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

Annotation of /FigKernelPackages/FIGgjo.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : golsen 1.1 #
2 :     # Copyright (c) 2003-2007 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 :     # This is a collection point for miscellaneous functions created by GJO
19 :     # that are useful in multiple scripts within the SEED. They could be put
20 :     # in FIG.pm, but these are less central.
21 :    
22 :     package FIGgjo;
23 : golsen 1.3
24 :     use gjocolorlib;
25 : golsen 1.1 use strict;
26 :    
27 :     #------------------------------------------------------------------------------
28 :     # This is a sufficient set of escaping for text in HTML (function and alias):
29 :     #
30 :     # $html = html_esc( $text )
31 :     #------------------------------------------------------------------------------
32 :    
33 :     sub html_esc { local $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
34 :    
35 :    
36 :     #------------------------------------------------------------------------------
37 :     # Set background color for html text:
38 :     #
39 :     # $html = bgcolor( $html, $color )
40 :     #------------------------------------------------------------------------------
41 :     sub bgcolor
42 :     {
43 :     return ! $_[0] ? '' # No text
44 :     : ! $_[1] ? $_[0] # No color
45 :     : "<span style='background-color:$_[1]'>$_[0]</span>"
46 :     }
47 :    
48 :    
49 :     #------------------------------------------------------------------------------
50 :     # Default pallets for colorizing functions and roles.
51 :     #------------------------------------------------------------------------------
52 :    
53 : golsen 1.3 my @pallets = ( [ '#DDCCAA', '#FFAAAA', '#FFCC66', '#FFFF44',
54 : golsen 1.1 '#CCFF66', '#88FF88', '#88EECC', '#88FFFF',
55 :     '#66CCFF', '#AAAAFF', '#CC88FF', '#FFAAFF'
56 :     ],
57 : golsen 1.3 [ '#DDCCAA', '#FFAAAA', '#FFCC66', '#FFFF44',
58 : golsen 1.1 '#AAFFAA', '#BBBBFF', '#FFAAFF'
59 :     ]
60 :     );
61 :    
62 :     # Find the smallest pallet that fits all of the colors
63 :    
64 :     sub choose_pallet
65 :     {
66 :     my ( $ncolor, $pallets ) = @_;
67 :     my @pals = sort { @$b <=> @$a } # most to fewest colors
68 :     ( $pallets ? @$pallets : @pallets );
69 :     my $pallet = $pals[0];
70 :     foreach ( @pals )
71 :     {
72 :     last if $ncolor > @$_;
73 :     $pallet = $_;
74 :     }
75 :     wantarray ? @$pallet : $pallet;
76 :     }
77 :    
78 :     #------------------------------------------------------------------------------
79 :     # colorize_roles creates a hash relating functions to html versions in which
80 :     # identical roles are colored the same.
81 :     #
82 :     # %colorized_function = colorize_roles( @functions )
83 :     # %colorized_function = colorize_roles( \@functions )
84 :     # %colorized_function = colorize_roles( \%functions )
85 :     # %colorized_function = colorize_roles( \@functions, $current_func )
86 :     # %colorized_function = colorize_roles( \%functions, $current_func )
87 :     #
88 :     # where:
89 :     #
90 :     # @functions list of functions
91 :     # %functions hash of functions (key does not matter)
92 :     # %colorized_function hash of colorized html text keyed by function
93 :     #------------------------------------------------------------------------------
94 :     sub colorize_roles
95 :     {
96 : golsen 1.2 my $role_clr = role_colors( @_ );
97 : golsen 1.1
98 :     my @funcs = ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] }
99 :     : ref( $_[0] ) eq 'HASH' ? map { $_[0]->{$_} } keys %{$_[0]}
100 :     : @_;
101 :    
102 :     push @funcs, $_[1] if $_[1] && ref( $_[0] );
103 :    
104 :     my %funcs = map { $_ => 1 } @funcs;
105 :    
106 :     my %formatted_func = ();
107 :     foreach my $func ( keys %funcs )
108 :     {
109 :     $formatted_func{ $func }
110 : golsen 1.2 = join( '', map { my $c = $role_clr->{ $_ };
111 : golsen 1.1 my $t = html_esc( $_ );
112 :     $c ? bgcolor( $t, $c ) : $t
113 :     }
114 :     split /( +[#!].*$| *\; +| +\/ | +\@ +)/, $func
115 :     );
116 :     }
117 :    
118 :     wantarray ? %formatted_func : \%formatted_func
119 :     }
120 :    
121 :    
122 :     #------------------------------------------------------------------------------
123 :     # colorize_roles creates a hash relating functions to html versions in which
124 :     # identical roles are colored the same.
125 :     #
126 :     # %cell_info = colorize_roles_in_cell( @functions )
127 :     # %cell_info = colorize_roles_in_cell( \@functions )
128 :     # %cell_info = colorize_roles_in_cell( \%functions )
129 :     # %cell_info = colorize_roles_in_cell( \@functions, $current_func )
130 :     # %cell_info = colorize_roles_in_cell( \%functions, $current_func )
131 :     #
132 :     # where:
133 :     #
134 :     # @functions list of functions
135 :     # %functions hash of functions (key does not matter)
136 :     # %cell_info hash of [ html_text, cell_color ], keyed by function
137 :     #------------------------------------------------------------------------------
138 :     sub colorize_roles_in_cell
139 :     {
140 : golsen 1.2 my ( $role_clr, $clr_priority ) = role_colors( @_ );
141 : golsen 1.1
142 :     # Make nonredundant list of functions:
143 :    
144 :     my %seen;
145 :     my @funcs = grep { $_ && ! $seen{$_}++ }
146 :     ( ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] }
147 :     : ref( $_[0] ) eq 'HASH' ? map { $_[0]->{$_} } keys %{$_[0]}
148 :     : @_
149 :     );
150 :     push @funcs, $_[1] if $_[1] && ! $seen{ $_[1] };
151 :    
152 :     my ( @parts, $cell, $c, $t );
153 :     my %cell_info = ();
154 :     foreach my $func ( @funcs )
155 :     {
156 : golsen 1.2 $cell_info{ $func } = cell_guts( $func, $role_clr, $clr_priority );
157 : golsen 1.1 }
158 :    
159 :     wantarray ? %cell_info : \%cell_info
160 :     }
161 :    
162 :    
163 :     #------------------------------------------------------------------------------
164 :     # colorize_roles creates a hash relating functions to html versions in which
165 :     # identical roles are colored the same.
166 :     #
167 :     # %cell_info = colorize_roles_in_cell_2( @functions )
168 :     # %cell_info = colorize_roles_in_cell_2( \@functions )
169 :     # %cell_info = colorize_roles_in_cell_2( \%functions )
170 :     # %cell_info = colorize_roles_in_cell_2( \@functions, $current_func )
171 :     # %cell_info = colorize_roles_in_cell_2( \%functions, $current_func )
172 :     #
173 :     # where:
174 :     #
175 :     # @functions list of functions
176 :     # %functions hash of functions (key does not matter)
177 :     # %cell_info hash of [ html_text, cell_color ], keyed by function
178 :     #------------------------------------------------------------------------------
179 :     sub colorize_roles_in_cell_2
180 :     {
181 : golsen 1.2 my ( $role_clr, $clr_priority ) = role_colors( @_ );
182 : golsen 1.1
183 :     # Make nonredundant list of functions:
184 :    
185 :     my %seen;
186 :     my @funcs = grep { $_ && ! $seen{$_}++ }
187 :     ( ref( $_[0] ) eq 'ARRAY' ? @{ $_[0] }
188 :     : ref( $_[0] ) eq 'HASH' ? map { $_[0]->{$_} } keys %{$_[0]}
189 :     : @_
190 :     );
191 : golsen 1.3
192 :     my $current_func = ref( $_[0] ) && $_[1] ? $_[1] : '';
193 :     $current_func =~ s/ +[#!].*$//;
194 : golsen 1.1
195 :     my ( @parts, $cell, $c, $t );
196 :     my %cell_info = ();
197 :     foreach my $func ( @funcs )
198 :     {
199 : golsen 1.2 # Split multidomain proteins, displaying roles side-by-side:
200 :    
201 :     my @subcells = split / +\/ /, $func;
202 :     if ( @subcells == 1 )
203 :     {
204 :     $cell_info{ $func } = cell_guts( $func, $role_clr, $clr_priority );
205 :     }
206 :     else
207 :     {
208 : golsen 1.3 my $f2 = $func;
209 :     $f2 =~ s/ +[#!].*$//;
210 :     my $is_current = ( $f2 eq $current_func ) ? 1 : 0;
211 :    
212 : golsen 1.2 my $html = '<TABLE><TR>'
213 : golsen 1.3 . join( '', map { colored_cell( cell_guts( $_, $role_clr, $clr_priority, $is_current ) ) }
214 : golsen 1.2 @subcells
215 :     )
216 :     . '</TD></TABLE>';
217 :     $cell_info{ $func } = [ $html, '' ];
218 :     }
219 : golsen 1.1 }
220 :    
221 :     wantarray ? %cell_info : \%cell_info
222 :     }
223 :    
224 :    
225 :     #------------------------------------------------------------------------------
226 : golsen 1.2 # colored cell provides html text for one cell
227 :     #
228 :     # $table_cell_html = colored_cell( $text, $color )
229 :     #------------------------------------------------------------------------------
230 :    
231 :     sub colored_cell { "<TD BgColor=$_[1]>$_[0]</TD>" }
232 :    
233 :    
234 :     #------------------------------------------------------------------------------
235 :     # cell_guts provides the html text and cell color for one function colorized
236 :     # by role.
237 :     #
238 : golsen 1.3 # @html_color = cell_guts( $function, \%role_clr, \%clr_priority, $is_curr )
239 :     # \@html_color = cell_guts( $function, \%role_clr, \%clr_priority, $is_curr )
240 : golsen 1.2 #
241 :     # where:
242 :     #
243 :     # @html_color = ( html_text, cell_color ) for the function
244 :     #------------------------------------------------------------------------------
245 :     sub cell_guts
246 :     {
247 : golsen 1.3 my ( $func, $role_clr, $clr_priority, $is_curr ) = @_;
248 : golsen 1.2
249 :     my $cc; # cell color
250 :     my $rc; # role color
251 :     my $rt; # role text
252 :     my @parts = split /( +[#!].*$| *\; +| +\/ | +\@ +)/, $func;
253 : golsen 1.3 if ( $is_curr )
254 :     {
255 :     my %clrs2 = map { $_ => faded( $role_clr->{ $_ } ) } @parts;
256 :     $role_clr = \%clrs2;
257 :     }
258 : golsen 1.2 ( $cc ) = sort { $clr_priority->{$a} <=> $clr_priority->{$b} }
259 :     grep { $_ }
260 :     map { $role_clr->{ $_ } }
261 :     @parts;
262 :     my @cell_guts = ( join( '', map { $rc = $role_clr->{ $_ };
263 :     $rt = html_esc( $_ );
264 :     $rc ne $cc ? bgcolor( $rt, $rc ) : $rt
265 :     }
266 :     @parts
267 :     ),
268 :     $cc
269 :     );
270 :    
271 :     wantarray ? @cell_guts : \@cell_guts;
272 :     }
273 :    
274 :    
275 : golsen 1.3 sub faded { gjocolorlib::blend_html_colors( $_[0], '#FFFFFF' ) }
276 :    
277 : golsen 1.2 #------------------------------------------------------------------------------
278 : golsen 1.1 # role_colors creates a hash of colors for roles in a set of functions.
279 :     #
280 :     # %colors = role_colors( @functions )
281 :     # %colors = role_colors( \@functions )
282 :     # %colors = role_colors( \%functions )
283 :     # %colors = role_colors( \@functions, $current_func )
284 :     # %colors = role_colors( \%functions, $current_func )
285 :     #
286 :     # where:
287 :     #
288 :     # @functions list of functions
289 :     # %functions hash of functions (key does not matter)
290 :     # %colors hash of colors keyed by role
291 :     #------------------------------------------------------------------------------
292 :     sub role_colors
293 :     {
294 :     my $funcs = ref( $_[0] ) eq 'ARRAY' ? $_[0]
295 :     : ref( $_[0] ) eq 'HASH' ? [ map { $_[0]->{$_} } keys %{$_[0]} ]
296 :     : [ @_ ];
297 :    
298 :     my $current_func = ref( $_[0] ) eq 'ARRAY' ? $_[1]
299 :     : ref( $_[0] ) eq 'HASH' ? $_[1]
300 :     : '';
301 :     $current_func =~ s/ +[#!].*$//; # strip comment
302 :    
303 :     my %func_cnt = (); # count function occurrances
304 :     foreach my $func ( @$funcs )
305 :     {
306 :     $func_cnt{ $func }++ if $func =~ /\S/;
307 :     }
308 :    
309 :     my %role_cnt = (); # count role occurances
310 :     foreach my $func ( keys %func_cnt )
311 :     {
312 :     $func =~ s/ +[#!].*$//;
313 :     my $cnt = $func_cnt{ $func };
314 :     foreach ( split / *\; +| +\/ | +\@ +/, $func )
315 :     {
316 :     $role_cnt{ $_ } += $cnt if $_ =~ /\S/;
317 :     }
318 :     }
319 :    
320 : golsen 1.2 my %role_clr;
321 : golsen 1.1 my @current_roles = sort { $role_cnt{ $b } <=> $role_cnt{ $a } }
322 :     grep { /\S/ }
323 :     split / *\; +| +\/ | +\@ +/, $current_func;
324 :     if ( @current_roles )
325 :     {
326 :     foreach ( @current_roles ) { delete $role_cnt{ $_ } }
327 : golsen 1.3 $role_clr{ shift @current_roles } = "#FFFFFF" if @current_roles == 1;
328 : golsen 1.1 }
329 :    
330 :     my @roles = ( @current_roles,
331 :     sort { $role_cnt{ $b } <=> $role_cnt{ $a } } keys %role_cnt
332 :     );
333 :    
334 :     my @colors = choose_pallet( scalar @roles );
335 :     my $n = 0;
336 : golsen 1.2 my %clr_priority = map { $_ => $n++ } ( "#FFFFFF", @colors, "#DDDDDD" );
337 : golsen 1.1
338 :     foreach ( @roles )
339 :     {
340 : golsen 1.2 $role_clr{ $_ } = ( shift @colors ) || "#DDDDDD";
341 : golsen 1.1 }
342 :    
343 : golsen 1.2 wantarray ? ( \%role_clr, \%clr_priority ) : \%role_clr
344 : golsen 1.1 }
345 :    
346 :    
347 :     #------------------------------------------------------------------------------
348 :     # colorize_functions creates a hash relating functions to html versions in
349 :     # which identical functions are colored the same.
350 :     #
351 :     # %colorized_function = colorize_functions( @functions )
352 :     # %colorized_function = colorize_functions( \@functions )
353 :     # %colorized_function = colorize_functions( \%functions )
354 :     # %colorized_function = colorize_functions( \@functions, $current_func )
355 :     # %colorized_function = colorize_functions( \%functions, $current_func )
356 :     #
357 :     # where:
358 :     #
359 :     # @functions list of functions
360 :     # %functions hash of functions (key does not matter)
361 :     # %colorized_function hash of colorized html text keyed by function
362 :     #------------------------------------------------------------------------------
363 :     sub colorize_functions
364 :     {
365 :     my %func_color = function_colors( @_ );
366 :    
367 :     my %formatted_func = ();
368 :     foreach my $func ( keys %func_color )
369 :     {
370 :     $formatted_func{ $func } = bgcolor( html_esc( $func ), $func_color{ $func } );
371 :     }
372 :    
373 :     wantarray ? %formatted_func : \%formatted_func
374 :     }
375 :    
376 :    
377 :     #------------------------------------------------------------------------------
378 :     # function_colors creates a hash of colors for a list of functions.
379 :     #
380 :     # %colors = function_colors( @functions )
381 :     # %colors = function_colors( \@functions )
382 :     # %colors = function_colors( \%functions )
383 :     # %colors = function_colors( \@functions, $current_func )
384 :     # %colors = function_colors( \%functions, $current_func )
385 :     #
386 :     # where:
387 :     #
388 :     # @functions list of functions
389 :     # %functions hash of functions (key does not matter)
390 :     # %colors hash of colors keyed by function
391 :     #------------------------------------------------------------------------------
392 :     sub function_colors
393 :     {
394 :     my $funcs = ref( $_[0] ) eq 'ARRAY' ? $_[0]
395 :     : ref( $_[0] ) eq 'HASH' ? [ map { $_[0]->{$_} } keys %{$_[0]} ]
396 :     : [ @_ ];
397 :    
398 :     my $current_func = ref( $_[0] ) eq 'ARRAY' ? $_[1]
399 :     : ref( $_[0] ) eq 'HASH' ? $_[1]
400 :     : '';
401 :    
402 :     my %func_cnt = ();
403 :     foreach my $func ( @$funcs )
404 :     {
405 :     $func_cnt{ $func }++ if $func =~ /\S/;
406 :     }
407 :    
408 :     my %func_color;
409 :     if ( $current_func =~ /\S/ )
410 :     {
411 :     $func_color{ $current_func } = '#FFFFFF'; # white
412 :     delete $func_cnt{ $current_func };
413 :     }
414 :    
415 :     my @funcs = sort { $func_cnt{ $b } <=> $func_cnt{ $a } }
416 :     keys %func_cnt;
417 :    
418 :     my @colors = choose_pallet( scalar @funcs );
419 :    
420 :     foreach ( @funcs )
421 :     {
422 :     $func_color{ $_ } = ( shift @colors ) || "#DDDDDD";
423 :     }
424 :    
425 :     wantarray ? %func_color : \%func_color
426 :     }
427 :    
428 :    
429 :     1;
430 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3