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

View of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.13 - (download) (annotate)
Mon Aug 21 21:49:31 2006 UTC (13 years, 9 months ago) by overbeek
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.12: +2 -2 lines
RAE: removing legacy static urls

# -*- perl -*-
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
# This file is part of the SEED Toolkit.
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.


=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.


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 = $@;
    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."));
        push(@html, $cgi->pre($err));
    &HTML::show_page($cgi, \@html, 1);
my $html = [];
my $user = $cgi->param('user');

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

if (($cgi->param('korgs') || $cgi->param('orgname')) && ($cgi->param('subsystems') || $cgi->param('allss')))


sub show_initial {
 my ($fig,$cgi,$html)=@_;
 # generate a blank page
 push @$html,  
 $cgi->p("Please enter your username: &nbsp; ", $cgi->textfield("user")),
 "You can enter the partial name of some organisms to choose from (e.g. Listeria): ", $cgi->textfield(-name=>"orgname", -size=>40), $cgi->p, "\n",
 $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 from the list or check this box to select them all",
 $cgi->checkbox(-name=>"allss", -label=>'')), "\n",
 $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;
 # partial genome name matching
 if ($cgi->param('orgname')) {
  @genomes=$fig->partial_genus_matching($cgi->param('orgname'), 1);
  $cgi->param('korgs', @genomes)
 else {
 # and subsystems
 my @ss;
 if ($cgi->param('allss')) {
  $cgi->param('subsystems', @ss);
 else {@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)};
  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

 my %tempkey;
 foreach (@ss) {$tempkey{$_}=$cgi->param("sort$_") or "1"} # this is a fake so if $cgi->param("sort$_") is undef it is still sorted
 @ss=sort {	
 		$tempkey{$a} <=> $tempkey{$b} ||
 		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='subsys.cgi?user=$user&ssa_name=$ss&request=show_ssa&can_alter=&check=&sort=by_phylo&show_clusters=1' target='_blank'>$label{$ss}</a>";
  push @$class1, ($class->{$ss}->[0] or "Unclassified");
  push @$class2, ($class->{$ss}->[1] or '');
 # 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'"];
 # do the same thing for the bottom column
 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'"];

 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])] }
 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>", map {"<a href='subsys.cgi?user=$user&ssa_name=$_&request=show_ssa&can_alter=&check=&sort=by_phylo&show_clusters=1' target='_blank'>$label{$_}</a>\n"} @removed;
 push @$html,
  "<center><h2>Subsystem Vectors</h2></center>",
  $cgi->start_form, $cgi->hidden('user'), $cgi->hidden('showempty'), $cgi->hidden('showclassifications'), "\n",
  &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"),  "\n",
  $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,

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3