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

View of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (download) (annotate)
Tue Jul 12 21:20:46 2005 UTC (14 years, 8 months ago) by redwards
Branch: MAIN
Changes since 1.5: +0 -2 lines
removing error messages from subsys_vectors.cgi

# -*- perl -*-

=pod

=head1 subsys_vectors.cgi

Subsystem vectors is a page for displaying information about the functional variants for different subsystems in different genomes. The basic idea is to present a spreadsheet where the rows are organisms and the columns are subsystems. The cells will be variant codes.

We will add the ability to sort the table by any individual subsystem, genus species information, or taxonomy.

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.

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.

=cut

use strict;
use FIG; 
use HTML;
use raelib;
my $raelib=new raelib;
use CGI;
my $cgi=new CGI;

my $fig;
eval {
    $fig = new FIG;
};   

if ($@ ne "")
{
    my $err = $@;
    
    my(@html);
    
    push(@html, $cgi->p("Error connecting to SEED database."));
    if ($err =~ /Could not connect to DBI:.*could not connect to server/)
    {
        push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
    }   
    else
    {
        push(@html, $cgi->pre($err));
    }   
    &HTML::show_page($cgi, \@html, 1);
    exit;
}   
    
my $html = [];
my $user = $cgi->param('user');

unshift(@$html, "<TITLE>The SEED - Subsystem Vectors</TITLE>\n");



if ($cgi->param('korgs') && $cgi->param('subsystems'))
{
 &show_table($fig,$cgi,$html);
}
else 
{
 &show_initial($fig,$cgi,$html);
}

&HTML::show_page($cgi,$html,1);
exit;


sub show_initial {
 my ($fig,$cgi,$html)=@_;
 # generate a blank page
 push @$html,  
 $cgi->start_form(), 
 $cgi->p("Please enter your username: &nbsp; ", $cgi->textfield("user")),
 $cgi->p("Please choose some organisms from the list. You can choose more than one organism:"),
 $raelib->scrolling_org_list($cgi, 1),
 $cgi->p("Please choose some subsystems from the list. You can choose more than one subsystem."),
 $raelib->scrolling_subsys_list($cgi, 1),
 $cgi->p, $cgi->checkbox(-name=>'showempty', -label=>"Show empty columns"), $cgi->p,
 $cgi->checkbox(-name=>'showclassifications', -checked=>1, -label=>"Show classifications"), $cgi->p;
 
 # just define the sort order
 my $c=1;
 foreach my $s (sort {uc($a) cmp uc($b)} $fig->all_subsystems) {push @$html, $cgi->hidden("sort$s", $c); $c++}

 push @$html, $cgi->submit, $cgi->reset, $cgi->end_form;
 return $html; 
}

sub show_table {
 my ($fig,$cgi,$html)=@_;
 # what genomes are we interested in?
 my @genomes=$cgi->param('korgs');
 # and subsystems
 my @ss=$cgi->param('subsystems');
 # go through the subsystems and get the variant codes
 # 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
 # genome by genome and not col by col
 my $vc; my $class;
 foreach my $ss (@ss) {
  my $subsystem=$fig->get_subsystem($ss);
  $vc->{$ss}=undef; # this is so the keys later on work fine 
  foreach my $gen (@genomes) {
   if (defined $subsystem->get_variant_code_for_genome($gen)) {$vc->{$ss}->{$gen}=$subsystem->get_variant_code_for_genome($gen)};
  }
  $class->{$ss}=$fig->subsystem_classification($ss);
  unless ($class->{$ss}->[0]) {$class->{$ss}=["Unclassified", '']}
 }

 # now we want to remove any subsystem that is entirely blank
 my @removed;
 unless ($cgi->param('showempty')) { 
  foreach my $ss (keys %$vc) {
   my $keep=0;
   foreach my $gen (keys %{$vc->{$ss}}) {
    if (exists $vc->{$ss}->{$gen}) {$keep=1; last}
   }
   next if ($keep);
   # if we get here the column is empty, so we delete the ss, and put it in @removed.
   push @removed, $ss;
   delete $vc->{$ss};
  }
 }
   

 my @labels=$raelib->subsys_names_for_display(@ss);
 my %label;
 foreach my $i (0 .. @ss) {$label{$ss[$i]}=$labels[$i]}
 
 # sort the columns in the appropriate way
 @ss=sort {
 		uc($class->{$a}->[0]) cmp uc($class->{$b}->[0]) ||
 		uc($class->{$a}->[1]) cmp uc($class->{$b}->[1])
	  } keys %$vc;

 # now generate the table header
 my $col_hdrs=["Genome ID", "Organism"];

 # note the first two columns are now put in later, when we merge things.
 #my $class1=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
 #my $class2=[]; # note that the first 2 cols of class2 is from the rowspan in the previous line

 my $class1=[];
 my $class2=[];

 my $i=2;
 foreach my $ss (@ss) {
  push @$col_hdrs, "<a href='FIG/subsys.cgi?user=$user&subsys=$ss target=\"_blank\"'>$label{$ss}</a>";
  push @$class1, ($class->{$ss}->[0] or "Unclassified");
  push @$class2, ($class->{$ss}->[1] or '');
  $i++;
 }
 
 # merge adjacent columns that are the same. We use  a temp array to hold the data while we do this
 my $temp=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
 my $i=0;
 while ($i<=$#$class1) {
  my $colspan=1; 
  while ($i <= $#$class1 && $class1->[$i] eq $class1->[$i+1]) {$colspan++; $i++}
  push @$temp, [$class1->[$i], "td colspan=$colspan style='text-align: center'"];
  $i++;
 }
 $class1=$temp;
 # do the same thing for the bottom column
 $temp=[];
 my $i=0;
 while ($i<=$#$class2) {
  my $colspan=1; 
  while ($i <= scalar(@$class2) && $class2->[$i] eq $class2->[$i+1]) {$colspan++; $i++}
  push @$temp, [$class2->[$i], "td colspan=$colspan style='text-align: center'"];
  $i++;
 }
 $class2=$temp; 

 my $tab=[];
 # finally build the table
 foreach my $gen (@genomes) {
  my $row=[
   [$gen, "td class='genomeid'"],
   [$fig->genus_species($gen), "td class='genus_species'"]
  ];
  foreach my $ss (@ss) {
   if (exists $vc->{$ss}->{$gen}) {
    push @$row, [$vc->{$ss}->{$gen}, "td class='".${ss}."_".$vc->{$ss}->{$gen}."' style='text-align: center'"];
   }
   else {
    push @$row, " &nbsp; ";
   }
  }
  push @$tab, $row;
 }

 my $sort=$cgi->param('sortby');
 if ($sort =~ /^\d+$/) {
  # sort by a column number
  # all columns are refs to arrays, so we sort on the first element in the ref that defines the cell.
  # we sort on the $sort value which is the name of the column.
  # and we sort the rows of the table as $a and $b
  @$tab=sort {$a->[$sort]->[0] cmp  $b->[$sort]->[0]} @$tab;
 }
 elsif ($sort eq "by_phylo")
 {   
  # stolen from subsys.cgi 
  $tab = [map      { $_->[0] }
  sort     { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
  map      { [$_, $fig->taxonomy_of($_->[0]->[0])] }
  @$tab];
 }
 elsif ($sort eq "by_tax_id")
 {   
  $tab = [sort {$a->[0] <=> $b->[0]} @$tab];
 }

 # 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
 #now add a radio button column to allow sorting of rows by column
 my $sortcol=["<b>Sort by column</b>", "<input type='radio' name='sortby' value='1'>"];
 foreach my $i (2..$#ss+2) {push @$sortcol, "<input type='radio' name='sortby' value='$i'>"}
 unshift @$tab, $sortcol;

 # we want to add the first line of the table which has the default sort order
 my $firstrow=[['<b>Column Order</b>', 'td colspan=2 style="text-align: center"']];
 for (my $i=0; $i<scalar(@ss); $i++) {
  push @$firstrow, [$cgi->textfield(-name=>"sort$ss[$i]", -size=>4, -default=>$i+1, -override=>1), "td style='text-align: center'"];
 }
 unshift @$tab, $firstrow;

 # start the table with the classifications if we want them
 if ($cgi->param("showclassifications")) {unshift @$tab, $class1, $class2}
 
 
 
 my $emptyhtml;
 if (scalar(@removed)) {
  $emptyhtml="<h3>Empty Cells</h3><p>The following subsystems only contained empty cells and are not shown:<ul><li>";
  $emptyhtml.=join "</li>\n<li>", @removed;
  $emptyhtml.="</li></ul>\n";
 }
 
 push @$html,
  "<center><h2>Subsystem Vectors</h2></center>",
  $cgi->start_form, $cgi->hidden('user'),
  &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"),  "\n",
  $cgi->p($emptyhtml),
  $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", 
  $cgi->popup_menu(-name => 'sortby', -value => ['','by_phylo','by_tax_id'], -labels => {"by_phylo"=>"Phylogeny", "by_tax_id"=>"Taxonomic ID"}, -default=>''));
  
 unless ($cgi->param('nmpdr')) {
   push @$html, $cgi->p("You can modify your selected genomes:<br>", $raelib->scrolling_org_list($cgi, 1)),
   $cgi->p("You can modify your selected subsystems:<br>", $raelib->scrolling_subsys_list($cgi, 1)),
 }
 push @$html, $cgi->p, $cgi->submit, $cgi->reset,
  $cgi->end_form;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3