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

Annotation of /FigWebServices/close_genome_discrepancies.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :     use HTML;
20 :     use CGI;
21 :     use CGI::Carp qw(fatalsToBrowser);
22 :     use strict;
23 :     use UnvSubsys;
24 :     my $fig=new FIG;
25 :     use raelib;
26 :     my $raelib=new raelib;
27 :     my $cgi=new CGI;
28 :     my $html=["<TITLE>Discrepancies between close genomes</TITLE>"];
29 :    
30 :    
31 :     my @orgs=sort {$fig->genus_species($a) cmp $fig->genus_species($b)} $cgi->param('korgs');
32 :     unless (@orgs > 1)
33 :     {
34 :     push @$html, (
35 :     $cgi->h1("<center>Discrepancies between close genomes</center>"),
36 :     $cgi->start_form,
37 :     $cgi->p("Please enter your username", $cgi->textfield(-name=>"user", -size=>20)),
38 :     $cgi->p("Please choose more than one genome from the menu, and a list of all discrepant pegs will be generated for you."),
39 :     $raelib->scrolling_org_list($cgi, 1),
40 :     $cgi->p("Maximum pegs per page", $cgi->textfield(-name=>"max", -value=>10, -size=>5)),
41 :     $cgi->p,
42 :     $cgi->submit, $cgi->reset,
43 :     $cgi->end_form);
44 :     &HTML::show_page($cgi, $html, 1);
45 :     exit(0);
46 :     }
47 :    
48 :     my $wanted={map {($_=>1)} @orgs};
49 :    
50 :     my $key_org = $cgi->param('key_org');
51 :     my $first_peg = $cgi->param('first_peg');
52 :     my $maxN = $cgi->param('maxN');
53 :     my $maxP = $cgi->param('maxP');
54 :     my $user = $cgi->param('user');
55 :     my $max = $cgi->param('max');
56 :    
57 :     unless ($key_org) {$key_org=$orgs[0]}
58 : overbeek 1.2 unless ($maxN) {$maxN=10}
59 : overbeek 1.1 unless ($maxP) {$maxP=1e-20}
60 :     unless ($max) {$max=10}
61 :    
62 :     my $keep=0;
63 :     unless ($first_peg) {$keep=1}
64 :    
65 :    
66 :     my $last_peg;
67 :     foreach my $peg (sort {$fig->feature_location($a) cmp $fig->feature_location($b)} $fig->pegs_of($key_org))
68 :     {
69 :     my $tab;
70 :     ($peg eq $first_peg) ? ($keep=1) : 1;
71 :     next unless ($keep);
72 :     $last_peg=$peg;
73 :     last if ($keep > $max);
74 :     my $fn=$fig->function_of($peg, $user);
75 :     my @inc=($peg);
76 :     my %function;
77 :     $function{$fn}=1;
78 :     foreach my $sim ($fig->sims($peg, $maxN, $maxP, "figx"))
79 :     {
80 :     next unless ($wanted->{$fig->genome_of($sim->[1])});
81 :     $fn=$fig->function_of($sim->[1], $user);
82 :     push @inc, $sim->[1];
83 :     $function{$fn}++;
84 :     }
85 :    
86 :     next unless (scalar(keys %function) > 1); # don't keep if they all have the same function
87 :    
88 :     # what are the orders of the functions (for the colors)
89 :     my $cnt=0;
90 :     my %position;
91 :     foreach my $fn (sort {$function{$b} <=> $function{$a}} keys %function) {$position{$fn}=$cnt++}
92 :     my @colors= UnvSubsys::cool_colors();
93 : overbeek 1.3 my %genomect;
94 :    
95 :     foreach my $peg (sort {$fig->genome_of($a) cmp $fig->genome_of($b)} @inc)
96 : overbeek 1.1 {
97 : overbeek 1.3 $genomect{$fig->genome_of($peg)}++;
98 : overbeek 1.1 my $user_entry = &HTML::fid_link( $cgi, $peg );
99 :     if ($user)
100 :     {
101 :     $user_entry = $cgi->checkbox(-name => 'checked', -label => '', -value => $peg) . "&nbsp; $user_entry";
102 :     }
103 :    
104 :     my $fn = $fig->function_of($peg,$user);
105 :     # note that %function has the nummber of functions with this annotation
106 :     my $color="#FFFFFF";
107 :     if ($fn) {$color=$colors[$position{$fn}]}
108 :     # add the annotation checkbox
109 :     if ($user && $fn)
110 :     {
111 :     $fn = $cgi->checkbox(-name => 'from', -label => '', -value => $peg) . "&nbsp; $fn";
112 :     }
113 :     # finally add the color
114 :     $fn=[$fn, "td style='background-color: $color'"];
115 :    
116 :     my $in_sub=" &nbsp; ";
117 : overbeek 1.2 my @subs=map {$_->[0]} $fig->subsystems_for_peg($peg);
118 : overbeek 1.1 if (@subs > 0) {
119 :     $in_sub = @subs;
120 :     my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @subs;
121 :     $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);
122 :     }
123 :     my $ev = join("<br>", &evidence_codes($fig, $peg));
124 : overbeek 1.3
125 :     my $genomelabel = $fig->genus_species($fig->genome_of($peg)) . " (".$fig->genome_of($peg).")";
126 :     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))));
127 : overbeek 1.1
128 :     my $row=[
129 :     $keep,
130 : overbeek 1.3 $abbr,
131 :     $genomect{$fig->genome_of($peg)},
132 : overbeek 1.1 $user_entry,
133 :     $in_sub,
134 :     $ev,
135 :     $fig->translation_length($peg),
136 :     $fn,
137 :     ];
138 :    
139 :     push @$tab, $row;
140 :     }
141 :     $keep++;
142 :    
143 :    
144 :    
145 :     if ($user)
146 :     {
147 :     push(@$html,$cgi->start_form(-method => 'post',
148 :     -target => "$$",
149 :     -action => &FIG::cgi_url . "/fid_checked.cgi"),
150 :     $cgi->hidden(-name => 'new_framework'),
151 :     $cgi->hidden(-name => 'user', -value => $user),
152 :     $cgi->hidden(-name => 'maxP', -value => $maxP ),
153 :     $cgi->hidden(-name => 'max', -value => $max),
154 :     $cgi->hidden(-name => 'maxN', -value => $maxN ),
155 :     $cgi->hidden(-name => 'key_org', -value => $key_org ),
156 :     $cgi->hidden(-name => 'first_peg', -value => $last_peg ),
157 :    
158 :    
159 :     );
160 :     }
161 :    
162 :    
163 :    
164 :    
165 : overbeek 1.3 my $col_hdrs=["Set", "Organism", "Occ", "PEG", "SS", "EV", "Len", "Function"];
166 : overbeek 1.1 push( @$html, &HTML::make_table( $col_hdrs, $tab, "Description By Set" ) );
167 :    
168 :     if ($user)
169 :     {
170 :     push(@$html,
171 :     $cgi->submit('assign/annotate'),
172 :     $cgi->end_form,
173 :     );
174 :     }
175 :    
176 :     }
177 :    
178 :     my $link=$cgi->url."?user=$user&max=$max&maxN=$maxN&maxP=$maxP&key_org=$key_org&first_peg=$last_peg&korgs=".(join("&korgs=", @orgs));
179 :     splice(@$html, 1, 0, $cgi->p("<a href='$link'>Next $max pegs</a>"));
180 :    
181 :    
182 :     push @$html, $cgi->p("<a href='$link'>Next $max pegs</a>");
183 :     &HTML::show_page($cgi, $html);
184 :    
185 :    
186 :    
187 :    
188 :    
189 :    
190 :    
191 :    
192 :     sub evidence_codes {
193 :     my($fig,$peg) = @_;
194 :    
195 :     if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }
196 :    
197 :     my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);
198 :     return (@codes > 0) ? map { $_->[2] } @codes : ();
199 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3