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

View of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.56 - (download) (annotate)
Tue Sep 16 18:22:29 2008 UTC (11 years, 2 months ago) by parrello
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, 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_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, HEAD
Changes since 1.55: +93 -88 lines
Changed to use the SEED Viewer if invoked in NMPDR mode.

# -*- 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.
#

#### start ####

use FIG;
use FIG_Config;

use HTML;
use strict;
use CGI;
use FIG_CGI;

use TemplateObject;
use Tracer;

# initialize fig object
my ($fig, $cgi, $user) = FIG_CGI::init(debug_save   => 0,
                                       debug_load   => 0,
                                       print_params => 0);
my $nmpdr = (FIGRules::nmpdr_mode($cgi) ? 1 : 0);
if ($nmpdr) {
    my ($genome) = $cgi->param('genome');
    print  $cgi->redirect(-status => 302, -uri => "$FIG_Config::linkinSV?page=Organism;organism=$genome");
} else {
    print $cgi->header();
    
    
    # DISABLED ATTRIBUTES
    # I have disabled attributes because it is taking so long to load. The places where I have disabled them are marked with  "DISABLED ATTRIBUTES"
    # RAE 10/25/05
    
    # RAE: 3/21/06
    # Re-enabled attributes, but left old markers in place for now!
    
    my @genomes = $cgi->param('genome');
    my $request = $cgi->param('request');
    my $sprout_param = "&SPROUT=$nmpdr";
    
    if (!$request) {
        #
        # Support for coming here from the NMPDR pages, where we have a form
        # with a pair of submit buttons, one for subsystems summary, one for
        # reactions summary.
        #
    
        if ($cgi->param("show_reactions")) {
            $request = "show_reactions";
        } elsif ($cgi->param("show_subsystems")) {
            $request = "show_subsystems";
        } elsif (@genomes == 0) {
            $request = "show_all_genomes";
        }
    }
    
    my $to = TemplateObject->new($cgi, php => 'Stats', $request);
    $to->add("<TITLE>The SEED Statistics Page</TITLE>\n");
    
    # RAE This little loop will add any genomes for any proteins that we know about to the list
    push @genomes, map{$fig->genome_of($_)} $cgi->param('prot');
    
    my $parameters = { fig_object  => $fig,
                       table_style => 'plain',
                       fig_disk    => $FIG_Config::fig_disk . "/",
                       form_target => 'display_subsys.cgi'
    };
    
    # Format the header information.
    $to->titles($parameters);
    
    #### START PROCESSING ####
    
    if ($request eq "subsystems_summary") {
        $to->add(results => &subsys_summary($fig,$cgi,$sprout_param));
    } elsif ($request eq "edit_kv_stats") {
        $to->add(results => &edit_kv_stats($fig,$cgi,$cgi->param('genome'), $sprout_param));
    } elsif ($request eq "show_all_genomes") {
        $to->add(results => &table_of_genomes($fig,$cgi,$sprout_param));
    } elsif (! $request) {
    
        my $genome;
        foreach $genome (@genomes) {
            $to->append(results => &basic_stats($fig, $cgi, $genome, $sprout_param));
            $to->append(results => $cgi->hr);
            $to->append(results => &assignment_stats($fig, $cgi, $genome, $sprout_param));
            $to->append(results => $cgi->hr);
            $to->append(results => &kv_peg_stats($fig, $cgi, $genome, $sprout_param));
            $to->append(results => $cgi->hr);
            $to->append(results => &kv_stats($fig, $cgi, $genome, $sprout_param));
            my $user = $cgi->param('user');
            $to->append(results => "<a href=./genome_statistics.cgi?genome=$genome&request=show_subsystems&user=$user$sprout_param>Show Subsystems</a><br>\n");
            $to->append(results => "<a href=./genome_statistics.cgi?genome=$genome&request=show_reactions&user=$user$sprout_param>Show Reactions</a><br>\n");
            if (! $nmpdr && &model_for_genome($genome)) {
                $to->append(results => "<a href=./status_of_model.cgi?user=$user&model=$genome$sprout_param>PEGs in published reaction model that are not yet covered</a><br>\n");
            }
            $to->append(results => $cgi->br);
        }
    } elsif (@genomes == 0) {
        $to->add(results => "<h1>Sorry, you need to specify at least one valid genome</h1>\n");
    } else {
        $to->append(results => genome_search_box($fig,$cgi,$genomes[0],$sprout_param));
        if    ($request eq "hypo_sub") {
            $to->append(results => &handle_hypo_sub($fig,$cgi,$genomes[0],$sprout_param));
        } elsif ($request eq "hypo_nosub") {
            $to->append(results => &handle_hypo_nosub($fig,$cgi,$genomes[0],$sprout_param));
        } elsif ($request eq "nothypo_sub") {
            $to->append(results => &handle_nothypo_sub($fig,$cgi,$genomes[0],$sprout_param));
        } elsif ($request eq "nothypo_nosub") {
            $to->append(results => &handle_nothypo_nosub($fig,$cgi,$genomes[0],$sprout_param));
        } elsif ($request eq "show_subsystems") {
            $to->append(results => &handle_show_subsystems($fig,$cgi,$genomes[0],$sprout_param));
        } elsif ($request eq "show_reactions") {
            $to->append(results => &handle_show_reactions($fig,$cgi,$genomes[0],$sprout_param));
        } else {
            $to->append(results => $cgi->h1("Invalid request: $request"));
        }
    }
    print $to->finish();
}
1;

#  Only subroutines below


sub basic_stats {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my $retVal = "";
    my($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy, $contiglns) = &get_basic_stats($fig,$genome,$sprout_param);
    my $lenThing = "";
    if (! $sprout_param) {
        my $lentable="<table border=1><tr><th>Contig</th><th>Length</th></tr>\n" . join("\n", map {"<tr><td>$_</td><td>".&commify($contiglns->{$_})."</td></tr>\n"} sort {$contiglns->{$b} <=> $contiglns->{$a}} keys %$contiglns)."</table>\n\n";
        $lenThing = "<div style=\"margin-left: 100px\">$lentable</div>" . $cgi->br;
    }
    
    $retVal .= &genome_search_box($fig, $cgi, $genome,$sprout_param) . "\n";
    $retVal .= join("\n", $cgi->h1('Basic Statistics'),
                     "<b>Genome ID:</b> $genome", $cgi->br,
                     "<b>Name:</b> $gname", $cgi->br,
                     "<b>Size (bp):</b> $szdna", $cgi->br,
                     "<b>Number contigs:</b> $num_contigs", $cgi->br,
		     $lenThing,
                     "<b>Number CDSs:</b> $pegs", $cgi->br,
                     "<b>Number rnas:</b> $rnas", $cgi->br,
                     "<b>Taxonomy:</b> $taxonomy", $cgi->br,
                     "<b>Complete:</b> ", $fig->is_complete($genome)?"Yes":"No", $cgi->br,
                     "");
    $retVal .= project_description($fig, $genome );
    return $retVal;
}

# Sprout does not have project descriptions, so it returns a null string.
sub project_description {
    my ($fig, $genome) = @_;
    my $retVal = "";
    if (! is_sprout($fig) && -d $FIG_Config::organisms
                          && -d "$FIG_Config::organisms/$genome"
                          && -f "$FIG_Config::organisms/$genome/PROJECT") {
        Open(\*PROJECT, "<$FIG_Config::organisms/$genome/PROJECT" );
        my @project = <PROJECT>;
        close PROJECT;
        $retVal = join("\n", "<b>Project description:</b>\n<pre>",
            ( map { "    " . $_ } @project ),
            "</pre>"
            );
    }
    return $retVal;
}

# Put commas into a whole number.
sub commify {
    my($n) = @_;
    my(@n) = ();
    my($i);

    for ($i = (length($n) - 3); ($i > 0); $i -= 3)
    {
        unshift(@n,",",substr($n,$i,3));
    }
    unshift(@n,substr($n,0,$i+3));
    return join("",@n);
}

sub count_stats {
    my ($subsystem_data,$assignments_data) = @_;
    
    my $hypo_sub = 0;
    my $hypo_nosub = 0;
    my $nothypo_sub = 0;
    my $nothypo_nosub = 0;
    my %in = map { $_->[2] => 1 } @$subsystem_data;
    my $in = keys(%in);

    my %sscount = map { $_->[0] => 1 } @$subsystem_data;
    my $nss=scalar(keys(%sscount));

    foreach $_ (@$assignments_data)
    {
        my($peg,$func) = @$_;
        my $is_hypo = &FIG::hypo($func);

        if    ($is_hypo && $in{$peg})           { $hypo_sub++ }
        elsif ($is_hypo && ! $in{$peg})         { $hypo_nosub++ }
        elsif ((! $is_hypo) && (! $in{$peg}))   { $nothypo_nosub++ }
        elsif ((! $is_hypo) && $in{$peg})       { $nothypo_sub++ }
    }
    my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;

    my ($fracHS, $fracNHS, $fracHNS, $fracNHNS);

    if ($tot == 0) {
        $fracHS = sprintf "%4.2f", 0.0;
        $fracNHS = sprintf "%4.2f", 0.0;
        $fracHNS = sprintf "%4.2f", 0.0;
        $fracNHNS = sprintf "%4.2f", 0.0;
    } else {
        $fracHS = sprintf "%4.2f", $hypo_sub / $tot;
        $fracNHS = sprintf "%4.2f", $nothypo_sub / $tot;
        $fracHNS = sprintf "%4.2f", $hypo_nosub / $tot;
        $fracNHNS = sprintf "%4.2f", $nothypo_nosub / $tot;
    }
    return ($hypo_sub, $hypo_nosub, $nothypo_nosub, $nothypo_sub, $fracHS, $fracNHS, $fracHNS, $fracNHNS, $nss);
}

sub assignment_stats {
    my($fig,$cgi,$genome, $sprout_param) = @_;

    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);

    my ($hypo_sub, $hypo_nosub, $nothypo_nosub, $nothypo_sub, $fracHS, $fracNHS, $fracHNS, $fracNHNS, $nss) =
        count_stats($subsystem_data, $assignments_data);

    my $user = $cgi->param('user');
    my $subCount = $nss;
    if (! $sprout_param) {
        $subCount = "<a href=\"subsys_vectors.cgi?korgs=$genome&allss=1$sprout_param\">$nss</a>";
    }
    my $retVal = join("\n", "<table>",
                 "  <tr>",
                 "    <th align=left>Number of subsystems:</th>",
                 "    <td align=right>$subCount</td>",
                 "  </tr>",
                 "  <tr>",
                 "    <th align=left>PEGs with hypothetical functions and in subsystem:</th>",
                 "    <td align=right><a href=\"genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub$sprout_param\">$hypo_sub ($fracHS)</a></td>",
                 "  </tr>",
                 "  <tr>",
                 "    <th align=left>PEGs with nonhypothetical functions and in subsystem:</th>",
                 "    <td align=right><a href=\"genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub$sprout_param\">$nothypo_sub ($fracNHS)</a></td>",
                 "  </tr>",
                 "  <tr>",
                 "    <th align=left>PEGs with hypothetical functions and not in subsystem:</th>",
                 "    <td align=right><a href=\"genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub$sprout_param\">$hypo_nosub ($fracHNS)</a></td>",
                 "  </tr>",
                 "  <tr>",
                 "    <th align=left>PEGs with nonhypothetical functions and not in subsystem:</th>",
                 "    <td align=right><a href=\"genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub$sprout_param\">$nothypo_nosub ($fracNHNS)</a></td>",
                 "  </tr>",
                 "</table>",
                 "");
    return $retVal;
}

sub sub_stats {
    my($fig,$cgi,$genome, $sprout_param) = @_;

    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);

    my ($hypo_sub, $hypo_nosub, $nothypo_nosub, $nothypo_sub, $fracHS, $fracNHS, $fracHNS, $fracNHNS, $nss) =
        count_stats($subsystem_data, $assignments_data);
    
    return ($fracHS, $fracHNS, $fracNHS, $fracNHNS);
}

sub handle_show_subsystems {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my(%in,$sub,$role,$protein,$sub_link,$tuple,$categories);
    my $retVal = "";
    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
    my $active = $fig->active_subsystems($genome);
    $retVal .= $cgi->h1($genome) . "\n";
    foreach $_ (@$subsystem_data) {
        ($sub,$role,$protein) = @$_;
        if ($active->{$sub}) {
            push(@{$in{$sub}->{$role}},&HTML::fid_link($cgi,$protein,0) . ": " . scalar $fig->function_of($protein));
        }
    }

    my @subs = sort { ($a->[0] cmp $b->[0]) or
                      ($a->[1] cmp $b->[1]) or
                      ($a->[2] cmp $b->[2]) or
                      ($a->[3] cmp $b->[3]) or
                      ($a->[4] cmp $b->[4]) 
                    } 
               map { $sub = $_; 
                     $categories = $fig->subsystem_classification($sub);
                     $categories = ((@$categories > 0) && $categories->[0]) ? $categories : ["Misc"];
                     [@$categories,$sub] 
                   }
       keys(%in);

    my $last1 = "";
    my $last2 = "";
    foreach $tuple (@subs)
    {
        $sub = pop @{$tuple};
        my $topic = $tuple->[0];

        if ($topic ne $last1)
        {
            $retVal .= $cgi->h1($topic) . "\n";
            $last1 = $topic;
            $last2 = "";
        }

        $topic = $tuple->[1] ? $tuple->[1] : "";
        if ($topic && ($topic ne $last2))
        {
            $retVal .= $cgi->h2($topic) . "\n";
            $last2 = $topic;
        }

        $sub_link = &sub_link($cgi,$sub,$sprout_param);
        $retVal .= $cgi->h3($sub_link) . "\n";

        my $roles = [];
        foreach $role (sort keys(%{$in{$sub}}))
        {
            push(@$roles,$cgi->ul($cgi->li($in{$sub}->{$role})));
        }
        $retVal .= $cgi->ul($cgi->li($roles));
    }
    return $retVal;
}

sub handle_show_reactions {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my($react_for_role,$r,%topic,%reaction,$sub,$role,$protein,$sub_link,$tuple,$categories);
    my(%reactions_for_sub,%class,$reactions,$classL,$category);
    my $retVal = "";

    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);

    foreach $_ (@$subsystem_data)
    {
        ($sub,$role,$protein) = @$_;
        if (! defined($reactions_for_sub{$sub}))
        {
	    my $subsystem = $fig->get_subsystem($sub);
            if ( $subsystem ) {
	    	$reactions = $subsystem->get_reactions;
            	$reactions = $reactions ? $reactions : "";
            	$reactions_for_sub{$sub} = $reactions;
            	$class{$sub} = $fig->subsystem_classification($sub);
	    }
        }
        
        if (($reactions = $reactions_for_sub{$sub}) && ($react_for_role = $reactions->{$role}))
        {
            $classL = $class{$sub};
            $category = ((@$classL > 0) && $classL->[0]) ? $classL->[0] : "Misc";
            foreach $r (@$react_for_role)
            {
                if ($fig->valid_reaction_id($r))
                {
                    $reaction{$r}->{$protein} = 1;
                    $topic{$category}->{$r} = 1;
                }
            }
        }
    }

    my @all       = sort { $a cmp $b } keys(%topic);

    if (@all == 0) {
        $retVal .= $cgi->p("No class reactions found.") . "\n";
    }
    foreach $category (@all) {
        $retVal .= &show_class_react($fig,$cgi,$category,[keys(%{$topic{$category}})],\%reaction,$sprout_param);
    }

    if ($_ = $topic{"Misc"}) {
        $retVal .= &show_class_react($fig,$cgi,'Misc',[keys(%$_)],\%reaction,$sprout_param) . "\n";
    } else {
        $retVal .= $cgi->p("No misc reactions found.") . "\n";
    }
    return $retVal;
}

sub show_class_react {
    my($fig,$cgi,$class,$for_topic,$reaction,$sprout_param) = @_;
    my($r,@pegs,$peg);

    my $retVal = $cgi->h1($class) . "\n";
    foreach $r (sort @$for_topic)
    {
        my $disp_react = $fig->displayable_reaction($r);
        $disp_react =~ s/^R\d+\: //;

        my $rstring = &HTML::reaction_link($r) . ": $disp_react";
        $retVal .= $cgi->h2($rstring) . "\n";
        @pegs = sort { &FIG::by_fig_id($a,$b) } keys(%{$reaction->{$r}});
        $retVal .= "<ul>\n";
        foreach $peg (@pegs) {
            $retVal .= "<li>" . &HTML::fid_link($cgi,$peg) . " " . scalar $fig->function_of($peg) . "\n";
        }
        $retVal .= "</ul>\n";
    }
    return $retVal;
}

sub handle_hypo_sub {
    my($fig,$cgi,$genome,$sprout_param) = @_;

    my $retVal = "";
    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
    my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
    my $col_hdrs = ["PEG","Function","Subsystem"];
    my $tab = [];
    foreach $_ (@$assignments_data)
    {
        my($peg,$func) = @$_;
        if (&FIG::hypo($func) && ($subs{$peg}))
        {
            push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg},$sprout_param)]);
        }
    }
    $_ = @$tab;
    $retVal .= &HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs in Subsystems");
    return $retVal;
}

sub handle_hypo_nosub {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my $retVal = "";
    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
    my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
    my $col_hdrs = ["PEG","Function"];
    my $tab = [];
    foreach $_ (@$assignments_data)
    {
        my($peg,$func) = @$_;
        if (&FIG::hypo($func) && (! $subs{$peg}))
        {
            push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
        }
    }
    $_ = @$tab;
    $retVal .= &HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs NOT in Subsystems") . "\n";
    return $retVal;
}

sub handle_nothypo_sub {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my $retVal = "";
    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
    my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
    my $col_hdrs = ["PEG","Function","Subsystem"];
    my $tab = [];
    foreach $_ (@$assignments_data)
    {
        my($peg,$func) = @$_;
        if ((! &FIG::hypo($func)) && ($subs{$peg}))
        {
            push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg},$sprout_param)]);
        }
    }
    $_ = @$tab;
    $retVal .= &HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs in Subsystems");
    return $retVal;
}

sub handle_nothypo_nosub {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my $retVal = "";
    my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
    my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
    my $col_hdrs = ["PEG","Function"];
    my $tab = [];
    foreach $_ (@$assignments_data) {
        my($peg,$func) = @$_;
        if ((! &FIG::hypo($func)) && (! $subs{$peg})) {
            push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
        }
    }
    $_ = @$tab;
    $retVal .= &HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs NOT in Subsystems");
    return $retVal;
}

sub get_data {
    my($fig,$cgi,$genome) = @_;

    my $subsystem_data = $fig->get_genome_subsystem_data($genome);
    my $assignment_data = $fig->get_genome_assignment_data($genome);

    return ($subsystem_data,$assignment_data);
}

sub sub_link {
    my($cgi,$sub,$sprout_param) = @_;

    my $genome = $cgi->param('genome');
    my $user = $cgi->param('user');
    $user = defined($user) ? $user : "";
    my $sub_link = "<a href=./display_subsys.cgi?ssa_name=$sub$sprout_param&request=show_ssa&user=$user&focus=$genome&show_clusters=1>$sub</a>";

    return $sub_link;
}

sub get_basic_stats {
    my($fig,$genome,$sprout_param) = @_;

    my($gname,$szdna,$pegs,$rnas,$taxonomy) = $fig->get_genome_stats($genome);
    $szdna = &commify($szdna);
    my %contiglengths=map {$_=>$fig->contig_ln($genome, $_)} ($fig->all_contigs($genome));
    my $num_contigs = scalar keys %contiglengths;
    return ($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy, \%contiglengths);
}

sub table_of_genomes {
    my($fig,$cgi,$sprout_param) = @_;
    my(@genomes);
    my $retVal = "";
#    push(@$html,"<pre>\n");
    if ($cgi->param('complete'))
    {
        @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes("complete"));
    }
    else
    {
        @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes());
    }

    my (@rows, @headings);
    my $genome;
    #push(@$html,join("\t","Genome ID","Complete","Genome Name","Size (bp)","Number Contigs","CDSs","RNAs","Taxonomy") . "\n");

    @headings = ("Genome ID","Complete","Genome Name",
                 "Size (bp)", "Number Contigs", "CDSs", "Non-Hypothetical in Subsystem", "Non-Hypothetical not in Subsystem", "Hypothetical in Subsystem", "Hypothetical not in Subsystem", "RNAs","Taxonomy");
    @rows = $cgi->th(\@headings);

    my $title;

    my $user = $cgi->param('user');
    foreach $genome (@genomes)
    {
        if (! $nmpdr || -f "$FIG_Config::organisms/$genome/NMPDR") { 
                my ($name, $size, $number_contigs, $cds, $rnas, $tax) = &get_basic_stats($fig, $genome);
                my ($hs, $hns, $nhs, $nhns) = &sub_stats($fig, $cgi, $genome, $sprout_param);

                
                push(@rows,$cgi->td([$genome, $fig->is_complete($genome)?"Yes":"No",
                        $name, $size, $number_contigs, $cds,
                         " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub$sprout_param> $nhs</a>",
                         " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub$sprout_param> $nhns</a>",
                         " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub$sprout_param> $hs</a>",
                         " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub$sprout_param> $hns</a>",
                        $rnas, $tax]));
                        

        }
    }
    if ($sprout_param) {
        $title = "NMPDR Genome Statistics";
    } else {
        $title = "Genome Statistics";
    } 
    $retVal .= join("\n", $cgi->table({-border=>undef, -width=>'100%'},
        $cgi->caption($cgi->h1($title)),
        $cgi->Tr(\@rows),
        ""));
    return $retVal;
}

sub subsys_summary {
    my($fig,$sprout_param) = @_;
    my $retVal = "";
    my($Nsubs,$genome,$sub,$role,$peg,$genome_instances,%genomes_in_use,$peg_instances,%pegs_in_use);
    foreach $sub ($fig->all_subsystems)
    {
        $Nsubs++;
        foreach $genome (map { $_->[0] } @{$fig->subsystem_genomes($sub)})
        {
            $genome_instances++;
            $genomes_in_use{$genome}++;
            foreach $role ($fig->subsystem_to_roles($sub))
            {
                foreach $peg ($fig->pegs_in_subsystem_cell($sub,$genome,$role))
                {
                    $peg_instances++;
                    $pegs_in_use{$peg}++;
                }
            }
        }
    }
    my $Ngenomes = scalar keys(%genomes_in_use);
    my $Npegs    = scalar keys(%pegs_in_use);
    my $g_in_sub = int($genome_instances / $Nsubs);
    my $p_in_sub = int($peg_instances / $Nsubs);
    $retVal .= $cgi->h1('Subsystem Summary') . "\n";
    $retVal .= join("\n", $cgi->br,
                "<b>Number Subsystems:</b> $Nsubs",$cgi->br,
                "<b>Genomes in Subsystems:</b> $Ngenomes",$cgi->br,
                "<b>PEGs in Subsystems:</b> $Npegs",$cgi->br,
                "<b>Avg genomes per subsystem:</b> $g_in_sub",$cgi->br,
                "<b>Avg PEGs per subsystem:</b> $p_in_sub",$cgi->br,
                "");
    return $retVal;
}

sub kv_peg_stats {
 my ($fig, $cgi, $genome, $sprout_param)=@_;
 my $retVal = "";
 #RAE Added the coverage of each genome with different attributes for the PEGs to find the number of genes that have attributes
 
 # DISABLED ATTRIBUTES
 #my $pegtags;
 #push(@$html, "Sorry attributes are not working\n");
 Trace("PEG Attributes requested. Sprout param is $sprout_param.") if T(3);
 if (! $sprout_param) {
    $retVal .= "\n<div class=\"pegattributes\">\n<p><h2>PEG Attributes for " . $fig->genus_species($genome) . "</h2></p>\n";
       
    my $count;
    foreach my $res ($fig->get_peg_keys_for_genome($genome)) {
       $count->{$res->[1]}++;
    }
    
    $retVal .= join("\n",
           "<div class='tags'>", 
           (map {"PEGS with attribute:  &nbsp; $_  :  ".$count->{$_}."<br />\n"} sort {$count->{$b} <=> $count->{$a}} keys %$count), 
           "</div></div>",
           ""
       );
 }
} 

sub kv_stats {
 my ($fig, $cgi, $genome, $sprout_param, $edit) = @_;

 # RAE Added tables for key value pairs for an organism, and allow you to edit them
 # figure out kv's for the organism, and make a table with them
 
 # if the optional edit boolean is set and a user is supplied, we will make a table where you can edit the KV pairs
 # else we will just make a blank table
 
 # prepare the html so we can add form fields here
 my $retVal = "";
 Trace("PEG Attributes requested. Sprout param is $sprout_param.") if T(3);
 if (! $sprout_param) {
    $retVal .= "\n<div class=\"attributes\">\n<p><h2>Attributes for " . $fig->genus_species($genome) . "</h2></p>\n";
    if ($edit) { $retVal .= $cgi->start_form(-action=>"genome_statistics.cgi"); }
   
    
    my $tab=[];
    my $user=$cgi->param('user');
    my $col_hdrs=["Attribute", "Value"];
    if ($user && $edit) {$col_hdrs=["Attribute", "Value", "URL"]}
   
    my $known;
    # DISABLED ATTRIBUTES
    # to disable attributes uncomment the two next lines and comment out the foreach my $key line
    #if (0) {
    # my $key; # remove this if reenabling attributes
    foreach my $key (sort {$a->[1] cmp $b->[1]} $fig->get_attributes($genome)) {
     $known->{$key->[1]}=1;
     if ($user && $edit) {
      push @$tab, 
       [
          $key->[1], 
          $cgi->textfield(-name=>"value.".$key->[1], -default=>$key->[2], -size=>50), 
          $cgi->textfield(-name=>"url.".$key->[1], -default=>$key->[3], -size=>50),
       ];
     } else {
      if ($key->[3] && $key->[3] =~ /^http/) {$key->[2] = "<a href=\"" . $key->[3] . "\">". $key->[2] . "</a>"}
      push @$tab, 
       [
          $key->[1], 
          $key->[2],
       ];
      }
     }
    if ($edit) {
     # now we want to add some pull down menus for things that we can add. And some blank boxes too for free text entry.
     # start with three of each
     my $opt=$fig->get_tags("genome"); # all the tags we know about
     my @options=sort {uc($a) cmp uc($b)} grep {!$known->{$_}} keys %$opt;
     unshift(@options, undef); # a blank field at the start
     for (my $i=1; $i<= (scalar @options + 5); $i++) {
      
      # we have the options, and 5 blank fields for free text entry
      my $choice=$cgi->popup_menu(-name=>"key.$i", -values=>\@options);
      if ($i >= scalar @options) {$choice = $cgi->textfield(-name=>"key.$i", -size=>50)}
      push @$tab, 
        [  
           $choice,
           $cgi->textfield(-name=>"value.$i", -size=>50), 
           $cgi->textfield(-name=>"url.$i", -size=>50),
        ];
     }
     # we need to know how many possibilities we have to look through later. Just pass it as a hidden, rather than counting it next time
     $retVal .= $cgi->hidden(-name=>"max new keys", -value=>scalar @options + 5);
    }
   
    # now just write the html
    $retVal .= &HTML::make_table($col_hdrs,$tab,"Attributes");
    if ($edit) {
     $retVal .= $cgi->hidden("genome") . $cgi->hidden("user") . $cgi->hidden("request");
     $retVal .= $cgi->submit('Change') . $cgi->reset();
    }
    $retVal .= "<p><a href=./genome_statistics.cgi?genome=$genome&request=edit_kv_stats&change=0&user=$user>Edit Key Value Pairs</a></p>\n</div>\n";
 }
 return $retVal;
} 


sub edit_kv_stats {
 my ($fig, $cgi, $genome, $sprout_param)=@_;
 
 my $retVal = "";
 if ($sprout_param) {
    $retVal .= "<h2>Error: invalid request for NMPDR.</h2>";
 } else {
    if ($cgi->param("Change")) {
     # we have changed the values
     # get the old kv pairs so we can see what has changed
     my $changed; my $deleted;
     foreach my $key ($fig->get_attributes($genome)) {
      if (!$cgi->param('value.'.$key->[1]) && !$cgi->param('url.'.$key->[1])) {
       $fig->delete_attribute($genome, $key->[1]);
       push @$key, ["deleted", "td colspan=2 style=\"text-align: center\""];
       push @$deleted, $key;
      }
      elsif (($cgi->param('value.'.$key->[1]) ne $key->[2]) || ($cgi->param('url.'.$key->[1]) ne $key->[3]))  {
        $fig->change_attribute($genome, $key->[1], $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]));
        push @$key, $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]);
        push @$changed, $key;
      }
     }
     
     my $added;
     for (my $i=0; $i <= $cgi->param("max new keys"); $i++) {
      if ($cgi->param("key.$i")) {
       $fig->add_attribute($genome, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"));
       push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
      }
     }
   
     # now all we have to do is create a table to report what we have done.
     my $tab=[];
     $retVal .= join("\n", "<div class=\"altered\"><p><h2>Attributes Altered for ",
                     $fig->genus_species($genome), " ($genome)</h2></p>",
                     "");
     my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
     if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
     if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
     if ($added)   {push @$tab, [["<strong>Added Attributes",   "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}
     
     $retVal .= &HTML::make_table($col_hdrs,$tab,"Changed Data");
    }
    else {
     $retVal = kv_stats($fig, $cgi, $genome, $sprout_param, 1);
    }
 }
 return $retVal;
}

sub model_for_genome {
    my($genome) = @_;

    return -s "$FIG_Config::global/Models/$genome";
}


sub genome_search_box {
    my($fig,$cgi,$genome,$sprout_param) = @_;
    my @arr = ();
    if ($sprout_param) {
        @arr=(
                $cgi->start_form(-action => "SearchSkeleton.cgi"),
                $cgi->hidden(-name => "Class",      -value => "FidSearch"),
                $cgi->hidden(-name => "genome",     -value => "$genome"),
                $cgi->hidden(-name => "subsystem",  -value => "(all)"),
                $cgi->h1("Search in ", $fig->genus_species($genome), " : &nbsp; ",
                    $cgi->textfield(-name => "keywords", -size => 20),
                    $cgi->submit(-name => "Search", -value => "Go"),
                   ),
                $cgi->end_form
             );
    } else {
        @arr=(
                $cgi->start_form(-action=>"index.cgi"), 
                $cgi->hidden(-name=>"korgs", -value=>"($genome)"),
                $cgi->hidden(-name=>"Search genome selected below", -value=>1),
                $cgi->hidden(-name=>"user"),
                $cgi->h1("Search in ", $fig->genus_species($genome), " : &nbsp; ",
                    $cgi->textfield(-name=>"pattern", -size=>20),
                    ),
                $cgi->submit, $cgi->reset, $cgi->end_form
            );
    }
    return join("", @arr);
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3