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

View of /FigWebServices/subsys_summary.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (annotate)
Sat Feb 12 19:28:04 2005 UTC (14 years, 9 months ago) by redwards
Branch: MAIN
Changes since 1.1: +47 -16 lines
added stats to subsys_summary.cgi

=pod

=head1

Create a summary of subsystems

=cut

use strict;
use FIG;
use HTML;
use 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;
}



$ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};

my $html = [];


if ($cgi->param('submit') eq "Summarize Subsystems")
{
 summarize_ss();
}
else
{
 show_initial();
}

unshift @$html, "<TITLE>The SEED - Subsystem summarizer </TITLE>\n";
&HTML::show_page($cgi, $html, 1);
exit;










sub summarize_ss {
 my @wants;
 foreach my $w ($cgi->param('korgs')) {
  $w =~ /\((\d+\.\d+)\)/;
  push @wants, $1;
 }
 

 my @th;
 if ($cgi->param('levels')) {push @th, ('Level 1', 'Level 2')}
 push @th, 'Subsystem'; # we should have this, at least
 if ($cgi->param('genomes')) {push @th, ('Organisms')}
 if ($cgi->param('stats')) {push @th, ('Roles', 'Total Pegs', @wants)}
 elsif ($cgi->param('roles')) {push @th, ('Roles', @wants)}

 my $tableheader="<tr><th>". (join "</th><th>", @th) . "</th></tr>\n\n";

 my $cols=scalar @th;
 my $table;
 foreach my $subsys ($fig->all_subsystems) {
  
  # add a header
  unless ($cgi->param('stats')) {$table .= "<tr><td colspan=$cols align=center><strong>Subsystem: $subsys</strong></td></tr>\n"}

  # figure out how many roles we have, as this will determine the number of rows in the table
  my @roles=$fig->subsystem_to_roles($subsys);
  my $rows=1;
  if (!$cgi->param('stats') && $cgi->param('roles')) {$rows=scalar @roles}
  
  # figure out which genomes are in this subsystem
  my %genomes;
  foreach my $gen (@{$fig->subsystem_genomes($subsys)}) {$genomes{$gen->[0]}=$gen->[1]}
   
  # start a new row for this data
  $table .= "\n<tr>\n";
  
  # get the classification if required
  if ($cgi->param('levels')) {
   # get the classification and make sure there are now 2 columns as andrei doesn't like #3.
   my $class=$fig->subsystem_classification($subsys);
   unless ($class) {@$class=(' &nbsp; ',' &nbsp; ')}
   unless ($$class[0]) {$$class[0] = " &nbsp; "} 
   unless ($$class[1]) {$$class[1] = " &nbsp; "}
   # remove anything more than $$class[1];
   @$class=($$class[0], $$class[1]); # could have done this with splice. Ech.
   
   $table .= "\n\t<td rowspan='$rows'>" . (join "</td>\n\t<td rowspan='$rows'>", (@$class)) . "</td>";
  }

  # add the subsystem to the table
  $table .= "\n\t<td><strong>$subsys<strong></td>";

  # add the genomes in the subsystem
  if ($cgi->param('genomes') && $cgi->param('stats')) {$table .= "\n\t<td rowspan='$rows'>" . (scalar keys %genomes) . " </td>"}
  elsif ($cgi->param('genomes')) {$table .= "\n\t<td rowspan='$rows'> &nbsp; " . (join "<br>\n", sort {$a cmp $b} values %genomes) . "</td>"}
 
  if ($cgi->param('stats')) {
   my $pegcount=0;
   $table .= "\n\t<td>" . (scalar @roles) . "</td>"; #number of roles in the subsystem
   my $pegcount; my $totalpegs;
   # there should be a quicker way of getting this ... ?
   foreach my $role (@roles) {
    foreach my $genome (keys %genomes) {
     my $count = scalar ($fig->pegs_in_subsystem_cell($subsys, $genome, $role));
     $pegcount->{$genome} += $count;
     $totalpegs += $count;
    }
   }
   
   $table .= "\n\t<td>$totalpegs</td>"; # all the pegs in the subsystem
   foreach my $w (@wants) {
    $table .= "\n\t<td>$pegcount->{$w}</td>"; # pegs for each of the chosen genomes
   }
   $table .= "</tr>\n";
  }
  elsif ($cgi->param('roles')) {
   # now add the roles
   my $first=1;
   foreach my $role (@roles) {
    my $genomeroles;
    foreach my $gen (@wants) {
     my $cell = ' &nbsp; '; 
     if ($genomes{$gen}) {
      foreach my $peg ($fig->pegs_in_subsystem_cell($subsys, $gen, $role)) {
       $cell .= &HTML::fid_link($cgi,$peg) . "; ";
      }
     }
     $genomeroles .= "\n\t<td>$cell</td>";
    }
    # because I am using rowspan to make long columns, we don't want the tr on the first of these.
    if ($first) {$table .= "\n\t<td>$role</td>" . $genomeroles . "</tr>\n"; $first=0}
    else {$table .= "\n\t<tr><td>$role</td>" . $genomeroles . "</tr>\n"}
   }
  }
  else {$table .= "</tr>\n"}
 }
 push @$html, ("\n<table border=1>" . $tableheader . $table . "</table>\n");
}   

  








sub show_initial {
    #############
    # 
    # Stolen from index.cgi
    # 
    # 
    
    my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' );

    #
    #  Canonical names must match the keywords used in the DBMS.  They are
    #  defined in compute_genome_counts.pl
    #
    my %canonical = (
        'All'                   =>  undef,
        'Archaea'               => 'Archaea',
        'Bacteria'              => 'Bacteria',
        'Eucarya'               => 'Eukaryota',
        'Viruses'               => 'Virus',
        'Environmental samples' => 'Environmental Sample'
        );
    
    my $req_dom = $cgi->param( 'domain' ) || 'All';
    my @domains = $cgi->radio_group( -name     => 'domain',
                                     -default  => $req_dom,
                                     -override => 1,
                                     -values   => [ @display ]
                                   );

    my $n_domain = 0;
    my %dom_num = map { ( $_, $n_domain++ ) } @display;
    my $req_dom_num = $dom_num{ $req_dom } || 0;

    #
    #  Viruses and Environmental samples must have completeness = All (that is
    #  how they are in the database).  Otherwise, default is Only "complete".
    #
    my $req_comp = ( $req_dom_num > $dom_num{ 'Eucarya' } ) ? 'All'
                 : $cgi->param( 'complete' ) || 'Only "complete"';
    my @complete = $cgi->radio_group( -name     => 'complete',
                                      -default  => $req_comp,
                                      -override => 1,
                                      -values   => [ 'All', 'Only "complete"' ]
                        );
    #
    #  Use $fig->genomes( complete, restricted, domain ) to get org list:
    #
    my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";
   
    my @orgs = sort map { my $org = $_; my $gs = $fig->genus_species($org); my $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }
               $fig->genomes( $complete, undef, $canonical{ $req_dom } );
    
    my $n_genomes = @orgs;

    push @$html,  $cgi->start_form, 
                  $cgi->h2("Please choose one or more organisms from the list below to see in the subsystems table"),
    		  "<TABLE>\n",
                  "   <TR>\n",
                  "      <TD>",
	          $cgi->scrolling_list( -name     => 'korgs',
                                        -size     => 10,
					-multiple => 1,
                                        -values   => \@orgs,
                                      ),
                  $cgi->br,
                  "$n_genomes genomes shown ",
                  $cgi->submit( 'Update List' ), $cgi->reset, $cgi->submit('submit', 'Summarize Subsystems'), 
                  "</TD>",
                  "      <TD>",
                  join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n",
                  join( "<br>", "<b>Completeness?</b>", @complete), "\n",
                  "</TD>",
                  "   </TR>\n",
                  "</TABLE>\n",
	          $cgi->p,
		  $cgi->checkbox(-name=>"stats", -label=>"Only show statistics", -checked=>'on'), $cgi->p,
		  $cgi->checkbox(-name=>"levels", -label=>"Show subsystem classification", -checked=>'on'), $cgi->p,
		  $cgi->checkbox(-name=>"genomes", -label=>"Show genomes in subsystem", -checked=>'on'), $cgi->p,
		  $cgi->checkbox(-name=>"roles", -label=>"Show roles in subsystem", -checked=>'on'), $cgi->p,
		  $cgi->end_form,

}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3