[Bio] / FigWebServices / subsys_vectors.cgi Repository:
ViewVC logotype

Diff of /FigWebServices/subsys_vectors.cgi

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

revision 1.4, Sat Jul 9 21:46:15 2005 UTC revision 1.5, Tue Jul 12 21:08:09 2005 UTC
# Line 10  Line 10 
10    
11  Coloring will be done by css with some css code somewhere (not sure where yet). Each cell will be given a class equal to subsysname."_".functionalvariant. If you set the value of $color{subsysname."_".functionalvariant} it will be set the color of the cell using css. hopefully.  Coloring will be done by css with some css code somewhere (not sure where yet). Each cell will be given a class equal to subsysname."_".functionalvariant. If you set the value of $color{subsysname."_".functionalvariant} it will be set the color of the cell using css. hopefully.
12    
13    There are two different variants of this code. If the cgi->param('nmpdr') is true, only a limited subset of functionality will be display. This is for the links from the NMPDR sites.
14    
15  =cut  =cut
16    
17  use strict;  use strict;
# Line 74  Line 76 
76   $raelib->scrolling_org_list($cgi, 1),   $raelib->scrolling_org_list($cgi, 1),
77   $cgi->p("Please choose some subsystems from the list. You can choose more than one subsystem."),   $cgi->p("Please choose some subsystems from the list. You can choose more than one subsystem."),
78   $raelib->scrolling_subsys_list($cgi, 1),   $raelib->scrolling_subsys_list($cgi, 1),
79   $cgi->p;   $cgi->p, $cgi->checkbox(-name=>'showempty', -label=>"Show empty columns"), $cgi->p,
80     $cgi->checkbox(-name=>'showclassifications', -checked=>1, -label=>"Show classifications"), $cgi->p;
81    
82   # just define the sort order   # just define the sort order
83   my $c=1;   my $c=1;
84   foreach my $s (sort {uc($a) cmp uc($b)} $fig->all_subsystems) {push @$html, $cgi->hidden("sort$s", $c); $c++}   foreach my $s (sort {uc($a) cmp uc($b)} $fig->all_subsystems) {push @$html, $cgi->hidden("sort$s", $c); $c++}
85    
86   push @$html,   push @$html, $cgi->submit, $cgi->reset, $cgi->end_form;
  $cgi->submit, $cgi->reset, $cgi->end_form;  
87   return $html;   return $html;
88  }  }
89    
# Line 90  Line 92 
92   # what genomes are we interested in?   # what genomes are we interested in?
93   my @genomes=$cgi->param('korgs');   my @genomes=$cgi->param('korgs');
94   # and subsystems   # and subsystems
95   my @ss=sort {$cgi->param("sort$a") <=> $cgi->param("sort$b") || uc($a) cmp uc($b)} $cgi->param('subsystems');   my @ss=$cgi->param('subsystems');
96   # go through the subsystems and get the variant codes   # go through the subsystems and get the variant codes
97   # we do this first because we can load a subsystem and then get all vcs for it. Then when we do the table, we buuild it   # we do this first because we can load a subsystem and then get all vcs for it. Then when we do the table, we buuild it
98   # genome by genome and not col by col   # genome by genome and not col by col
99   my $vc;   my $vc; my $class;
100   foreach my $ss (@ss) {   foreach my $ss (@ss) {
101    my $subsystem=$fig->get_subsystem($ss);    my $subsystem=$fig->get_subsystem($ss);
102      $vc->{$ss}=undef; # this is so the keys later on work fine
103    foreach my $gen (@genomes) {    foreach my $gen (@genomes) {
104     if ($subsystem->get_variant_code_for_genome($gen)) {$vc->{$ss}->{$gen}=$subsystem->get_variant_code_for_genome($gen)}     if (defined $subsystem->get_variant_code_for_genome($gen)) {$vc->{$ss}->{$gen}=$subsystem->get_variant_code_for_genome($gen)};
105     else {$vc->{$ss}->{$gen}=" &nbsp; "}    }
106      $class->{$ss}=$fig->subsystem_classification($ss);
107      unless ($class->{$ss}->[0]) {$class->{$ss}=["Unclassified", '']}
108      print STDERR "$ss\t", $class->{$ss}->[0], "\n";
109     }
110    
111     # now we want to remove any subsystem that is entirely blank
112     my @removed;
113     unless ($cgi->param('showempty')) {
114      foreach my $ss (keys %$vc) {
115       my $keep=0;
116       foreach my $gen (keys %{$vc->{$ss}}) {
117        if (exists $vc->{$ss}->{$gen}) {$keep=1; last}
118       }
119       next if ($keep);
120       # if we get here the column is empty, so we delete the ss, and put it in @removed.
121       push @removed, $ss;
122       delete $vc->{$ss};
123    }    }
124   }   }
125    
126    
127     my @labels=$raelib->subsys_names_for_display(@ss);
128     my %label;
129     foreach my $i (0 .. @ss) {$label{$ss[$i]}=$labels[$i]}
130    
131     # sort the columns in the appropriate way
132     @ss=sort {
133                    uc($class->{$a}->[0]) cmp uc($class->{$b}->[0]) ||
134                    uc($class->{$a}->[1]) cmp uc($class->{$b}->[1])
135              } keys %$vc;
136    
137   # now generate the table header   # now generate the table header
138   my $selfurl=$cgi->self_url;   my $col_hdrs=["Genome ID", "Organism"];
  $selfurl =~ s/(;?&?)sortby=.*?;?&?/$1/g;  
139    
140   my $col_hdrs=[   # note the first two columns are now put in later, when we merge things.
141          "<a href='$selfurl;sortby=0'>Genome ID</a>",   #my $class1=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
142          "<a href='$selfurl;sortby=1'>Organism</a>"   #my $class2=[]; # note that the first 2 cols of class2 is from the rowspan in the previous line
  ];  
143    
144   my @labels=$raelib->subsys_names_for_display(@ss);   my $class1=[];
145   for (my $i=2; $i<=(scalar(@ss)+2); $i++) {   my $class2=[];
146    push @$col_hdrs, "<a href='$selfurl;sortby=$i'>".$labels[$i-2]."</a>";  
147     my $i=2;
148     foreach my $ss (@ss) {
149      push @$col_hdrs, "<a href='FIG/subsys.cgi?user=$user&subsys=$ss target=\"_blank\"'>$label{$ss}</a>";
150      push @$class1, ($class->{$ss}->[0] or "Unclassified");
151      push @$class2, ($class->{$ss}->[1] or '');
152      $i++;
153     }
154    
155     # merge adjacent columns that are the same. We use  a temp array to hold the data while we do this
156     my $temp=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
157     my $i=0;
158     while ($i<=$#$class1) {
159      my $colspan=1;
160      while ($i <= $#$class1 && $class1->[$i] eq $class1->[$i+1]) {$colspan++; $i++}
161      push @$temp, [$class1->[$i], "td colspan=$colspan style='text-align: center'"];
162      $i++;
163     }
164     $class1=$temp;
165     # do the same thing for the bottom column
166     $temp=[];
167     my $i=0;
168     while ($i<=$#$class2) {
169      my $colspan=1;
170      while ($i <= scalar(@$class2) && $class2->[$i] eq $class2->[$i+1]) {$colspan++; $i++}
171      push @$temp, [$class2->[$i], "td colspan=$colspan style='text-align: center'"];
172      $i++;
173   }   }
174     $class2=$temp;
175    
176   my $tab=[];   my $tab=[];
177     # finally build the table
178   foreach my $gen (@genomes) {   foreach my $gen (@genomes) {
179    my $row=[    my $row=[
180     [$gen, "td class='genomeid'"],     [$gen, "td class='genomeid'"],
181     [$fig->genus_species($gen), "td class='genus_species'"]     [$fig->genus_species($gen), "td class='genus_species'"]
182    ];    ];
183    foreach my $ss (@ss) {    foreach my $ss (@ss) {
184       if (exists $vc->{$ss}->{$gen}) {
185     push @$row, [$vc->{$ss}->{$gen}, "td class='".${ss}."_".$vc->{$ss}->{$gen}."' style='text-align: center'"];     push @$row, [$vc->{$ss}->{$gen}, "td class='".${ss}."_".$vc->{$ss}->{$gen}."' style='text-align: center'"];
186    }    }
187       else {
188        push @$row, " &nbsp; ";
189       }
190      }
191    push @$tab, $row;    push @$tab, $row;
192   }   }
193    
194   my $sort=$cgi->param('sortby');   my $sort=$cgi->param('sortby');
  print STDERR "Sorting by $sort\n";  
195   if ($sort =~ /^\d+$/) {   if ($sort =~ /^\d+$/) {
196    # sort by a column number    # sort by a column number
197    # all columns are refs to arrays, so we sort on the first element in the ref that defines the cell.    # all columns are refs to arrays, so we sort on the first element in the ref that defines the cell.
# Line 152  Line 212 
212    $tab = [sort     { $a->[0] <=> $b->[0] } @$tab];    $tab = [sort     { $a->[0] <=> $b->[0] } @$tab];
213   }   }
214    
215     # we are going to build the top three or four rows in reverese order. We do this after the column sort to make sure that it works
216     #now add a radio button column to allow sorting of rows by column
217     my $sortcol=["<b>Sort by column</b>", "<input type='radio' name='sortby' value='1'>"];
218     foreach my $i (2..$#ss+2) {push @$sortcol, "<input type='radio' name='sortby' value='$i'>"}
219     unshift @$tab, $sortcol;
220    
221   # finally we want to add the first line of the table which has the default sort order   # we want to add the first line of the table which has the default sort order
222   my $firstrow=[['<b>Column Order</b>', 'td colspan=2 style="text-align: center"']];   my $firstrow=[['<b>Column Order</b>', 'td colspan=2 style="text-align: center"']];
223   for (my $i=0; $i<scalar(@ss); $i++) {   for (my $i=0; $i<scalar(@ss); $i++) {
224    push @$firstrow, [$cgi->textfield(-name=>"sort$ss[$i]", -size=>4, -default=>$i+1, -override=>1), "td style='text-align: center'"];    push @$firstrow, [$cgi->textfield(-name=>"sort$ss[$i]", -size=>4, -default=>$i+1, -override=>1), "td style='text-align: center'"];
225   }   }
226   unshift @$tab, $firstrow;   unshift @$tab, $firstrow;
227    
228     # start the table with the classifications if we want them
229     if ($cgi->param("showclassifications")) {unshift @$tab, $class1, $class2}
230    
231    
232    
233     my $emptyhtml;
234     print STDERR "Removed contains ", scalar(@removed), " entries\n";
235     if (scalar(@removed)) {
236      $emptyhtml="<h3>Empty Cells</h3><p>The following subsystems only contained empty cells and are not shown:<ul><li>";
237      $emptyhtml.=join "</li>\n<li>", @removed;
238      $emptyhtml.="</li></ul>\n";
239     }
240    
241   push @$html,   push @$html,
242    "<center><h2>Subsystem Vectors</h2></center>",    "<center><h2>Subsystem Vectors</h2></center>",
243    $cgi->start_form, $cgi->hidden('user'),    $cgi->start_form, $cgi->hidden('user'),
244    &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"),  "\n",    &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"),  "\n",
245    $cgi->p("You may sort by an individual column by clicking on that column header, or you may sort by one of these options",    $cgi->p($emptyhtml),
246    $cgi->popup_menu(-name => 'sortby', -value => ['','by_phylo','by_tax_id'], -labels => {"by_phylo"=>"Phylogeny", "by_tax_id"=>"Taxonomic ID"}, -default=>'')),    $cgi->p("You may sort by an individual column by picking it using the radio buttons, or you may sort by one of these options",
247    $cgi->p("You can modify your selected genomes:<br>", $raelib->scrolling_org_list($cgi, 1)),    $cgi->popup_menu(-name => 'sortby', -value => ['','by_phylo','by_tax_id'], -labels => {"by_phylo"=>"Phylogeny", "by_tax_id"=>"Taxonomic ID"}, -default=>''));
248    
249     unless ($cgi->param('nmpdr')) {
250       push @$html, $cgi->p("You can modify your selected genomes:<br>", $raelib->scrolling_org_list($cgi, 1)),
251    $cgi->p("You can modify your selected subsystems:<br>", $raelib->scrolling_subsys_list($cgi, 1)),    $cgi->p("You can modify your selected subsystems:<br>", $raelib->scrolling_subsys_list($cgi, 1)),
252    $cgi->p, $cgi->submit, $cgi->reset,   }
253     push @$html, $cgi->p, $cgi->submit, $cgi->reset,
254    $cgi->end_form;    $cgi->end_form;
255  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3