[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.8 - (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 : redwards 1.8 $cgi->p("Maximum pegs per page", $cgi->textfield(-name=>"max", -value=>50, -size=>5)),
41 : overbeek 1.1 $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.7 unless ($maxN) {$maxN=50}
59 : overbeek 1.1 unless ($maxP) {$maxP=1e-20}
60 :     unless ($max) {$max=10}
61 :    
62 :     my $keep=0;
63 : overbeek 1.4 undef $first_peg unless ($key_org eq $fig->genome_of($first_peg));
64 : overbeek 1.1 unless ($first_peg) {$keep=1}
65 :    
66 :    
67 :     my $last_peg;
68 : overbeek 1.5 my $pegct; my $pegsofar;
69 : overbeek 1.1 foreach my $peg (sort {$fig->feature_location($a) cmp $fig->feature_location($b)} $fig->pegs_of($key_org))
70 :     {
71 : overbeek 1.5 $pegct++;
72 : overbeek 1.1 my $tab;
73 :     ($peg eq $first_peg) ? ($keep=1) : 1;
74 : overbeek 1.7 unless ($keep) {$pegsofar++; next}
75 : overbeek 1.6 next if ($keep > $max);
76 : overbeek 1.1 $last_peg=$peg;
77 : overbeek 1.5 $pegsofar++;
78 : overbeek 1.1 my $fn=$fig->function_of($peg, $user);
79 :     my @inc=($peg);
80 :     my %function;
81 :     $function{$fn}=1;
82 :     foreach my $sim ($fig->sims($peg, $maxN, $maxP, "figx"))
83 :     {
84 :     next unless ($wanted->{$fig->genome_of($sim->[1])});
85 :     $fn=$fig->function_of($sim->[1], $user);
86 :     push @inc, $sim->[1];
87 :     $function{$fn}++;
88 :     }
89 :    
90 :     next unless (scalar(keys %function) > 1); # don't keep if they all have the same function
91 :    
92 :     # what are the orders of the functions (for the colors)
93 :     my $cnt=0;
94 :     my %position;
95 :     foreach my $fn (sort {$function{$b} <=> $function{$a}} keys %function) {$position{$fn}=$cnt++}
96 :     my @colors= UnvSubsys::cool_colors();
97 : overbeek 1.3 my %genomect;
98 :    
99 :     foreach my $peg (sort {$fig->genome_of($a) cmp $fig->genome_of($b)} @inc)
100 : overbeek 1.1 {
101 : overbeek 1.3 $genomect{$fig->genome_of($peg)}++;
102 : overbeek 1.1 my $user_entry = &HTML::fid_link( $cgi, $peg );
103 :     if ($user)
104 :     {
105 :     $user_entry = $cgi->checkbox(-name => 'checked', -label => '', -value => $peg) . "&nbsp; $user_entry";
106 :     }
107 :    
108 :     my $fn = $fig->function_of($peg,$user);
109 :     # note that %function has the nummber of functions with this annotation
110 :     my $color="#FFFFFF";
111 :     if ($fn) {$color=$colors[$position{$fn}]}
112 :     # add the annotation checkbox
113 :     if ($user && $fn)
114 :     {
115 :     $fn = $cgi->checkbox(-name => 'from', -label => '', -value => $peg) . "&nbsp; $fn";
116 :     }
117 :     # finally add the color
118 :     $fn=[$fn, "td style='background-color: $color'"];
119 :    
120 :     my $in_sub=" &nbsp; ";
121 : overbeek 1.2 my @subs=map {$_->[0]} $fig->subsystems_for_peg($peg);
122 : overbeek 1.1 if (@subs > 0) {
123 :     $in_sub = @subs;
124 :     my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @subs;
125 :     $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);
126 :     }
127 :     my $ev = join("<br>", &evidence_codes($fig, $peg));
128 : overbeek 1.3
129 :     my $genomelabel = $fig->genus_species($fig->genome_of($peg)) . " (".$fig->genome_of($peg).")";
130 :     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))));
131 : overbeek 1.1
132 :     my $row=[
133 :     $keep,
134 : overbeek 1.3 $abbr,
135 :     $genomect{$fig->genome_of($peg)},
136 : overbeek 1.1 $user_entry,
137 :     $in_sub,
138 :     $ev,
139 :     $fig->translation_length($peg),
140 :     $fn,
141 :     ];
142 :    
143 :     push @$tab, $row;
144 :     }
145 :     $keep++;
146 :    
147 :    
148 :    
149 :     if ($user)
150 :     {
151 :     push(@$html,$cgi->start_form(-method => 'post',
152 : redwards 1.8 -target => "annotation_window",
153 : overbeek 1.1 -action => &FIG::cgi_url . "/fid_checked.cgi"),
154 :     $cgi->hidden(-name => 'new_framework'),
155 :     $cgi->hidden(-name => 'user', -value => $user),
156 :     $cgi->hidden(-name => 'maxP', -value => $maxP ),
157 :     $cgi->hidden(-name => 'max', -value => $max),
158 :     $cgi->hidden(-name => 'maxN', -value => $maxN ),
159 :     $cgi->hidden(-name => 'key_org', -value => $key_org ),
160 :     $cgi->hidden(-name => 'first_peg', -value => $last_peg ),
161 :    
162 :    
163 :     );
164 :     }
165 :    
166 :    
167 :    
168 :    
169 : overbeek 1.3 my $col_hdrs=["Set", "Organism", "Occ", "PEG", "SS", "EV", "Len", "Function"];
170 : overbeek 1.1 push( @$html, &HTML::make_table( $col_hdrs, $tab, "Description By Set" ) );
171 :    
172 :     if ($user)
173 :     {
174 :     push(@$html,
175 :     $cgi->submit('assign/annotate'),
176 :     $cgi->end_form,
177 :     );
178 :     }
179 :    
180 :     }
181 :    
182 : overbeek 1.4
183 : overbeek 1.7 # set the new first peg
184 :     $cgi->param('first_peg', $last_peg);
185 : overbeek 1.4
186 :    
187 : overbeek 1.1 my $link=$cgi->url."?user=$user&max=$max&maxN=$maxN&maxP=$maxP&key_org=$key_org&first_peg=$last_peg&korgs=".(join("&korgs=", @orgs));
188 : overbeek 1.5 my $percent=int(($pegsofar/$pegct) * 1000)/10;
189 :     splice(@$html, 1, 0, $cgi->p("<a href='$link'>Next $max pegs</a>"), $cgi->h4("Walked $pegsofar of $pegct pegs ($percent \%)"));
190 : overbeek 1.1
191 :    
192 : overbeek 1.4 push @$html, $cgi->p("<a href='$link'>Next $max pegs</a><hr>\n");
193 :     my %organisms=map {($_ => $fig->genus_species($_). " ($_)")} @orgs;
194 :     push @$html, (
195 :     $cgi->start_form(),
196 :     $cgi->hidden(-name=>"user"),
197 :     $cgi->hidden(-name=>"korgs"),
198 :     $cgi->ul(
199 :     "<br />\n<h2>Currently walking along " , $fig->genus_species($key_org), "</h2>",
200 :     "<br />\nChange to: &nbsp; " , $cgi->popup_menu(-name=>"key_org", -values=>[keys %organisms], -labels=>\%organisms, -default=>$key_org),
201 :     "<br />\nmaxN: " , $cgi->textfield(-name=>"maxN", -default=>$maxN, -size=>6),
202 :     "<br />\nmaxP: " , $cgi->textfield(-name=>"maxP", -default=>$maxP, -size=>6),
203 : overbeek 1.7 "<br />\nfirst peg: " , $cgi->textfield(-name=>"first_peg", -default=>$last_peg, -size=>20),
204 : overbeek 1.4 "<br />\nNumber of pegs to show: " , $cgi->textfield(-name=>"max", -default=>$max, -size=>6),
205 :     "<br />\n" , $cgi->submit, $cgi->reset,
206 :     ),
207 :     $cgi->end_form,
208 :     );
209 : overbeek 1.1 &HTML::show_page($cgi, $html);
210 :    
211 :    
212 :    
213 :    
214 :    
215 :    
216 :    
217 :    
218 :     sub evidence_codes {
219 :     my($fig,$peg) = @_;
220 :    
221 :     if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }
222 :    
223 : redwards 1.8 my %codes = map {$_->[2] =~ s/\;.*//; $_->[2]=>1} grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);
224 :     return keys %codes;
225 : overbeek 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3