[Bio] / SubsystemEditor / WebPage / MetaSpreadsheet.pm Repository:
ViewVC logotype

Annotation of /SubsystemEditor/WebPage/MetaSpreadsheet.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : bartels 1.1 package SubsystemEditor::WebPage::MetaSpreadsheet;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :     use DBMaster;
9 :    
10 :     use FIG;
11 :    
12 :     use MIME::Base64;
13 :     use Data::Dumper;
14 :     use File::Spec;
15 :     use GenomeLists;
16 :     use MetaSubsystem;
17 :     use base qw( WebPage );
18 :    
19 :     1;
20 :    
21 :    
22 :     ##############################################################
23 :     # Method for registering components etc. for the application #
24 :     ##############################################################
25 :     sub init {
26 :     my ( $self ) = @_;
27 :    
28 :     $self->application->register_component( 'Table', 'SubsystemSpreadsheet' );
29 :     $self->application->register_component( 'TabView', 'functionTabView' );
30 :     $self->application->register_component( 'Table', 'LD_SUBSETS' );
31 :     $self->application->register_component( 'Table', 'LD_ROLES' );
32 :     # $self->application->register_component( 'Info', 'CommentInfo');
33 :     # $self->application->register_component( 'OrganismSelect', 'OSelect');
34 :     # $self->application->register_component( 'Table', 'VarDescTable' );
35 :     $self->application->register_component( 'Table', 'FunctionalRolesTable' );
36 :    
37 :     return 1;
38 :     }
39 :    
40 :     sub require_javascript {
41 :    
42 :     return [ './Html/showfunctionalroles.js' ];
43 :    
44 :     }
45 :    
46 :     ##############################################
47 :     # Website content is returned by this method #
48 :     ##############################################
49 :     sub output {
50 :     my ( $self ) = @_;
51 :    
52 :     # needed objects #
53 :     my $application = $self->application();
54 :     $self->{ 'fig' } = $application->data_handle( 'FIG' );
55 :     $self->{ 'cgi' } = $self->application->cgi;
56 :    
57 :     # subsystem name and 'nice name' #
58 :     my $name = $self->{ 'cgi' }->param( 'metasubsystem' );
59 :     my $ssname = $name;
60 :    
61 :     my $esc_name = uri_escape( $name );
62 :    
63 :     $ssname =~ s/\_/ /g;
64 :    
65 :     # look if someone is logged in and can write the subsystem #
66 :     $self->{ 'can_alter' } = 0;
67 :     my $user = $self->application->session->user;
68 :    
69 :     my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
70 :     my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
71 :    
72 :    
73 :     ############################################
74 :     ### GET PREFERENCES FOR AN EXISTING USER ###
75 :     my $preferences = {};
76 :    
77 :     if ( defined( $user ) && ref( $user ) ) {
78 :     my $pre = $self->application->dbmaster->Preferences->get_objects( { user => $user,
79 :     application => $ppoapplication } );
80 :     %{ $preferences } = map { $_->name => $_ } @$pre;
81 :     }
82 :     ############################################
83 :    
84 :     # get a seeduser #
85 :     my $seeduser = '';
86 :    
87 :     if ( defined( $preferences->{ 'SeedUser' } ) ) {
88 :     $seeduser = $preferences->{ 'SeedUser' }->value;
89 :     }
90 :     if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $esc_name ) ) {
91 :     $self->{ 'can_alter' } = 1;
92 :     $self->{ 'fig' }->set_user( $seeduser );
93 :     $self->{ 'seeduser' } = $seeduser;
94 :     }
95 :    
96 :     $self->{ 'metasubsystem' } = new MetaSubsystem( $name, $self->{ 'fig' }, 0 );
97 :    
98 :    
99 :     #########
100 :     # TASKS #
101 :     #########
102 :    
103 :     if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'LimitSubsets' ) {
104 :    
105 :     my @showsets = $self->{ 'cgi' }->param( 'show_set' );
106 :     my @collapsesets = $self->{ 'cgi' }->param( 'collapse_set' );
107 :     my @showrole = $self->{ 'cgi' }->param( 'show_role' );
108 :    
109 :     my $view;
110 :    
111 :     foreach my $set ( @showsets ) {
112 :     $set =~ /show_set_(.*)/;
113 :     $view->{ 'Subsets' }->{ $1 }->{ 'visible' } = 1;
114 :     }
115 :     foreach my $set ( @collapsesets ) {
116 :     $set =~ /collapse_set_(.*)/;
117 :     $view->{ 'Subsets' }->{ $1 }->{ 'collapsed' } = 1;
118 :     }
119 :     foreach my $role ( @showrole ) {
120 :     $role =~ /show_role_(.*)\##-##(.*)/;
121 :     my $tmprole = $1.'##-##'.$2;
122 :     $view->{ 'Roles' }->{ $tmprole }->{ 'visible' } = 1;
123 :     $view->{ 'Roles' }->{ $tmprole }->{ 'subsystem' } = $2;
124 :     }
125 :     $self->{ 'metasubsystem' }->{ 'view' } = $view;
126 :     $self->{ 'metasubsystem' }->write_metasubsystem();
127 :     }
128 :    
129 :     $self->get_metass_data();
130 :    
131 :     ########
132 :     # Data #
133 :     ########
134 :    
135 :     my ( $frscrlist, $hiddenvalues ) = $self->load_subsystem_spreadsheet( $application, $preferences );
136 :    
137 :     my $table = $self->application->component( 'SubsystemSpreadsheet' );
138 :     my $frtable = $self->application->component( 'FunctionalRolesTable' );
139 :    
140 :     ######################
141 :     # Construct the menu #
142 :     ######################
143 :    
144 :     my $menu = $self->application->menu();
145 :    
146 :     # Build nice tab menu here
147 :     $menu->add_category( 'Meta Overview', "SubsysEditor.cgi?page=MetaOverview" );
148 :    
149 :     ##############################
150 :     # Construct the page content #
151 :     ##############################
152 :    
153 :     # colorpanel #
154 :     my $colorpanel = $self->color_spreadsheet_panel( $preferences, $name );
155 :     # limitdisplaypanel #
156 :     my $limitdisplaypanel = $self->limit_display_panel();
157 :     my $limitsubsetspanel = $self->limit_subsets_panel();
158 :    
159 :     my $tab_view_component = $self->application->component( 'functionTabView' );
160 :     $tab_view_component->width( 900 );
161 :     # if ( $can_alter ) {
162 :     # $tab_view_component->add_tab( '<H2>&nbsp; Add Genomes to Spreadsheet &nbsp;</H2>', "$addgenomepanel" );
163 :     # }
164 :     $tab_view_component->add_tab( '<H2>&nbsp; Color Spreadsheet &nbsp;</H2>', "$colorpanel" );
165 :     $tab_view_component->add_tab( '<H2>&nbsp; Limit Genomes &nbsp;</H2>', "$limitdisplaypanel" );
166 :     $tab_view_component->add_tab( '<H2>&nbsp; Limit Subsets &nbsp;</H2>', "$limitsubsetspanel" );
167 :     $tab_view_component->add_tab( '<H2>&nbsp; Functional Roles &nbsp;</H2>', $frtable->output() );
168 :     # $tab_view_component->add_tab( '<H2>&nbsp; Show Variants &nbsp;</H2>', "$variantpanel" );
169 :    
170 :     if ( defined( $self->{ 'cgi' }->param( 'defaulttabhidden' ) ) ) {
171 :     $tab_view_component->default( $self->{ 'cgi' }->param( 'defaulttabhidden' ) );
172 :     }
173 :     else {
174 :     $tab_view_component->default( 0 );
175 :     }
176 :    
177 :     # add hidden parameter for the tab that is actually open #
178 :     my $dth = 0;
179 :     if ( defined( $self->{ 'cgi' }->param( 'defaulttabhidden' ) ) ) {
180 :     $dth = $self->{ 'cgi' }->param( 'defaulttabhidden' );
181 :     }
182 :    
183 :     $hiddenvalues->{ 'metasubsystem' } = $name;
184 :     $hiddenvalues->{ 'buttonpressed' } = 'none';
185 :     $hiddenvalues->{ 'defaulttabhidden' } = $dth;
186 :    
187 :     ###########
188 :     # Content #
189 :     ###########
190 :    
191 :     my $content = "<H1>Subsystem Metaview for $ssname</H1>";
192 :    
193 :     # start form #
194 :     $content .= $self->start_form( 'subsys_spreadsheet', $hiddenvalues );
195 :     $content .= "<TABLE><TR><TD>";
196 :    
197 :     $content .= $tab_view_component->output();
198 :     $content .= "</TD></TR><TR><TD>";
199 :     # put in color legends #
200 :     if ( defined( $self->{ 'legend' } ) ) {
201 :     $content .= $self->{ 'legend' };
202 :     $content .= "</TD></TR><TR><TD>";
203 :     }
204 :     if ( defined( $self->{ 'legendg' } ) ) {
205 :     $content .= $self->{ 'legendg' };
206 :     $content .= "</TD></TR><TR><TD>";
207 :     }
208 :    
209 :     # $content .= "</TD></TR><TR><TD>";
210 :    
211 :     $content .= $table->output();
212 :    
213 :     $content .= "</TD></TR>";
214 :     $content .= "</TABLE>";
215 :    
216 :     # end form
217 :     $content .= $self->end_form();
218 :    
219 :     return $content;
220 :     }
221 :    
222 :     ##############################
223 :     # draw subsystem spreadsheet #
224 :     ##############################
225 :     sub load_subsystem_spreadsheet {
226 :     my ( $self, $application, $preferences ) = @_;
227 :    
228 :     # initialize roles, subsets and spreadsheet
229 :     my $roles = $self->{ 'data_roles' };
230 :     my $subsets = $self->{ 'data_subsets' };
231 :     my $spreadsheet_hash = $self->{ 'data_spreadsheethash' };
232 :     my $pegsarr = $self->{ 'data_allpegs' };
233 :    
234 :     my $user = $application->session->user();
235 :     my $seeduser = $self->{ 'seeduser' };
236 :     my $metass = $self->{ 'metasubsystem' };
237 :    
238 :    
239 :     # get a list of sane colors
240 :     my $colors = $self->get_colors();
241 :    
242 :     #####################################
243 :     # Displaying and Collapsing Subsets #
244 :     #####################################
245 :    
246 :     # Now - what roles or what subsets do I take?
247 :     my $role_to_group;
248 :     my $columns;
249 :     my $role_to_function;
250 :     my $function_to_role;
251 :     my $toshowroles;
252 :     my %takeroles;
253 :     my %takebutcollapsed;
254 :     my $subsetssupercolumns = 0;
255 :    
256 :     # here get the roles to show, also the subsets so that we can look them up from the hash
257 :     foreach my $subset ( keys %$subsets ) {
258 :    
259 :     if ( $metass->{ 'view' }->{ 'Subsets' }->{ $subset }->{ 'visible' } ) {
260 :     if ( $metass->{ 'view' }->{ 'Subsets' }->{ $subset }->{ 'collapsed' } ) {
261 :     $columns->{ $subset } = scalar( keys %$columns );
262 :     $subsetssupercolumns++;
263 :     foreach my $abb ( keys %{ $subsets->{ $subset } } ) {
264 :     my $fullname = $abb.'##-##'.$subsets->{ $subset }->{ $abb };
265 :     push @{ $role_to_group->{ $fullname } }, $subset;
266 :     $takebutcollapsed{ $fullname } = 1;
267 :     }
268 :     }
269 :     else {
270 :     foreach my $abb ( keys %{ $subsets->{ $subset } } ) {
271 :     my $fullname = $abb.'##-##'.$subsets->{ $subset }->{ $abb };
272 :     $takeroles{ $fullname } = 1;
273 :     }
274 :     }
275 :     }
276 :     }
277 :    
278 :     foreach my $role ( @$roles ) {
279 :     push @$toshowroles, $role;
280 :    
281 :     my $rolesubsystem = $role->[0].'##-##'.$role->[3];
282 :    
283 :     $role_to_function->{ $rolesubsystem } = $role->[1];
284 :     $function_to_role->{ $role->[1] } = $role->[2];
285 :    
286 :     my $th = $metass->{ 'view' }->{ 'Roles' };
287 :    
288 :     # look if this role is part of a subset
289 :     if ( exists( $role_to_group->{ $role->[0] } ) ) {
290 :     $takeroles{ $rolesubsystem } = 1;
291 :     }
292 :     elsif ( defined( $th->{ $rolesubsystem } && $th->{ $rolesubsystem }->{ 'visible' } ) ) {
293 :     $columns->{ $rolesubsystem } = scalar( keys %$columns );
294 :     $takeroles{ $rolesubsystem } = 1;
295 :     }
296 :     elsif ( $takeroles{ $rolesubsystem } && !defined( $takebutcollapsed{ $rolesubsystem } ) ) {
297 :     $columns->{ $rolesubsystem } = scalar( keys %$columns );
298 :     }
299 :     }
300 :    
301 :     my $rolelist .= $self->{ 'cgi' }->scrolling_list( -id => 'rolelist',
302 :     -name => 'rolelist',
303 :     -multiple => 1,
304 :     -values => $toshowroles,
305 :     -default => '',
306 :     -size => 3
307 :     );
308 :    
309 :     ##########################################
310 :     # COLORING SETTINGS OF GENES AND GENOMES #
311 :     ##########################################
312 :     my $peg_to_color_alround;
313 :     my $cluster_colors_alround = {};
314 :     my $genome_colors;
315 :     my $genomes_to_color = {};
316 :     my $columnNameHash;
317 :     my $ind_to_subset;
318 :     my $name = $self->{ 'cgi' }->param( 'metasubsystem' );
319 :    
320 :     ### COLOR GENES ###
321 :     my $color_by = 'do not color'; #default
322 :     if ( $preferences->{ $name."_color_stuff" } ) {
323 :     $color_by = $preferences->{ $name."_color_stuff" }->value;
324 :     }
325 :     if ( defined( $self->{ 'cgi' }->param( 'color_stuff' ) ) ) {
326 :     $color_by = $self->{ 'cgi' }->param( 'color_stuff' );
327 :     unless ( $preferences->{ $name."_color_stuff" } ) {
328 :     if ( defined( $user ) && ref( $user ) ) {
329 :     $preferences->{ $name."_color_stuff" } = $self->application->dbmaster->Preferences->create( { user => $user,
330 :     application => $self->application->backend,
331 :     name => $name."_color_stuff",
332 :     value => $color_by } );
333 :     }
334 :     }
335 :     else {
336 :     $preferences->{ $name."_color_stuff" }->value( $color_by );
337 :     }
338 :     }
339 :     elsif ( $preferences->{ $name."_color_stuff" } ) {
340 :     $self->{ 'cgi' }->param( 'color_stuff', $preferences->{ $name."_color_stuff" }->value );
341 :     }
342 :    
343 :     if ( $color_by eq 'by attribute: ' ) {
344 :     my $attr = 'Essential_Gene_Sets_Bacterial';
345 :    
346 :     if ( $preferences->{ $name."_color_by_peg_tag" } ) {
347 :     $attr = $preferences->{ $name."_color_by_peg_tag" }->value;
348 :     }
349 :     if ( defined( $self->{ 'cgi' }->param( 'color_by_peg_tag' ) ) ) {
350 :     $attr = $self->{ 'cgi' }->param( 'color_by_peg_tag' );
351 :     unless ( $preferences->{ $name."_color_by_peg_tag" } ) {
352 :     if ( $user ) {
353 :     $preferences->{ $name."_color_by_peg_tag" } = $self->application->dbmaster->Preferences->create( { user => $user,
354 :     application => $self->application->backend,
355 :     name => $name."_color_by_peg_tag",
356 :     value => $attr } );
357 :     }
358 :     }
359 :     else {
360 :     $preferences->{ $name."_color_by_peg_tag" }->value( $attr );
361 :     }
362 :     }
363 :    
364 :     ( $peg_to_color_alround, $cluster_colors_alround ) = $self->get_color_by_attribute_infos( $attr, $pegsarr, $colors );
365 :     }
366 :    
367 :     ### COLOR GENOMES ###
368 :     my $colorg_by = 'do not color';
369 :     if ( $preferences->{ $name."_colorg_stuff" } ) {
370 :     $colorg_by = $preferences->{ $name."_colorg_stuff" }->value;
371 :     }
372 :     if ( defined( $self->{ 'cgi' }->param( 'colorg_stuff' ) ) ) {
373 :     $colorg_by = $self->{ 'cgi' }->param( 'colorg_stuff' );
374 :     unless ( $preferences->{ $name."_colorg_stuff" } ) {
375 :     if ( $user ) {
376 :     $preferences->{ $name."_colorg_stuff" } = $self->application->dbmaster->Preferences->create( { user => $user,
377 :     application => $self->application->backend,
378 :     name => $name."_colorg_stuff",
379 :     value => $color_by } );
380 :     }
381 :     }
382 :     else {
383 :     $preferences->{ $name."_colorg_stuff" }->value( $colorg_by );
384 :     }
385 :     }
386 :     elsif ( $preferences->{ $name."_colorg_stuff" } ) {
387 :     $self->{ 'cgi' }->param( 'colorg_stuff', $preferences->{ $name."_colorg_stuff" }->value );
388 :     }
389 :    
390 :     if ( $colorg_by eq 'by attribute: ' ) {
391 :    
392 :     my $attr;
393 :     if ( $preferences->{ $name."_color_by_ga" } ) {
394 :     $attr = $preferences->{ $name."_color_by_ga" }->value;
395 :     }
396 :    
397 :     if ( defined( $self->{ 'cgi' }->param( 'color_by_ga' ) ) && $self->{ 'cgi' }->param( 'color_by_ga' ) ne '' ) {
398 :     $attr = $self->{ 'cgi' }->param( 'color_by_ga' );
399 :    
400 :     unless ( $preferences->{ $name."_color_by_ga" } ) {
401 :     if ( $user ) {
402 :     $preferences->{ $name."_color_by_ga" } = $self->application->dbmaster->Preferences->create( { user => $user,
403 :     application => $self->application->backend,
404 :     name => $name."_color_by_ga",
405 :     value => $attr } );
406 :     }
407 :     }
408 :     elsif ( defined( $attr ) ) {
409 :     $preferences->{ $name."_color_by_ga" }->value( $attr );
410 :     $self->{ 'cgi' }->param( 'color_by_ga', $attr );
411 :     }
412 :     ( $genomes_to_color, $genome_colors ) = $self->get_color_by_attribute_infos_for_genomes( $spreadsheet_hash, $colors );
413 :     }
414 :     }
415 :    
416 :     ## END OF COLORING SETTINGS ##
417 :    
418 :     ################################
419 :     # Creating the table from here #
420 :     ################################
421 :    
422 :     # create table headers
423 :     my $table_columns = [ '',
424 :     { name => 'Organism', filter => 1, sortable => 1, width => '150', operand => $self->{ 'cgi' }->param( 'filterOrganism' ) || '' },
425 :     { name => 'Domain', filter => 1, operator => 'combobox', operand => $self->{ 'cgi' }->param( 'filterDomain' ) || '' },
426 :     { name => 'Taxonomy', sortable => 1, visible => 0, show_control => 1 },
427 :     { name => 'Variant', sortable => 1 }
428 :     ];
429 :    
430 :     my $supercolumns = [ [ '', 1 ], [ '', 1 ], [ '', 1 ], [ '', 1 ] ];
431 :    
432 :     if ( $subsetssupercolumns > 0 ) {
433 :     push @$supercolumns, [ 'Subsets', $subsetssupercolumns ];
434 :     }
435 :     my $supercolstobe;
436 :    
437 :     my $ii = 4; # this is for keeping in mind in what column we start the Functional Roles
438 :    
439 :     # if user can write he gets a writable variant column that if first invisible
440 :     if ( $self->{ 'can_alter' } ) {
441 :     push @$table_columns, { name => 'Variant', visible => 0 };
442 :     $ii++;
443 :     }
444 :    
445 :     my $i = $ii;
446 :    
447 :     ### Now add the column headers for all functional roles or subsets of the table ###
448 :     foreach my $column ( sort { $columns->{ $a } <=> $columns->{ $b } } keys( %$columns) ) {
449 :     $i++;
450 :    
451 :     if ( exists( $role_to_function->{ $column } ) ) {
452 :     $column =~ /(.*)\#\#\-\#\#(.*)/;
453 :     my $colrole = $1;
454 :     my $ss_of_role = $2;
455 :     my $tooltip = "<TABLE><TR><TH>Role</TH><TH>Subsystem</TH></TR>\n";
456 :     $tooltip .= "<TR><TD>".$role_to_function->{ $column }."</TD><TD>$ss_of_role</TD></TR</TABLE>";
457 :     push @$supercolstobe, [ $ss_of_role, 1 ];
458 :     push( @$table_columns, { name => $colrole, tooltip => $tooltip });
459 :     $columnNameHash->{ $i } = $colrole.'<BR>'.$tooltip;
460 :     $ind_to_subset->{ $i } = 1;
461 :     }
462 :     else {
463 :     my $tooltip = "<table>";
464 :     foreach my $role ( keys %{ $subsets->{ $column } } ) {
465 :     $tooltip .= "<tr><td>$role</td><td><b>" . $subsets->{ $column }->{ $role } . " </b></td></tr>";
466 :     }
467 :     $tooltip .= "</table>";
468 :     push( @$table_columns, { name => $column, tooltip => $tooltip } );
469 :     $columnNameHash->{ $i } = $column.'<BR>'.$tooltip;
470 :     }
471 :     }
472 :     push( @$table_columns, { name => 'Pattern', sortable => 1, visible => 0, show_control => 1 });
473 :    
474 :    
475 :     # Variants - default is not to show the -1 variants, so we have to ask if that is still true.
476 :     my $show_mo_variants = 0;
477 :     if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'MoVariants' || $self->{ 'cgi' }->param( 'showMoVariants' ) ) {
478 :     $show_mo_variants = 1;
479 :     }
480 :     if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'HideMoVariants' ) {
481 :     $show_mo_variants = 0;
482 :     }
483 :    
484 :     # For the lines of the table, walk through spreadsheet hash #
485 :     my $pretty_spreadsheet;
486 :    
487 :     my @sortedrows;
488 :    
489 :     if ( $preferences->{ 'sort_spreadsheet_by' } && $preferences->{ 'sort_spreadsheet_by' }->value() eq 'alphabetically' ) {
490 :     @sortedrows = sort { $spreadsheet_hash->{ $a }->{ 'name' } cmp $spreadsheet_hash->{ $b }->{ 'name' } } keys %$spreadsheet_hash;
491 :     }
492 :     else {
493 :     @sortedrows = sort { $spreadsheet_hash->{ $a }->{ 'taxonomy' } cmp $spreadsheet_hash->{ $b }->{ 'taxonomy' } } keys %$spreadsheet_hash;
494 :     }
495 :    
496 :     foreach my $g ( @sortedrows ) {
497 :    
498 :     my $new_row;
499 :    
500 :     # organism name, domain, taxonomy, variantcode #
501 :     my $gname = $spreadsheet_hash->{ $g }->{ 'name' };
502 :     my $domain = $spreadsheet_hash->{ $g }->{ 'domain' };
503 :     my $tax = $spreadsheet_hash->{ $g }->{ 'taxonomy' };
504 :     my $variant = $spreadsheet_hash->{ $g }->{ 'variant' };
505 :    
506 :     unless ( $show_mo_variants ) {
507 :     next if ( $variant eq '-1' );
508 :     }
509 :    
510 :     # add link to Organism page here #
511 :     $gname = "<A HREF='seedviewer.cgi?page=Organism&organism=" . $g."' target=_blank>$gname</A>";
512 :    
513 :     my $gentry = $gname;
514 :     if ( defined( $genomes_to_color->{ $g } ) ) {
515 :     $gentry = "<span style='background-color: " . $genome_colors->{ $genomes_to_color->{ $g } } . ";'>$gname</span>";
516 :     }
517 :    
518 :     my $genome_checkbox = $self->{ 'cgi' }->checkbox( -name => 'genome_checkbox',
519 :     -id => "genome_checkbox_$g",
520 :     -value => "genome_checkbox_$g",
521 :     -label => '',
522 :     -checked => 0,
523 :     -override => 1,
524 :     );
525 :    
526 :     push( @$new_row, $genome_checkbox );
527 :     push( @$new_row, $gentry );
528 :     push( @$new_row, $domain );
529 :     push( @$new_row, $tax );
530 :     push( @$new_row, $variant );
531 :     if ( $self->{ 'can_alter' } ) {
532 :     push( @$new_row, "<INPUT TYPE=TEXT NAME=\"variant$g\" SIZE=5 VALUE=\"$variant\">" );
533 :     }
534 :    
535 :     # now the genes #
536 :     my $thisrow = $spreadsheet_hash->{ $g }->{ 'row' };
537 :     my @row = @$thisrow;
538 :    
539 :     # memorize all pegs of this row
540 :     my $pegs;
541 :     my $rawpegs;
542 :    
543 :     # go through data cells and do grouping
544 :     my $data_cells;
545 :    
546 :     for ( my $i=0; $i<scalar( @row ); $i++ ) {
547 :     push( @$pegs, split( /, /, $row[$i] ) );
548 :    
549 :     my $roleident = $roles->[$i]->[0].'##-##'.$roles->[$i]->[3];
550 :    
551 :     next unless ( defined( $takeroles{ $roleident } ) || defined( $takebutcollapsed{ $roleident } ) );
552 :    
553 :     if ( exists( $role_to_group->{ $roleident } ) ) {
554 :     my $subsetsofthisrole = $role_to_group->{ $roleident };
555 :    
556 :     my $thiscell = '';
557 :     foreach my $ss ( @$subsetsofthisrole ) {
558 :     my $index = $columns->{ $ss };
559 :     unless ( $row[$i] =~ /INPUT/ ) {
560 :     push( @{ $data_cells->[ $index ] }, split( /, /, $row[$i] ) );
561 :     }
562 :     }
563 :     }
564 :     else {
565 :     my $index = $columns->{ $roleident };
566 :     push( @{ $data_cells->[ $index ] }, split( /, /, $row[$i] ) );
567 :     }
568 :     }
569 :    
570 :     foreach my $p ( @$pegs ) {
571 :     if ( $p =~ /(fig\|\d+\.\d+\.peg\.\d+)/ ) {
572 :     push @$rawpegs, $p;
573 :     }
574 :     }
575 :    
576 :     my $peg_to_color;
577 :     my $cluster_colors;
578 :    
579 :     # if we wanna color by cluster put it in here
580 :     if ( $color_by eq 'by cluster' ) {
581 :    
582 :     # compute clusters
583 :     my @clusters = $self->{ 'fig' }->compute_clusters( $rawpegs, undef, 5000 );
584 :    
585 :     for ( my $i = 0; $i < scalar( @clusters ); $i++ ) {
586 :    
587 :     my %countfunctions = map{ (scalar $self->{ 'fig' }->function_of( $_ ) => 1 ) } @{ $clusters[ $i ] };
588 :     next unless ( scalar( keys %countfunctions ) > 1);
589 :    
590 :     foreach my $peg ( @{ $clusters[ $i ] } ) {
591 :     $peg_to_color->{ $peg } = $i;
592 :     }
593 :     }
594 :     }
595 :     elsif ( $color_by eq 'by attribute: ' ) {
596 :     $peg_to_color = $peg_to_color_alround;
597 :     $cluster_colors = $cluster_colors_alround;
598 :     }
599 :    
600 :     # print actual cells
601 :     my $pattern = "a";
602 :     my $ind = $ii;
603 :     foreach my $data_cell ( @$data_cells ) {
604 :     $ind++;
605 :     my $num_clustered = 0;
606 :     my $num_unclustered = 0;
607 :     my $cluster_num = 0;
608 :     if ( defined( $data_cell ) ) {
609 :     $data_cell = [ sort( @$data_cell ) ];
610 :     my $cell = [];
611 :    
612 :     foreach my $peg ( @$data_cell ) {
613 :    
614 :     if ( $peg =~ /(fig\|\d+\.\d+\.peg\.\d+)/ ) {
615 :     my $thispeg = $1;
616 :     my $pegf = $self->{ 'fig' }->function_of( $thispeg );
617 :     my $pegfnum = '';
618 :    
619 :     if ( !defined( $thispeg ) ) {
620 :     next;
621 :     }
622 :    
623 :     $thispeg =~ /fig\|\d+\.\d+\.peg\.(\d+)/;
624 :     my $n = $1;
625 :    
626 :     my $peg_link = $self->fid_link( $thispeg );
627 :     $peg_link = "<A HREF='$peg_link' target=_blank>$n</A>";
628 :     unless ( $ind_to_subset->{ $ind } ) {
629 :     my $add_to_peg = $self->get_peg_addition( $pegf );
630 :     $peg_link .= $add_to_peg;
631 :     }
632 :    
633 :     if ( exists( $peg_to_color->{ $peg } ) ) {
634 :     unless ( defined( $cluster_colors->{ $peg_to_color->{ $peg } } ) ) {
635 :     $cluster_colors->{ $peg_to_color->{ $peg } } = $colors->[ scalar( keys( %$cluster_colors ) ) ];
636 :     }
637 :     $cluster_num = scalar( keys( %$cluster_colors ) );
638 :     $num_clustered++;
639 :     push( @$cell, "<span style='background-color: " . $cluster_colors->{ $peg_to_color->{ $peg } } . ";'>$peg_link</span>" );
640 :     }
641 :     else {
642 :     $num_unclustered++;
643 :     push @$cell, "<span>$peg_link</span>" ;
644 :     }
645 :     }
646 :     else {
647 :     push @$cell, $peg;
648 :     }
649 :     }
650 :     my $tt = $columnNameHash->{ $ind };
651 :     push( @$new_row, { data => join( '<br>', @$cell ), tooltip => $tt } );
652 :     }
653 :     else {
654 :     my $tt = $columnNameHash->{ $ind };
655 :     push( @$new_row, { data => '', tooltip => $tt } );
656 :     }
657 :     $pattern .= $num_clustered.$num_unclustered.$cluster_num;
658 :     }
659 :    
660 :     # pattern
661 :     push(@$new_row, $pattern);
662 :    
663 :     # push row to table
664 :     push(@$pretty_spreadsheet, $new_row);
665 :     }
666 :    
667 :     ### create table from parsed data ###
668 :    
669 :     my $table = $application->component( 'SubsystemSpreadsheet' );
670 :     $table->columns( $table_columns );
671 :     $table->data( $pretty_spreadsheet );
672 :     $table->show_top_browse( 1 );
673 :     $table->show_export_button( { strip_html => 1,
674 :     hide_invisible_columns => 1,
675 :     title => 'Export plain data to Excel' } );
676 :    
677 :     my $ss;
678 :     my $ssval = 0;
679 :     foreach my $thisarr ( @$supercolstobe ) {
680 :     if ( !defined( $ss ) ) {
681 :     $ss = $thisarr->[0];
682 :     $ssval++;
683 :     }
684 :     elsif ( $ss eq $thisarr->[0] ) {
685 :     $ssval++;
686 :     }
687 :     else {
688 :     my $nicess = $ss;
689 :     $nicess =~ s/\_/ /g;
690 :     push @$supercolumns, [ $nicess, $ssval ];
691 :     $ss = $thisarr->[0];
692 :     $ssval = 1;
693 :     }
694 :     }
695 :     if ( defined( $ss ) ) {
696 :     my $nicess = $ss;
697 :     $nicess =~ s/\_/ /g;
698 :     push @$supercolumns, [ $nicess, $ssval ];
699 :     }
700 :    
701 :     $table->supercolumns( $supercolumns );
702 :    
703 :     $table->show_select_items_per_page( 1 );
704 :    
705 :     ### remember some hidden values ###
706 :    
707 :     my $hiddenvalues = { 'filterOrganism' => '',
708 :     'sortOrganism' => '',
709 :     'filterDomain' => '',
710 :     'tableid' => $table->id,
711 :     'showMoVariants' => $show_mo_variants };
712 :    
713 :     # finished
714 :     return ( $rolelist, $hiddenvalues );
715 :     }
716 :    
717 :    
718 :     ######################################
719 :     # Panel for coloring the spreadsheet #
720 :     ######################################
721 :     sub color_spreadsheet_panel {
722 :    
723 :     my ( $self, $preferences, $name ) = @_;
724 :    
725 :     my $content = "<H2>Color genes in spreadsheet</H2>";
726 :    
727 :     my $default_coloring = $self->{ 'cgi' }->param( 'color_stuff' ) || 'do not color';
728 :    
729 :     if ( !defined( $self->{ 'cgi' }->param( 'color_by_peg_tag' ) ) && defined( $preferences->{ $name."_color_by_peg_tag" } ) ) {
730 :     $self->{ 'cgi' }->param( 'color_by_peg_tag', $preferences->{ $name."_color_by_peg_tag" }->value );
731 :     }
732 :    
733 :     my $defaultg_coloring = 'do not color';
734 :     if ( defined( $self->{ 'cgi' }->param( 'colorg_stuff' ) ) ) {
735 :     $defaultg_coloring = $self->{ 'cgi' }->param( 'colorg_stuff' );
736 :     }
737 :    
738 :     my @color_opt = $self->{ 'cgi' }->radio_group( -name => 'color_stuff',
739 :     -values => [ 'do not color', 'by cluster', 'by attribute: ' ],
740 :     -default => $default_coloring,
741 :     -override => 1
742 :     );
743 :    
744 :     my @pegkeys = $self->{ 'fig' }->get_peg_keys();
745 :     push @pegkeys, 'Expert_Annotations';
746 :    
747 :     # Compile and order the attribute keys found on pegs:
748 :     my $high_priority = qr/(essential|fitness)/i;
749 :     my @options = sort { $b =~ /$high_priority/o <=> $a =~ /$high_priority/o
750 :     || uc( $a ) cmp uc( $b )
751 :     }
752 :     @pegkeys;
753 :     my $blacklist = attribute_blacklist();
754 :    
755 :     @options = grep { !$blacklist->{ $_ } } @options;
756 :     unshift @options, undef; # Start list with empty
757 :    
758 :     my $att_popup = $self->{ 'cgi' }->popup_menu(-name => 'color_by_peg_tag', -values => \@options);
759 :    
760 :     $content .= join( "<BR>\n", @color_opt );
761 :     $content .= $att_popup;
762 :    
763 :     $content .= "<H2>Color genomes in spreadsheet</H2>";
764 :    
765 :     my @goptions = sort { uc( $a ) cmp uc( $b ) } $self->{ 'fig' }->get_genome_keys(); # get all the genome keys
766 :     unshift @goptions, undef; # a blank field at the start
767 :    
768 :     my @colorg_opt = $self->{ 'cgi' }->radio_group( -name => 'colorg_stuff',
769 :     -values => [ 'do not color', 'by attribute: ' ],
770 :     -default => $defaultg_coloring,
771 :     -override => 1
772 :     );
773 :    
774 :     my $genome_popup = $self->{ 'cgi' }->popup_menu( -name => 'color_by_ga', -values => \@goptions );
775 :     $content .= join( "<BR>\n", @colorg_opt );
776 :     $content .= $genome_popup;
777 :     if ( $self->{ 'can_alter' } ) {
778 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Color Spreadsheet' ONCLICK='SubmitSpreadsheet( \"Color Spreadsheet\", 1 );'>";
779 :     }
780 :     else {
781 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Color Spreadsheet' ONCLICK='SubmitSpreadsheet( \"Color Spreadsheet\", 0 );'>";
782 :     }
783 :    
784 :     return $content;
785 :     }
786 :    
787 :     ###############
788 :     # data method #
789 :     ###############
790 :     sub get_metass_data {
791 :    
792 :     my ( $self ) = @_;
793 :    
794 :     my $meta = $self->{ 'metasubsystem' };
795 :    
796 :     my $subsystems = $meta->{ 'subsystems' };
797 :    
798 :     my ( $subsets, $spreadsheet, $allpegs );
799 :     my $counter = 0;
800 :     my @roles;
801 :     my %spreadsheethash;
802 :     my @supercolumns;
803 :    
804 :     my $frtable = $self->application->component( 'FunctionalRolesTable' );
805 :     $frtable->columns( [ '#', 'Subsystem', 'Abbr.', 'Role Name' ] );
806 :     my $frtablerows;
807 :    
808 :     my @genomes = keys %{ $meta->{ 'genomes' } };
809 :     my $role_counter = 0;
810 :    
811 :     foreach my $ssname ( keys %$subsystems ) {
812 :     my $subsystem = $subsystems->{ $ssname };
813 :    
814 :     $counter ++;
815 :    
816 :     ## get da roles ##
817 :     my @rs = $subsystem->get_roles();
818 :     foreach my $r ( @rs ) {
819 :     $role_counter++;
820 :     my $abb = $subsystem->get_abbr_for_role( $r );
821 :     my $in = $subsystem->get_role_index( $r );
822 :     push @{ $self->{ 'roles_to_num' }->{ $r } }, [ $role_counter, $abb.'##-##'.$ssname ];
823 :     # $self->{ 'abb_ss_to_num' }->{ $abb.'##-##'.$ssname } = $role_counter;
824 :    
825 :    
826 :     push @roles, [ $abb, $r, $in, $ssname ];
827 :     push @$frtablerows, [ $role_counter, $ssname, $abb, $r ];
828 :     }
829 :    
830 :     foreach my $genome ( @genomes ) {
831 :     my $gidx = $subsystem->get_genome_index( $genome );
832 :    
833 :     $spreadsheethash{ $genome }->{ 'name' } = $self->{ 'fig' }->genus_species( $genome );
834 :     $spreadsheethash{ $genome }->{ 'domain' } = $self->{ 'fig' }->genome_domain( $genome );
835 :     $spreadsheethash{ $genome }->{ 'taxonomy' } = $self->{ 'fig' }->taxonomy_of( $genome );
836 :    
837 :     my $var = $subsystem->get_variant_code( $gidx );
838 :     if ( !defined( $gidx ) ) {
839 :     $var = '-';
840 :     }
841 :     if ( defined( $spreadsheethash{ $genome }->{ 'variant' } ) ) {
842 :     $spreadsheethash{ $genome }->{ 'variant' } .= "_$var";
843 :     }
844 :     else {
845 :     $spreadsheethash{ $genome }->{ 'variant' } = $var;
846 :     }
847 :    
848 :     my $rowss = $subsystem->get_row( $gidx );
849 :     my @row;
850 :    
851 :     foreach my $tr ( @$rowss ) {
852 :     if ( !defined( $gidx ) ) {
853 :     push @row, '';
854 :     }
855 :     else {
856 :     if ( defined( $tr->[0] ) ) {
857 :     push @$allpegs, @$tr;
858 :     push @row, join( ', ', @$tr );
859 :     }
860 :     else {
861 :     push @row, '';
862 :     }
863 :     }
864 :     }
865 :    
866 :     push @{ $spreadsheethash{ $genome }->{ 'row' } }, @row;
867 :     }
868 :    
869 :     $frtable->data( $frtablerows );
870 :    
871 :     }
872 :    
873 :     ## now get da subsets ##
874 :     my @subsetArr = keys %{ $meta->{ 'subsets' } };
875 :    
876 :     foreach my $subsetname ( @subsetArr ) {
877 :     next if ( $subsetname eq 'All' );
878 :     my @abb_subsets = keys %{ $meta->{ 'subsets' } };
879 :    
880 :     $subsets->{ $subsetname } = $meta->{ 'subsets' }->{ $subsetname };
881 :     }
882 :    
883 :     $self->{ 'data_roles' } = \@roles;
884 :     $self->{ 'data_subsets' } = $subsets;
885 :     $self->{ 'data_spreadsheethash' } = \%spreadsheethash;
886 :     $self->{ 'data_allpegs' } = $allpegs;
887 :    
888 :     }
889 :    
890 :     ######################################
891 :     # Panel for coloring the spreadsheet #
892 :     ######################################
893 :     sub limit_display_panel {
894 :    
895 :     my ( $self ) = @_;
896 :    
897 :     # create a new subsystem object #
898 :     my $subsets = $self->{ 'metasubsystem' }->{ 'subsets' };
899 :    
900 :     # my @tmp = grep { $_ ne "All" } sort $subsystem->get_subset_namesR;
901 :     my $genomes = $self->{ 'metasubsystem' }->{ 'genomes' };
902 :    
903 :     my %options = ( "higher_plants" => "Higher Plants",
904 :     "eukaryotic_ps" => "Photosynthetic Eukaryotes",
905 :     "nonoxygenic_ps" => "Anoxygenic Phototrophs",
906 :     "hundred_hundred" => "Hundred by a hundred",
907 :     "functional_coupling_paper" => "Functional Coupling Paper",
908 :     "cyano_or_plant" => "Cyanos OR Plants",
909 :     "ecoli_essentiality_paper" => "E. coli Essentiality Paper",
910 :     "has_essentiality_data" => "Genomes with essentiality data",
911 :     "" => "All"
912 :     );
913 :    
914 :     my @options = ( 'All',
915 :     'NMPDR',
916 :     'BRC',
917 :     'Hundred by a hundred' );
918 :    
919 :     my @genomeListsUser = GenomeLists::getListsForUser();
920 :     unshift @genomeListsUser, 'All';
921 :    
922 :     my @allsets = keys %$subsets;
923 :     # my @starsets = grep { ( $_ =~ /^\*/ ) } @allsets;
924 :     my @starsets = @allsets;
925 :    
926 :     my $content .= "<P>Limit display of the the genomes in the table based on phylogeny or one of the preselected groups in the left box. Limit display of roles via their subsets and decide which subsets you want to uncollapse in the right box:<P>\n";
927 :    
928 :     # put in table #
929 :     $content .= "<TABLE><TR><TD>";
930 :    
931 :     # build a little table for the genomes limiting
932 :     $content .= "<H2>&nbsp; Limit displayed Genomes</H2><TABLE><TR><TD>";
933 :    
934 :     $content .= "<B>Phylogeny</B></TD><TD><B>Specific Sets</B></TD><TD><B>User Sets</B></TD></TR><TR><TD>";
935 :    
936 :     # phylogeny here #
937 :     $content .= $self->{ 'cgi' }->scrolling_list( -id => 'phylogeny_set',
938 :     -name => 'phylogeny_set',
939 :     -values => [ "All", keys %$genomes ],
940 :     -default => 'All',
941 :     -size => 5
942 :     );
943 :     $content .= "</TD><TD>\n";
944 :    
945 :     # now special sets #
946 :     $content .= $self->{ 'cgi' }->scrolling_list( -id => 'special_set',
947 :     -name => 'special_set',
948 :     -values => \@options,
949 :     -default => 'All',
950 :     -size => 5
951 :     );
952 :     $content .= "</TD><TD>\n";
953 :    
954 :     # now special sets #
955 :     $content .= $self->{ 'cgi' }->scrolling_list( -id => 'user_set',
956 :     -name => 'user_set',
957 :     -values => \@genomeListsUser,
958 :     -default => 'All',
959 :     -size => 5
960 :     );
961 :     $content .= "</TD></TR></TABLE>\n";
962 :     $content .= "</TD></TR>\n</TABLE>";
963 :    
964 :     if ( $self->{ 'can_alter' } ) {
965 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Display' ONCLICK='SubmitSpreadsheet( \"LimitDisplay\", 3 );'>";
966 :     }
967 :     else {
968 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Display' ONCLICK='SubmitSpreadsheet( \"LimitDisplay\", 2 );'>";
969 :     }
970 :    
971 :     return $content;
972 :     }
973 :    
974 :    
975 :     ######################################
976 :     # Panel for coloring the spreadsheet #
977 :     ######################################
978 :     sub limit_subsets_panel {
979 :    
980 :     my ( $self ) = @_;
981 :    
982 :     # create a new subsystem object #
983 :     my $subsets = $self->{ 'metasubsystem' }->{ 'subsets' };
984 :    
985 :     my @allsets = keys %$subsets;
986 :     # my @starsets = grep { ( $_ =~ /^\*/ ) } @allsets;
987 :     my @starsets = @allsets;
988 :    
989 :     my @roles = @{ $self->{ 'data_roles' } };
990 :     my %roles;
991 :     foreach my $r ( @roles ) {
992 :     $roles{ $r->[0].'##-##'.$r->[3] } = $r;
993 :     }
994 :    
995 :     my $subsets_table = $self->application->component( 'LD_SUBSETS' );
996 :     my $roles_table = $self->application->component( 'LD_ROLES' );
997 :    
998 :     $subsets_table->columns( [ 'Name', 'Members', 'Show', 'Collapse' ] );
999 :     $roles_table->columns( [ 'Subsystem', '', '', '', '', '', '', '', '', '' ] );
1000 :    
1001 :     my $sstdata = [];
1002 :     foreach my $set ( @allsets ) {
1003 :     my $show_checked = $self->{ 'metasubsystem' }->{ 'view' }->{ 'Subsets' }->{ $set }->{ 'visible' } || 0;
1004 :     my $collapse_checked = $self->{ 'metasubsystem' }->{ 'view' }->{ 'Subsets' }->{ $set }->{ 'collapsed' } || 0;
1005 :    
1006 :     my $show_set = $self->{ 'cgi' }->checkbox( -name => 'show_set',
1007 :     -id => "show_set_$set",
1008 :     -value => "show_set_$set",
1009 :     -label => '',
1010 :     -checked => $show_checked,
1011 :     );
1012 :     my $collapse_set = $self->{ 'cgi' }->checkbox( -name => 'collapse_set',
1013 :     -id => "collapse_set_$set",
1014 :     -value => "collapse_set_$set",
1015 :     -label => '',
1016 :     -checked => $collapse_checked,
1017 :     );
1018 :    
1019 :     my @mems = keys %{ $subsets->{ $set } };
1020 :     foreach ( @mems ) {
1021 :     my $rolefullname = $_ . '##-##'. $subsets->{ $set }->{ $_ };
1022 :     delete $roles{ $rolefullname };
1023 :     }
1024 :    
1025 :     my $row = [ $set, { data => join( ', ', @mems ), tooltip => join( ', ', values %{ $subsets->{ $set } } ) },
1026 :     $show_set, $collapse_set ];
1027 :    
1028 :     push @$sstdata, $row;
1029 :     }
1030 :    
1031 :     my $rowdata = [];
1032 :     my %rowdatahash;
1033 :     foreach my $r ( sort keys %roles ) {
1034 :     my $checkid = "show_role_$r";
1035 :    
1036 :     my $show_checked = 0;
1037 :     if ( $self->{ 'metasubsystem' }->{ 'view' }->{ 'Roles' }->{ $r }->{ 'visible' } ) {
1038 :     $show_checked = 1;
1039 :     }
1040 :    
1041 :     my $show_set = $self->{ 'cgi' }->checkbox( -name => 'show_role',
1042 :     -id => "$checkid",
1043 :     -value => "$checkid",
1044 :     -label => '',
1045 :     -checked => $show_checked,
1046 :     );
1047 :     $r =~ /(.*)##-##.*/;
1048 :    
1049 :     $rowdatahash{ $roles{ $r }->[3] }->{ $1 }->{ 'funcrole' } = $roles{ $r }->[1];
1050 :     $rowdatahash{ $roles{ $r }->[3] }->{ $1 }->{ 'checkbox' } = $show_set;
1051 :     }
1052 :    
1053 :     my $isrow = 0;
1054 :     foreach my $subsys ( keys %rowdatahash ) {
1055 :     my $count = 0;
1056 :     my @row = ( $subsys );
1057 :     foreach my $abb ( keys %{ $rowdatahash{ $subsys } } ) {
1058 :     $count++;
1059 :     $isrow = 1;
1060 :     push @row, $abb."<BR>".$rowdatahash{ $subsys }->{ $abb }->{ 'checkbox' };
1061 :     if ( $count > 8 ) {
1062 :     $count = 0;
1063 :     push @$rowdata, [ @row ];
1064 :     @row = ( $subsys );
1065 :     }
1066 :     }
1067 :     if ( $count > 0 ) {
1068 :     for( my $i = $count; $i <= 8; $i++ ) {
1069 :     push @row, '';
1070 :     }
1071 :     push @$rowdata, [ @row ];
1072 :     }
1073 :     }
1074 :    
1075 :     $subsets_table->data( $sstdata );
1076 :     $roles_table->data( $rowdata );
1077 :    
1078 :     my $content = '<TABLE><TR>';
1079 :     $content .= "<TD><B>Subsets</B></TD></TR><TR>";
1080 :     $content .= "<TD>Choose which subsets should be visible, and for these if they should be displayed collapsed or show each role in a separate column.";
1081 :     $content .= "</TD></TR><TR><TD>";
1082 :     $content .= $subsets_table->output();
1083 :     if ( $isrow ) {
1084 :     $content .= '</TD></TR><TR>';
1085 :     $content .= "<TD><B>Functional Roles</B></TD></TR><TR>";
1086 :     $content .= "<TD>The following roles are not part of any defined subsystem. Check the roles you want to see in your display.</TD>";
1087 :     $content .= '</TR><TR><TD>';
1088 :     $content .= $roles_table->output();
1089 :     }
1090 :     $content .= '</TD></TR></TABLE>';
1091 :    
1092 :     if ( $self->{ 'can_alter' } ) {
1093 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Subsets and Functional Roles' ONCLICK='SubmitSpreadsheet( \"LimitSubsets\", 2 );'>";
1094 :     }
1095 :     else {
1096 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Subsets and Functional Roles' ONCLICK='SubmitSpreadsheet( \"LimitSubsets\", 2 );'>";
1097 :     }
1098 :    
1099 :     return $content;
1100 :     }
1101 :    
1102 :    
1103 :     sub fid_link {
1104 :     my ( $self, $fid ) = @_;
1105 :     my $n;
1106 :     my $seeduser = $self->{ 'seeduser' };
1107 :     $seeduser = '' if ( !defined( $seeduser ) );
1108 :    
1109 :     if ($fid =~ /^fig\|\d+\.\d+\.([a-zA-Z]+)\.(\d+)/) {
1110 :     if ( $1 eq "peg" ) {
1111 :     $n = $2;
1112 :     }
1113 :     else {
1114 :     $n = "$1.$2";
1115 :     }
1116 :     }
1117 :    
1118 :     return "./protein.cgi?prot=$fid&user=$seeduser\&new_framework=0";
1119 :     }
1120 :    
1121 :    
1122 :    
1123 :     sub get_color_by_attribute_infos {
1124 :    
1125 :     my ( $self, $fig, $attr, $pegsarr, $colors ) = @_;
1126 :    
1127 :     my $scalacolor = is_scala_attribute( $attr );
1128 :     my $peg_to_color_alround;
1129 :     my $cluster_colors_alround;
1130 :    
1131 :     if ( defined( $attr ) ) {
1132 :     my $groups_for_pegs = get_groups_for_pegs( $fig, $attr, $pegsarr );
1133 :     my $i = 0;
1134 :     my $biggestitem = 0;
1135 :     my $smallestitem = 100000000000;
1136 :    
1137 :     if ( $scalacolor ) {
1138 :     foreach my $item ( keys %$groups_for_pegs ) {
1139 :    
1140 :     if ( $biggestitem < $item ) {
1141 :     $biggestitem = $item;
1142 :     }
1143 :     if ( $smallestitem > $item ) {
1144 :     $smallestitem = $item;
1145 :     }
1146 :     }
1147 :     $self->{ 'legend' } = get_scala_legend( $biggestitem, $smallestitem, 'Color legend for CDSs' );
1148 :     }
1149 :    
1150 :     my $leghash;
1151 :     foreach my $item ( keys %$groups_for_pegs ) {
1152 :     foreach my $peg ( @{ $groups_for_pegs->{ $item } } ) {
1153 :     $peg_to_color_alround->{ $peg } = $i;
1154 :     }
1155 :    
1156 :     if ( $scalacolor ) {
1157 :     my $col = get_scalar_color( $item, $biggestitem, $smallestitem );
1158 :     $cluster_colors_alround->{ $i } = $col;
1159 :     }
1160 :     else {
1161 :     $cluster_colors_alround->{ $i } = $colors->[ scalar( keys( %$cluster_colors_alround ) ) ];
1162 :     $leghash->{ $item } = $cluster_colors_alround->{ $i };
1163 :     }
1164 :     $i++;
1165 :     }
1166 :     if ( !$scalacolor ) {
1167 :     $self->{ 'legend' } = get_value_legend( $leghash, 'Color Legend for CDSs' );
1168 :     }
1169 :     }
1170 :     return ( $peg_to_color_alround, $cluster_colors_alround );
1171 :     }
1172 :    
1173 :     sub get_peg_addition {
1174 :    
1175 :     my ( $self, $pegf ) = @_;
1176 :    
1177 :     my @frs = split( ' / ', $pegf );
1178 :     my $pegfnum = '';
1179 :    
1180 :     foreach ( @frs ) {
1181 :     my $m = $self->{ 'roles_to_num' }->{ $_ };
1182 :     next if ( !defined( $m ) );
1183 :    
1184 :     foreach my $pm ( @$m ) {
1185 :     my $pegfnumtmp = $pm->[0];
1186 :     $pegfnum .= '_'.$pegfnumtmp;
1187 :     }
1188 :     }
1189 :     return $pegfnum;
1190 :     }
1191 :    
1192 :     sub get_color_by_attribute_infos_for_genomes {
1193 :    
1194 :     my ( $self, $fig, $cgi, $spreadsheethash, $colors ) = @_;
1195 :    
1196 :     my $genomes_to_color;
1197 :     my $genome_colors;
1198 :     my $leghash;
1199 :     my $i = 0;
1200 :     my $biggestitem = 0;
1201 :     my $smallestitem = 100000000000;
1202 :    
1203 :     my $attr = $cgi->param( 'color_by_ga' );
1204 :     my $scalacolor = is_scala_attribute( $attr );
1205 :    
1206 :     my @genomes = keys %$spreadsheethash;
1207 :     my $groups_for_genomes = get_groups_for_pegs( $fig, $attr, \@genomes );
1208 :    
1209 :     if ( $scalacolor ) {
1210 :    
1211 :     foreach my $item ( keys %$groups_for_genomes ) {
1212 :    
1213 :     if ( $biggestitem < $item ) {
1214 :     $biggestitem = $item;
1215 :     }
1216 :     if ( $smallestitem > $item ) {
1217 :     $smallestitem = $item;
1218 :     }
1219 :     }
1220 :     $self->{ 'legendg' } = get_scala_legend( $biggestitem, $smallestitem, 'Color Legend for Genomes' );
1221 :     }
1222 :    
1223 :     foreach my $item ( keys %$groups_for_genomes ) {
1224 :     foreach my $g ( @{ $groups_for_genomes->{ $item } } ) {
1225 :     $genomes_to_color->{ $g } = $i;
1226 :     }
1227 :    
1228 :     if ( $scalacolor ) {
1229 :     my $col = get_scalar_color( $item, $biggestitem, $smallestitem );
1230 :     $genome_colors->{ $i } = $col;
1231 :     }
1232 :     else {
1233 :     $genome_colors->{ $i } = $colors->[ scalar( keys( %$genome_colors ) ) ];
1234 :     $leghash->{ $item } = $genome_colors->{ $i };
1235 :     }
1236 :     $i++;
1237 :     }
1238 :     if ( !$scalacolor ) {
1239 :     $self->{ 'legendg' } = get_value_legend( $leghash, 'Color Legend for Genomes' );
1240 :     }
1241 :    
1242 :     return ( $genomes_to_color, $genome_colors );
1243 :     }
1244 :    
1245 :    
1246 :     sub get_colors {
1247 :     my ( $self ) = @_;
1248 :    
1249 :     return [ '#d94242', '#eaec19', '#715ae5', '#25d729', '#f9ae1d', '#19b5b3', '#b519b3', '#ffa6ef',
1250 :     '#744747', '#701414', '#70a444', '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040',
1251 :     '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
1252 :     "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
1253 :     "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A",
1254 :     "#FFE4C4", "#FFB6C1", "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD",
1255 :     "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD", "#00FA9A", "#228B22", "#1E90FF", "#FA8072",
1256 :     "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4", "#D3D3D3", "#7B68EE", "#2F4F4F",
1257 :     "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1", "#6495ED", "#800080",
1258 :     "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C", "#EE82EE", "#7CFC00",
1259 :     "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520", "#008080", "#00FF7F",
1260 :     "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#00008B", "#5F9EA0", "#4169E1",
1261 :     "#20B2AA", "#8A2BE2", "#ADFF2F", "#556B2F", "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B",
1262 :     "#FF0000", "#F08080", "#7FFF00", "#8B0000", "#40E0D0", "#0000CD", "#48D1CC", "#8B008B",
1263 :     "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A", "#FFE4B5", "#B0C4DE", "#FAF0E6",
1264 :     "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF", "#000080", "#32CD32", "#FFFACD",
1265 :     "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585", "#BDB76B", "#00FFFF",
1266 :     "#FFDAB9", "#ADD8E6", "#778899" ];
1267 :     }
1268 :    
1269 :    
1270 :     #####################################################
1271 :     # List of attributes that are not used for coloring #
1272 :     #####################################################
1273 :     sub attribute_blacklist {
1274 :    
1275 :     my $list = { 'pfam-domain' => 1,
1276 :     'PFAM' => 1,
1277 :     'CDD' => 1 };
1278 :     return $list;
1279 :    
1280 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3