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

View of /FigWebServices/close_genome_discrepancies.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.8 - (download) (annotate)
Thu Sep 21 19:03:21 2006 UTC (13 years, 1 month ago) by redwards
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.7: +4 -4 lines
minor updates to ev code and default params

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

use HTML;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use UnvSubsys;
my $fig=new FIG;
use raelib; 
my $raelib=new raelib;
my $cgi=new CGI;
my $html=["<TITLE>Discrepancies between close genomes</TITLE>"];

my @orgs=sort {$fig->genus_species($a) cmp $fig->genus_species($b)} $cgi->param('korgs');
unless (@orgs > 1)
    push @$html, (
    $cgi->h1("<center>Discrepancies between close genomes</center>"),
    $cgi->p("Please enter your username", $cgi->textfield(-name=>"user", -size=>20)),
    $cgi->p("Please choose more than one genome from the menu, and a list of all discrepant pegs will be generated for you."),
    $raelib->scrolling_org_list($cgi, 1),
    $cgi->p("Maximum pegs per page", $cgi->textfield(-name=>"max", -value=>50, -size=>5)),
    $cgi->submit, $cgi->reset,
    &HTML::show_page($cgi, $html, 1);

my $wanted={map {($_=>1)} @orgs};

my $key_org   = $cgi->param('key_org');
my $first_peg = $cgi->param('first_peg');
my $maxN      = $cgi->param('maxN');
my $maxP      = $cgi->param('maxP');
my $user      = $cgi->param('user');
my $max       = $cgi->param('max');

unless ($key_org) {$key_org=$orgs[0]}
unless ($maxN) {$maxN=50}
unless ($maxP) {$maxP=1e-20}
unless ($max) {$max=10}

my $keep=0;
undef $first_peg unless ($key_org eq $fig->genome_of($first_peg));
unless ($first_peg) {$keep=1}

my $last_peg;
my $pegct; my $pegsofar;
foreach my $peg (sort {$fig->feature_location($a) cmp $fig->feature_location($b)} $fig->pegs_of($key_org))
    my $tab;
    ($peg eq $first_peg) ? ($keep=1) : 1;
    unless ($keep) {$pegsofar++; next}
    next if ($keep > $max);
    my $fn=$fig->function_of($peg, $user);
    my @inc=($peg);
    my %function;
    foreach my $sim ($fig->sims($peg, $maxN, $maxP, "figx"))
        next unless ($wanted->{$fig->genome_of($sim->[1])});
        $fn=$fig->function_of($sim->[1], $user);
        push @inc, $sim->[1];

    next unless (scalar(keys %function) > 1); # don't keep if they all have the same function

# what are the orders of the functions (for the colors)
    my $cnt=0;
    my %position;
    foreach my $fn (sort {$function{$b} <=> $function{$a}} keys %function) {$position{$fn}=$cnt++}
    my @colors= UnvSubsys::cool_colors();
    my %genomect;
    foreach my $peg (sort {$fig->genome_of($a) cmp $fig->genome_of($b)} @inc)
        my $user_entry = &HTML::fid_link( $cgi, $peg );
        if ($user)
            $user_entry = $cgi->checkbox(-name => 'checked', -label => '', -value => $peg) . "&nbsp; $user_entry";

        my $fn = $fig->function_of($peg,$user);
# note that %function has the nummber of functions with this annotation
        my $color="#FFFFFF";
        if ($fn) {$color=$colors[$position{$fn}]}
# add the annotation checkbox
        if ($user && $fn)
            $fn = $cgi->checkbox(-name => 'from', -label => '', -value => $peg) . "&nbsp; $fn";
# finally add the color
        $fn=[$fn, "td style='background-color: $color'"];

        my $in_sub=" &nbsp; ";
        my @subs=map {$_->[0]} $fig->subsystems_for_peg($peg);
        if (@subs > 0) {
            $in_sub = @subs;
            my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @subs;
            $in_sub = $cgi->a({id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);
        my $ev = join("<br>", &evidence_codes($fig, $peg));
        my $genomelabel = $fig->genus_species($fig->genome_of($peg)) . " (".$fig->genome_of($peg).")";
        my $abbr=$cgi->a({id=>"genome", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Genome', '$genomelabel', ''); this.tooltip.addHandler(); return false;"}, $fig->abbrev($fig->genus_species($fig->genome_of($peg))));

        my $row=[

        push @$tab, $row;

    if ($user)
        push(@$html,$cgi->start_form(-method => 'post', 
                    -target => "annotation_window",
                    -action => &FIG::cgi_url . "/fid_checked.cgi"),
                $cgi->hidden(-name => 'new_framework'),
                $cgi->hidden(-name => 'user', -value => $user),
                $cgi->hidden(-name => 'maxP', -value => $maxP ),
                $cgi->hidden(-name => 'max',  -value => $max),
                $cgi->hidden(-name => 'maxN', -value => $maxN ),
                $cgi->hidden(-name => 'key_org', -value => $key_org ),
                $cgi->hidden(-name => 'first_peg', -value => $last_peg ),


    my $col_hdrs=["Set", "Organism", "Occ", "PEG", "SS", "EV", "Len", "Function"];
    push( @$html, &HTML::make_table( $col_hdrs, $tab, "Description By Set" ) );

    if ($user)


# set the new first peg
$cgi->param('first_peg', $last_peg);

my $link=$cgi->url."?user=$user&max=$max&maxN=$maxN&maxP=$maxP&key_org=$key_org&first_peg=$last_peg&korgs=".(join("&korgs=", @orgs));
my $percent=int(($pegsofar/$pegct) * 1000)/10;
splice(@$html, 1, 0, $cgi->p("<a href='$link'>Next $max pegs</a>"), $cgi->h4("Walked $pegsofar of $pegct pegs ($percent \%)"));

push @$html, $cgi->p("<a href='$link'>Next $max pegs</a><hr>\n");
my %organisms=map {($_ => $fig->genus_species($_). " ($_)")} @orgs;
push @$html, (
                    "<br />\n<h2>Currently walking along " , $fig->genus_species($key_org), "</h2>",
                    "<br />\nChange to: &nbsp; " , $cgi->popup_menu(-name=>"key_org", -values=>[keys %organisms], -labels=>\%organisms, -default=>$key_org),
                    "<br />\nmaxN: " , $cgi->textfield(-name=>"maxN", -default=>$maxN, -size=>6),
                    "<br />\nmaxP: " , $cgi->textfield(-name=>"maxP", -default=>$maxP, -size=>6),
                    "<br />\nfirst peg: " , $cgi->textfield(-name=>"first_peg", -default=>$last_peg, -size=>20),
                    "<br />\nNumber of pegs to show: " , $cgi->textfield(-name=>"max", -default=>$max, -size=>6),
                    "<br />\n" , $cgi->submit, $cgi->reset,
&HTML::show_page($cgi, $html);

sub evidence_codes {
    my($fig,$peg) = @_;

    if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }

    my %codes = map {$_->[2] =~ s/\;.*//; $_->[2]=>1} grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);
    return keys %codes;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3