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

Annotation of /FigWebServices/ma_to_tf_nr.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : mkubal 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1 protein_sets_2.cgi
6 :    
7 :     Find transcription factors for affymetrix spot ids
8 :    
9 :     =cut
10 :    
11 :     use FIG;
12 :     use HTML;
13 :     use CGI;
14 :     my $cgi=new CGI;
15 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
16 :    
17 :     $fig = new FIG;
18 :     my $html = [];
19 :    
20 :     unshift(@$html, "<TITLE>Find Transcription Factors for Expressed Genes</TITLE>\n");
21 :    
22 :     my $id_to_ratio;
23 :     my $inputs;
24 :     if ($cgi->param('request') )
25 :     {
26 :     my $input =$cgi->param('proteins');
27 :     my @inputs = split("\n",$input);
28 :    
29 :     if ($cgi->upload('fileupload'))
30 :     {
31 :     my $fh=$cgi->upload('fileupload');
32 :     @inputs = <$fh> ;
33 :     }
34 :    
35 :     $given = [@inputs];
36 :     $id_to_ratio = &parse_inputs($given);
37 :    
38 :     }
39 :    
40 :     if ($id_to_ratio && $cgi->param('request') eq "Find Transcription Factors")
41 :     {
42 :     &find_tfs($fig,$cgi,$html,$id_to_ratio);
43 :     }
44 :    
45 :     if($cgi->param('request') eq "Find Exclusive Combinations")
46 :     {
47 :     &analyze_combinations($fig,$cgi,$html);
48 :     }
49 :    
50 :     if ($id_to_ratio && $cgi->param('request') eq "Find Most Frequent Factors")
51 :     {
52 :     &find_most_frequent($fig,$cgi,$html,$tag_to_id);
53 :     }
54 :    
55 :     else
56 :     {
57 :     &show_initial($fig,$cgi,$html);
58 :     &HTML::show_page($cgi,$html,1);
59 :     exit;
60 :     }
61 :    
62 :     sub show_initial {
63 :     my ($fig,$cgi,$html)=@_;
64 :     # generate a blank page
65 :     push @$html,
66 :     $cgi->start_multipart_form(),
67 :     "<p>Enter affymetrix spot id, expression ratio pairs separated by a space or a tab</p>\n",
68 :     "<p>",
69 :     "<b>Paste pairs here:</b><br>\n",
70 :     $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n",
71 :     "<br><b>Or choose a file here:</b><br>\n",
72 :     $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
73 :     $cgi->submit(-name=>'request', -value=>'Find Transcription Factors'),
74 :     $cgi->submit(-name=>'request', -value=>'Find Exclusive Combinations'),
75 :     $cgi->reset, $cgi->end_form;
76 :     return $html;
77 :     }
78 :    
79 :     sub find_tfs
80 :     {
81 : mkubal 1.3 print STDERR "find_tfs called\n";
82 : mkubal 1.1 my ($fig,$cgi,$html,$spotid_to_ratio)=@_;
83 :     $new_html = [];
84 :     $dir = "/home/mkubal/public_html";
85 :    
86 :     my @ids = keys(%{$spotid_to_ratio});
87 :    
88 : mkubal 1.3 open(OUT2,">$dir/tfs_to_ratio.txt");
89 :    
90 :     open(OUT3,">$dir/refseq_in_exp.txt");
91 : mkubal 1.1
92 :     open(IN,"$dir/spotid_to_refseq.txt");
93 :     %spotid_to_refseq;
94 :     while ($_ = <IN>){
95 :     chomp($_);
96 :     @temp = split("\t",$_);
97 : mkubal 1.3 if($spotid_to_refseq{$temp[0]}){
98 :     $ref = $spotid_to_refseq{$temp[0]};
99 :     push(@$ref,$temp[1]);
100 :     print STDERR "old spotid:$temp[1]\n";
101 :     }
102 :     else{
103 :     $spotid_to_refseq{$temp[0]} = [$temp[1]];
104 :     print STDERR "new spotid:$temp[1]\n";
105 :     }
106 : mkubal 1.1 }
107 :    
108 :     open(IN2,"$dir/refseq_to_transfactor.txt.nonredundant");
109 :     %refseq_to_tf;
110 :     while ($_ = <IN2>){
111 :     chomp($_);
112 : mkubal 1.3 print STDERR "refseq_to_transfactor:$_\n";
113 : mkubal 1.1 @temp = split("\t",$_);
114 :     if($refseq_to_tf{$temp[0]}){
115 :     $ref = $refseq_to_tf{$temp[0]};
116 :     push(@$ref,$temp[1]);
117 :     }
118 :     else{
119 :     $refseq_to_tf{$temp[0]} = [$temp[1]];
120 :     }
121 :     }
122 : mkubal 1.2 close(IN2);
123 : mkubal 1.1
124 :     push(@$new_html,"<HTML><HEAD>
125 :     <TITLE>strep</TITLE>
126 :     <META NAME='generator' CONTENT='YokMap 1.0.1'>
127 :     <META HTTP-EQUIV='Content-Type' CONTENT='text/html; charset=iso-8859-1'>
128 :     </HEAD>
129 :     <BODY BGCOLOR='#ffffff'>");
130 :    
131 :     push(@$new_html,"<TABLE border><TR><TH>Expression Ratio</TH><TH>Transcription Factor(s)</TH><TH>Affymetrix Spot ID</TH><TH>RefSeq ID</TH></TR>");
132 :    
133 :     my $row_string = "";
134 :     foreach my $id (@ids)
135 :     {
136 : mkubal 1.3 print STDERR "ids here:$id\n";
137 : mkubal 1.1 my $ratio = $spotid_to_ratio->{$id};
138 : mkubal 1.3 my $refseqs = $spotid_to_refseq{$id};
139 :     foreach $refseq (@$refseqs){
140 :     print OUT3 "$refseq\n";
141 :    
142 :     my $tfs_ref = $refseq_to_tf{$refseq};
143 :    
144 : mkubal 1.1 foreach $tfs (@$tfs_ref){
145 : mkubal 1.3 $row_string = "<TR><TD>$ratio</TD><TD>$tfs</TD><TD>$id</TD><TD>$refseq</TD></TR>";
146 :     push(@$new_html,$row_string);
147 :     }
148 :    
149 :     if($tfs_ref){
150 :     foreach $tfs (@$tfs_ref){
151 :     print OUT2 "$tfs\t$ratio\n";
152 :     }
153 : mkubal 1.1 }
154 :     }
155 :    
156 :     }
157 :    
158 :     close(OUT2);
159 : mkubal 1.3 close(OUT3);
160 : mkubal 1.1
161 :     push(@$new_html,"</TABLE>");
162 :     #push(@$new_html,
163 :     # "<br><br>",
164 :     # $cgi->submit(-name=>'request', -value=>'Find Exclusive Combinations'),
165 :     # $cgi->submit(-name=>'request', -value=>'Find Most Frequent Factors'));
166 :    
167 :    
168 :     &HTML::show_page($cgi,$new_html);
169 :     exit;
170 :     }
171 :    
172 :     sub analyze_combinations
173 :     {
174 :     my ($fig,$cgi,$html)=@_;
175 :     $new_html = [];
176 : mkubal 1.2 %significant;
177 : mkubal 1.1 $dir = "/home/mkubal/public_html";
178 :    
179 : mkubal 1.2 open(IN2,"$dir/refseq_to_transfactor.txt.nonredundant");
180 :     %tfs_to_refseq;
181 :     while ($_ = <IN2>){
182 :     chomp($_);
183 :     @temp = split("\t",$_);
184 :     if($tfs_to_refseq{$temp[1]}){
185 :     $ref = $tfs_to_refseq{$temp[1]};
186 :     push(@$ref,$temp[0]);
187 :     }
188 :     else{
189 :     $tfs_to_refseq{$temp[1]} = [$temp[0]];
190 :     }
191 :     }
192 :     close(IN2);
193 :    
194 : mkubal 1.3 open(IN3,"$dir/refseq_in_exp.txt");
195 :     %refseq_in_exp;
196 :     while ($_ = <IN3>){
197 :     chomp($_);
198 :     $refseq_in_exp{$_} = 1;
199 :     }
200 :     close(IN3);
201 :    
202 :     #print STDERR "made it here\n";
203 : mkubal 1.1 open(IN,"$dir/tfs_to_ratio.txt");
204 :     %tfs_combinations;
205 :     %tfs_counts;
206 :     %tfs_expected;
207 : mkubal 1.3 %tfs_total;
208 : mkubal 1.1 open(IN3,"$dir/stats.txt.nonredundant");
209 :     open(SUMMARY,">$dir/nonredundant_stats.summary");
210 :     while ($_ = <IN3>){
211 : mkubal 1.3 @temp = split("\t",$_);
212 :     $expected = $temp[2];
213 :     $total = $temp[1];
214 :     chomp($expected);
215 :     $tfs_expected{$temp[0]} = $expected;
216 :     $tfs_total{$temp[0]} = $total;
217 : mkubal 1.1 }
218 :     close(IN3);
219 :    
220 :     my @lines;
221 :     while ($_ = <IN>){
222 :     push(@lines,$_);
223 :     #print "input line:$_\n";
224 :     chomp($_);
225 :     @temp = split("\t",$_);
226 :     $tfs_combinations{$temp[0]} = 1;
227 :     }
228 :     close(IN);
229 :    
230 :     @negative_exclusives;
231 :     @positive_exclusives;
232 : mkubal 1.2 @therest;
233 : mkubal 1.1
234 :     foreach my $k (keys(%tfs_combinations)){
235 : mkubal 1.3 #print STDERR "k:$k\n";
236 : mkubal 1.1 $sign = "not_set";
237 :     $exclusive = 1;
238 :     foreach $l (@lines){
239 :     @temp = split("\t",$l);
240 :     $tfs = $temp[0];
241 :     $ratio = $temp[1];
242 :     if($k eq $tfs){
243 :     if($tfs_counts{$k}){$tfs_counts{$k} = $tfs_counts{$k} + 1}
244 :     else{$tfs_counts{$k} = 1}
245 :    
246 :     if($sign eq "not_set"){
247 :     if($ratio < 0){$sign = "negative"}
248 :     else{$sign = "positive"}
249 :     }
250 :     else{
251 :     $previous_sign = $sign;
252 :     if($ratio < 0){$sign = "negative"}
253 :     else{$sign = "positive"}
254 :     if($previous_sign ne $sign){$exclusive =0}
255 :     }
256 :     }
257 :     }
258 :    
259 :     if($exclusive){
260 :     if($sign eq "positive"){
261 :     push(@positive_exclusives,$k)
262 :     }
263 :     else{push(@negative_exclusives,$k)}
264 :     }
265 : mkubal 1.2 else{push(@therest,$k)}
266 : mkubal 1.1 }
267 :     push(@$new_html,"<HTML><HEAD>
268 :     <TITLE>strep</TITLE>
269 :     <META NAME='generator' CONTENT='YokMap 1.0.1'>
270 :     <META HTTP-EQUIV='Content-Type' CONTENT='text/html; charset=iso-8859-1'>
271 :     </HEAD>
272 :     <BODY BGCOLOR='#ffffff'>");
273 :    
274 :     push(@$new_html,"<TABLE border><TR><TH>UP Transcription Factor Combinations</TH><TH>Number of Genes</TH><TH>Observed/Expected</TH></TR>");
275 :    
276 :     foreach my $tfs (@positive_exclusives){
277 :     my $count = $tfs_counts{$tfs};
278 : mkubal 1.3 my $observed = $count * (1/311);
279 : mkubal 1.1 my $expected = $tfs_expected{$tfs};
280 :     my $ratio = $observed/$expected;
281 : mkubal 1.3 if($ratio > 10 ){ $significant{$tfs} = $ratio};
282 : mkubal 1.1 my $row_string = "<TR><TD>$tfs</TD><TD>$count</TD><TD>$ratio</TD></TR>";
283 :     push(@$new_html,$row_string);
284 :     print SUMMARY "UP\t$tfs\t$observed\t$expected\t$ratio\n";
285 : mkubal 1.2
286 : mkubal 1.1 }
287 :    
288 :     push(@$new_html,"</TABLE>");
289 :    
290 :     push(@$new_html,"<br><br>");
291 :    
292 :     push(@$new_html,"<TABLE border><TR><TH>DOWN Transcription Factor Combinations</TH><TH>Number of Genes</TH><TH>Observed/Expected</TH></TR>");
293 :    
294 :     foreach my $tfs (@negative_exclusives)
295 :     {
296 :     my $count = $tfs_counts{$tfs};
297 : mkubal 1.3 my $observed = $count * (1/311);
298 : mkubal 1.1 my $expected = $tfs_expected{$tfs};
299 :     my $ratio = $observed/$expected;
300 : mkubal 1.3 if($ratio > 10 ){ $significant{$tfs} = $ratio};
301 : mkubal 1.1 my $row_string = "<TR><TD>$tfs</TD><TD>$count</TD><TD>$ratio</TD></TR>";
302 :     push(@$new_html,$row_string);
303 :     print SUMMARY "DOWN\t$tfs\t$observed\t$expected\t$ratio\n";
304 : mkubal 1.2 }
305 :    
306 :     push(@$new_html,"</TABLE>");
307 :    
308 :     push(@$new_html,"<br><br>");
309 :    
310 :     push(@$new_html,"<TABLE border><TR><TH>MIXED Transcription Factor Combinations</TH><TH>Number of Genes</TH><TH>Observed/Expected</TH></TR>");
311 :    
312 :     foreach my $tfs (@therest)
313 :     {
314 :     my $count = $tfs_counts{$tfs};
315 : mkubal 1.3 my $observed = $count * (1/311);
316 : mkubal 1.2 my $expected = $tfs_expected{$tfs};
317 :     my $ratio = $observed/$expected;
318 : mkubal 1.3 if($ratio > 10 ){ $significant{$tfs} = $ratio};
319 : mkubal 1.2 my $row_string = "<TR><TD>$tfs</TD><TD>$count</TD><TD>$ratio</TD></TR>";
320 :     push(@$new_html,$row_string);
321 :     print SUMMARY "MIXED\t$tfs\t$observed\t$expected\t$ratio\n";
322 :     }
323 : mkubal 1.1
324 : mkubal 1.2 push(@$new_html,"</TABLE>");
325 :    
326 :     push(@$new_html,"<br><br>");
327 :    
328 : mkubal 1.3 push(@$new_html,"<TABLE border><TR><TH>SIGNIFICANT Transcription Factor Combinations</TH><TH>RefSeq in Exp</TH><TH>Other RefSeq</TH><TH>Observed/Expected</TH><TH>ORPV</TH></TR>");
329 : mkubal 1.2
330 :    
331 :     @sorted = sort {$b <=> $a} values(%significant);
332 :     %sorted_hash;
333 :     foreach $s (values(%significant)){
334 :     $sorted_hash{$s} = 1;
335 :     }
336 :    
337 :     @final;
338 :     %already_in;
339 :     foreach $s (@sorted){
340 :     foreach $tfs (keys(%significant)){
341 :     if($already_in{$tfs}){ $do_nothing = 1}
342 :     else{
343 :     $ratio = $significant{$tfs};
344 :     if( $ratio >= $s){
345 :     push(@final,$tfs);
346 :     $already_in{$tfs} = 1;
347 :     }
348 :     }
349 :     }
350 :     }
351 :    
352 :     foreach my $tfs (@final)
353 :     {
354 :     my $ids = $tfs_to_refseq{$tfs};
355 : mkubal 1.3 @in_id_strings = ();
356 :     @other_id_strings = ();
357 : mkubal 1.2 foreach $id (@$ids){
358 : mkubal 1.3 if($refseq_in_exp{$id}){
359 :     $id_string ="<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=NucCore&cmd=search&term=$id'>$id</a>";
360 :     push(@in_id_strings,$id_string);
361 :     }
362 :     else {
363 :     $id_string ="<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=NucCore&cmd=search&term=$id'>$id</a>";
364 :     push(@other_id_strings,$id_string);
365 :     }
366 : mkubal 1.2 }
367 :    
368 : mkubal 1.3 $in_ids_line = join(",",@in_id_strings);
369 :     $other_ids_line = join(",",@other_id_strings);
370 :     my $ratio = $significant{$tfs};
371 :     my $count = $tfs_counts{$tfs};
372 :    
373 :     my $d = 311;
374 :     my $m = $tfs_total{$tfs};
375 :     my $n = 20659;
376 :     my $orpv = &orpv($count,$d,$m,$n);
377 :    
378 :     my $row_string = "<TR><TD>$tfs</TD><TD>$in_ids_line</TD><TD>$other_ids_line</TD><TD>$ratio</TD><TD>$orpv</TD></TR>";
379 : mkubal 1.2 push(@$new_html,$row_string);
380 :     print SUMMARY "SIGNIFICANT\t$tfs\t$id\t$ratio\n";
381 :     }
382 :    
383 :     push(@$new_html,"</TABLE>");
384 :    
385 :     &HTML::show_page($cgi,$new_html);
386 :     exit;
387 : mkubal 1.1 }
388 :    
389 :     sub parse_inputs
390 :     {
391 :    
392 :     my ($given) =@_;
393 :     my $hash;
394 :     foreach my $g (@$given)
395 :     {
396 :     my $id ="";
397 :     my $ratio = "";
398 :    
399 :     if ($g =~/(.*?)(\t|\s+)(.*)/)
400 :     {
401 :     $id = $1;
402 :     $ratio = $3;
403 :     }
404 :    
405 :     $hash{$id} = $ratio;
406 :     }
407 :    
408 :     return \%hash;
409 :    
410 :     }
411 :    
412 : mkubal 1.3 sub gammaln{
413 :     my($x) = @_;
414 :     $x = $x -1;
415 :     if($x){
416 :     my $result = ( $x *log($x) ) - $x;
417 :     print STDERR "gammaln result: $result\n";
418 :     return $result;
419 :    
420 :     }
421 :     else{ return 0}
422 :     }
423 :    
424 :     sub lchoose{
425 :     my($n,$x) = @_;
426 :     return &gammaln($n+1) - &gammaln($x+1) - &gammaln($n-$x+1);
427 :     }
428 :    
429 :     sub ldhypg {
430 :     my($x,$d,$m,$n)= @_;
431 :     if ($x>$m || $d-$x > $n-$m || $d>$n || $x>$d) {
432 :     print STDERR "x,d,m,n:$x,$d,$m,$n\n";
433 :     return(-inf)
434 :     }
435 :     else
436 :     {
437 :     my ($p, $q, $r) = (&lchoose($m,$x), &lchoose($n-$m,$d-$x), &lchoose($n,$d));
438 :     print STDERR "p, q, r = $p\t$q\t$r\n";
439 :     return($p + $q - $r);
440 :     #return(&lchoose($m,$x) + &lchoose($n-$m,$d-$x) - &lchoose($n,$d));
441 :     }
442 :     }
443 :    
444 :     sub orpv{
445 :     print STDERR "orpv called\n";
446 :     my($x,$d,$m,$n) = @_;
447 :     $pval = 0;
448 :     for ( $y=$x; $y <= $n; $y++) {
449 :     $result = &ldhypg($y,$d,$m,$n);
450 :     $exp_of_result = exp($result);
451 :     if($exp_of_result == 1) {$do_nothing = 1}
452 :     else{$pval= $pval+ $exp_of_result}
453 :     }
454 :     print STDERR "pval: $pval\n";
455 :     return($pval);
456 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3