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

Annotation of /FigWebServices/pir.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1
6 :    
7 :     Compare some data between SEED and PIR. We probably need to add things like p2p or automatic ftp gets or something like that
8 :    
9 :     =cut
10 :    
11 :     use strict;
12 :     use FIG;
13 :     use HTML;
14 :     use raelib;
15 :     use CGI;
16 :     my $cgi=new CGI;
17 :    
18 :    
19 :     my $fig;
20 :     eval {
21 :     $fig = new FIG;
22 :     };
23 :    
24 :     if ($@ ne "")
25 :     {
26 :     my $err = $@;
27 :    
28 :     my(@html);
29 :    
30 :     push(@html, $cgi->p("Error connecting to SEED database."));
31 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
32 :     {
33 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
34 :     }
35 :     else
36 :     {
37 :     push(@html, $cgi->pre($err));
38 :     }
39 :     &HTML::show_page($cgi, \@html, 1);
40 :     exit;
41 :     }
42 :    
43 :    
44 :    
45 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
46 :    
47 :     my $html = [];
48 :     my $user = $cgi->param('user');
49 :    
50 :     # make sure that we read the file at the beginning
51 : redwards 1.2 my ($pegbypir, $pirid) =&read_pir_file();
52 : redwards 1.1
53 :    
54 :    
55 :    
56 : redwards 1.17 if ($cgi->param('submit') eq "Tabulate summary") {
57 : redwards 1.9 $html=&table_annotations($html, $pegbypir, $pirid);
58 : redwards 1.10 push @$html, $cgi->p({class=>"diagnostic"}, ("<small>Generating this table took approximately " . (time-$^T) . " seconds\n</small>"));
59 : redwards 1.5 }
60 : redwards 1.17 elsif ($cgi->param('pirsf') && !($cgi->param('submit') eq "Update view")) {
61 : redwards 1.1 # we want to display one of the correspondances
62 : redwards 1.5 my $selfurl=$cgi->url;
63 :     push @$html, $cgi->p;
64 :     if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=" . $cgi->param('user') . "\">Show All Matches</a>\n"}
65 :     else {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&ssonly='1'&user=" . $cgi->param('user') . "\">Show only matches with a subsystem</a>\n"}
66 :    
67 :     my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "PEG", "FIG Function", "FIG Subsystem"];
68 : redwards 1.1 my $tab = [];
69 : redwards 1.2 foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
70 : redwards 1.1 my @sslinks;
71 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {
72 :     push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $$subsys[0]);
73 :     }
74 :    
75 :     my $pirlink=$cgi->param('pirsf');
76 : redwards 1.2 $pirlink =~ /^PIR(SF\d+)/;
77 :     $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};
78 : redwards 1.4 next if ($cgi->param("ssonly") && !(scalar @sslinks));
79 : redwards 1.2 push (@$tab, [$pirlink, $fig->genus_species($fig->genome_of($peg)), &HTML::fid_link($cgi, $peg, 1), (scalar $fig->function_of($peg)), (join ", ", @sslinks)]);
80 : redwards 1.1 }
81 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Correspondance between SEED and PIR"));
82 :     }
83 :     else {
84 :     unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
85 :     &show_initial($fig,$cgi,$html);
86 :     }
87 :    
88 :     &HTML::show_page($cgi,$html,1);
89 :     exit;
90 :    
91 :    
92 :    
93 :    
94 :    
95 :     sub show_initial {
96 :     my ($fig,$cgi,$html)=@_;
97 :     # generate a blank page
98 :     # we want a list of all functions that have >= 1 peg unless we want all
99 :     my $min=10;
100 :     if ($cgi->param("min")) {$min=$cgi->param("min")}
101 :     if ($cgi->param("showall")) {$min=0}
102 :     my $full=1;
103 :     if ($cgi->param("preliminary")) {$full=0}
104 :     # count different subsystems per sf
105 :     my $ss; my @pirsf;
106 : redwards 1.2 foreach my $sf (keys %$pegbypir) {
107 :     next unless ($pegbypir->{$sf});
108 :     next unless (scalar @{$pegbypir->{$sf}} >= $min);
109 :     next if ($full && $pirid->{$sf} =~ /\(preliminary\)/i);
110 :     next if (!$full && $pirid->{$sf} =~ /\(full/i);
111 : redwards 1.1 push @pirsf, $sf;
112 :     if ($cgi->param('showsubsys')) {
113 : redwards 1.2 foreach my $peg (@{$pegbypir->{$sf}}) {
114 : redwards 1.1 foreach my $subsys ($fig->subsystems_for_peg($peg)) {
115 :     $ss->{$sf}->{$$subsys[0]}++;
116 :     }
117 :     }
118 :     }
119 :     }
120 :    
121 :     # now generate the labels
122 :     my $display;
123 :     foreach my $sf (@pirsf) {
124 :     next unless ($sf);
125 : redwards 1.2 my $displayname=$pirid->{$sf};
126 : redwards 1.1 if (length($displayname) > 50) {$displayname=substr($displayname, 0, 50)}
127 : redwards 1.2 if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}
128 :     else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}
129 : redwards 1.1 }
130 :     unshift @pirsf, ''; $display->{''}='';
131 :    
132 :     push (@$html, $cgi->start_form(-action => "pir.cgi"),
133 :     $cgi->h2("Please choose your super family"),
134 :     "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,
135 :     "The pull down list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",
136 :     "If you choose to show subsystem counts in this menu, you will get two numbers. The first of the two numbers in parenthesis is the number ",
137 :     "of PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
138 :     "subsystems that those PEGs are in.\n", $cgi->p,
139 :     $cgi->popup_menu(-name=>'pirsf', -values=>[keys %$display], -labels=>$display), $cgi->p,
140 :     "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />",
141 :     "or show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,
142 :     $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in pull down menu (this will slow things down!)"), $cgi->p,
143 :     $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,
144 :     $cgi->submit('submit', 'Update view'),
145 :     $cgi->submit('submit', 'Show Correspondance'),
146 : redwards 1.17 $cgi->reset,
147 : redwards 1.16 $cgi->p, $cgi->hr, $cgi->p,
148 :     "To view a summary of the comparisons between PIR and SEED annotations, please check here:", $cgi->p,
149 :     $cgi->checkbox(-name=>"onlyss", -label=>"Show only those PEGs that are in a subsystem and a superfamily", -checked=>"on"), $cgi->p,
150 : redwards 1.17 $cgi->checkbox(-name=>"totalsort", -label=>"Sort by the total number of different annotations"), $cgi->p,
151 :     $cgi->submit('submit', 'Tabulate summary'),
152 : redwards 1.1 $cgi->reset,
153 :    
154 :    
155 :     $cgi->end_form,
156 :     );
157 :    
158 :     }
159 :    
160 :    
161 :    
162 :     =head1 read_pir_file
163 :    
164 :     Read the PIR data file that describes superfamilies and the PIR proteins that have those families.
165 :     The PIR data file is from ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat and
166 :     contains the family name beginning with a > and then a list of PIR ids.
167 :    
168 : redwards 1.2 I split this using the PIRSF\d+ and return two hashes. One that correlates PIRSF\d+ to fig id and one
169 :     that correlates it to superfamily names.
170 : redwards 1.1
171 :     =cut
172 :    
173 :     sub read_pir_file {
174 :    
175 :     # just read the file, convert it to an HTML table and return it
176 :     unless (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {
177 :     print STDERR "Can't find the correspondance file pirsfcorrespondance.txt so we are going to make it\n";
178 :     raelib->pirsfcorrespondance("$FIG_Config::data/Global/pirsfinfo.dat", "$FIG_Config::data/Global/pirsfcorrespondance.txt");
179 :     }
180 :     open (IN, "$FIG_Config::data/Global/pirsfcorrespondance.txt") || die "Can't open $FIG_Config::data/Global/pirsfcorrespondance.txt";
181 :     my $pir;
182 : redwards 1.2 my $functions;
183 :     my $id;
184 : redwards 1.1 my $added;
185 :     while (<IN>) {
186 :     chomp;
187 :     if (s/^>//) {
188 :     unless ($added) {
189 :     # we didn't find anything that maps here
190 : redwards 1.2 $pir->{$id}=undef;
191 : redwards 1.1 }
192 : redwards 1.2 /^(PIRSF\d+)\s+(.*?)$/;
193 :     $id=$1;
194 :     $functions->{$id}=$2;
195 : redwards 1.1 undef $added;
196 :     }
197 :     else {
198 : redwards 1.2 my ($pirid, $peg)=split /\t/;
199 : redwards 1.1 next unless ($peg);
200 : redwards 1.2 push @{$pir->{$id}}, $peg;
201 : redwards 1.1 $added=1;
202 :     }
203 :     }
204 : redwards 1.2 return $pir, $functions;
205 : redwards 1.1 }
206 : redwards 1.5
207 : redwards 1.9 =head1 table_annotations
208 : redwards 1.5
209 : redwards 1.9 Return a table sorted by the number of annotations, and list a bunch of stuff
210 : redwards 1.5
211 :     =cut
212 :    
213 : redwards 1.9 sub table_annotations {
214 :     my ($html, $pegbypir, $pirid)=@_;
215 : redwards 1.12 my $count; my $subsystems; my $countinss;
216 : redwards 1.9 foreach my $sf (keys %$pegbypir) {
217 : redwards 1.12 my $function; my $ss; my $functionandss;
218 : redwards 1.9 foreach my $peg (@{$pegbypir->{$sf}}) {
219 : redwards 1.13 my $fn=scalar $fig->function_of($peg);
220 : redwards 1.16 my $newss=0; # this is a boolean to see whether this peg has a subsys associated with it.
221 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {$ss->{$$subsys[0]}++; $newss++}
222 : redwards 1.13 $function->{$fn}++;
223 : redwards 1.16 $functionandss->{$fn}++ if ($newss);
224 : redwards 1.5 }
225 : redwards 1.9 $subsystems->{$sf}=join "; ", keys %$ss;
226 :     $count->{$sf}=scalar keys %$function;
227 : redwards 1.12 $countinss->{$sf}=scalar keys %$functionandss;
228 : redwards 1.5 }
229 :    
230 : redwards 1.12 my $col_hdrs = ["Number of annotations in subsystems", "Number of SEED annotations", "PIRSF<br><small>(Link goes to SEED/PIR comparison)</small>",
231 : redwards 1.6 "Superfamily name", "Subsystems in superfamily"];
232 : redwards 1.10 my $tab; my $lastcount; my $row;
233 : redwards 1.12 # note we are going to make a new table every 200 or so rows because that way the browsers don't get messed up. We actually increment between two identical counts
234 :     my @superfamilies=sort {$countinss->{$b} <=> $countinss->{$a}} keys %$count;
235 :     if ($cgi->param('totalsort')) {@superfamilies=sort {$count->{$b} <=> $count->{$a}} keys %$count}
236 :     foreach my $sf (@superfamilies) {
237 :     next if ($cgi->param('onlyss') && !($countinss->{$sf}));
238 : redwards 1.10 $row++;
239 : redwards 1.9 if ($lastcount ne $count->{$sf}) {
240 :     $lastcount=$count->{$sf};
241 : redwards 1.12 if ($tab && ($row > 200)) {
242 : redwards 1.10 push(@$html,&HTML::make_table($col_hdrs,$tab,""));
243 : redwards 1.18 my $et=time-$^T;
244 :     print STDERR "pir.cgi: Added to table at $lastcount after $et total seconds\n";
245 : redwards 1.10 $row=0;
246 :     undef $tab;
247 :     }
248 : redwards 1.9 }
249 :     push @$tab, [
250 : redwards 1.15 $countinss->{$sf},
251 : redwards 1.9 $count->{$sf},
252 : redwards 1.10 "<a href=\"http://seed-linux-2.uchicago.edu/FIG/pir.cgi?pirsf=$sf&ssonly='1'&user=''\">$sf</a>",
253 : redwards 1.9 $pirid->{$sf},
254 :     $subsystems->{$sf},
255 :     ];
256 : redwards 1.5 }
257 : redwards 1.6 push(@$html,&HTML::make_table($col_hdrs,$tab,""));
258 : redwards 1.5 return $html;
259 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3