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

Diff of /FigWebServices/proteinfamilies.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21, Sat Oct 22 17:43:49 2005 UTC revision 1.22, Tue Oct 25 14:20:20 2005 UTC
# Line 48  Line 48 
48    
49  unshift(@$html, "<TITLE>The SEED - Global Protein Families </TITLE>\n");  unshift(@$html, "<TITLE>The SEED - Global Protein Families </TITLE>\n");
50    
 my %proteinbase=(  
  "fig"  => "protein.cgi?user=$user&prot=fig|",  
  "cog"  => "http://www.ncbi.nlm.nih.gov/COG/old/palox.cgi?",  
  "sp"   => "http://www.expasy.org/uniprot/",  
  "tr"   => "http://www.expasy.org/uniprot/",  
  "kegg" => "http://www.genome.jp/dbget-bin/www_bget?",  
 );  
   
   
51    
52  if ($cgi->param('Show Proteins In Each Family'))  if ($cgi->param('Show Proteins In Each Family'))
53  {  {
# Line 78  Line 69 
69  }  }
70  elsif ($cgi->param('differentiate'))  elsif ($cgi->param('differentiate'))
71  {  {
72     push @$html, $cgi->h3({style=>"color: red"}, "Scroll down to see the table");
73     &set_of_equivs($fig,$cgi,$html);
74   &differentiate($fig,$cgi,$html);   &differentiate($fig,$cgi,$html);
75  }  }
76  elsif ($cgi->param('family'))  elsif ($cgi->param('family'))
# Line 110  Line 103 
103   "You can use a FIG ID such as fig|83333.1.peg.3, or an ID from SwissProt, KEGG, NCBI, and others.</p>",   "You can use a FIG ID such as fig|83333.1.peg.3, or an ID from SwissProt, KEGG, NCBI, and others.</p>",
104   $cgi->start_form(-method=>'get'),   $cgi->start_form(-method=>'get'),
105   "Please enter a protein id: ", $cgi->textfield(-name=>"prot", -size=>40), "<br>",   "Please enter a protein id: ", $cgi->textfield(-name=>"prot", -size=>40), "<br>",
106   $cgi->submit(-name=>'equivalence', -value=>"Show an equivalence table"),   $cgi->submit(-name=>'equivalence', -value=>"Show an equivalence table"), $cgi->reset, $cgi->end_form;
  "<p>Alternately, you can enter a family. Please enter a family name in the format pir|PIRSF001547 or fig|PF002363.</p>",  
  "Please enter a family id:  ", $cgi->textfield(-name=>"family", -size=>40), "<br>",  
  $cgi->submit, $cgi->reset, $cgi->end_form;  
107   return $html;   return $html;
108  }  }
109    
110    # "<p>Alternately, you can enter a family. Please enter a family name in the format pir|PIRSF001547 or fig|PF002363.</p>",
111    # "Please enter a family id:  ", $cgi->textfield(-name=>"family", -size=>40), "<br>",
112    # $cgi->submit, $cgi->reset, $cgi->end_form;
113    
114  sub show_family {  sub show_family {
115   my ($fig,$cgi,$html)=@_;   my ($fig,$cgi,$html)=@_;
116   foreach my $fam ($cgi->param('family')) {   foreach my $fam ($cgi->param('family')) {
117    my @cids=sort {$a <=> $b} $fig->ids_in_family($fam);    my @cids=sort {$a <=> $b} $fig->ids_in_family($fam);
118    my $tab=[];    my $tab=[];
119    my $col_hdrs=['Cluster ID', 'Polypeptides with same amino acid sequence'];    my $col_hdrs=['CID', 'Polypeptides with same amino acid sequence'];
120    foreach my $cid (@cids) {    foreach my $cid (@cids) {
121     my @pegs=$fig->cid_to_prots($cid);     my @pegs=$fig->cid_to_prots($cid);
122     foreach my $p (@pegs) {     @pegs=map {&protein_link($_)} @pegs;
     foreach my $k (keys %proteinbase) {  
      if ($p =~ /^$k/) {$p =~ s/^(.*?)\|//; $p = "<a href='$proteinbase{$k}$p'>$1|$p</a>"}  
     }  
    }  
123     push @$tab, [$cid, (join ", ", (@pegs))];     push @$tab, [$cid, (join ", ", (@pegs))];
124    }    }
125    
# Line 151  Line 140 
140  sub show_protein {  sub show_protein {
141   my ($fig,$cgi,$html)=@_;   my ($fig,$cgi,$html)=@_;
142   foreach my $peg ($cgi->param('prot')) {   foreach my $peg ($cgi->param('prot')) {
143    my @families=$fig->families_for_protein($peg);    my @families;
144      if ($peg =~ /^\d+$/)
145      {
146       # it is a cid
147       @families=$fig->in_family($peg);
148       $peg = "CID $peg";
149      }
150      else
151      {
152       @families=$fig->families_for_protein($peg);
153      }
154    
155    unless (@families)    unless (@families)
156    {    {
157     push @$html, "<h2 style='color: red'>Sorry, $peg is not in any protein families</h2>";     push @$html, "<h2 style='color: red'>Sorry, $peg is not in any protein families</h2>";
# Line 258  Line 258 
258     push @$tab, \@row;     push @$tab, \@row;
259    }    }
260    
261    push @$html,  $cgi->start_form(-method=>'get'), $cgi->p("Limit the display to proteins from ", &choose_focus($cgi), "\n"), $cgi->p("Sort the order by ", &choose_sort($cgi),"\n");    push @$html,  $cgi->start_form(-method=>'get'), $cgi->p("Limit display to proteins from ", &choose_focus($cgi), "\n"), $cgi->p("Sort the order by ", &choose_sort($cgi),"\n");
262    if ($reverse) {    if ($reverse) {
263     push @$html, $cgi->p("These are proteins that ARE NOT in ", $fig->family_function($col), " ($col) but are in other families that have proteins in this family.");     push @$html, $cgi->p("These are proteins that ARE NOT in ", $fig->family_function($col), " ($col) but are in other families that have proteins in this family.");
264    } else {    } else {
# Line 317  Line 317 
317    "cog"         => "COG",    "cog"         => "COG",
318   );   );
319    
320   my $default = $cgi->param("focus"); unless ($default) {$default="all"}   my $default = $cgi->param("focus"); unless ($default) {$default="fig"}
321    
322   return $cgi->popup_menu(   return $cgi->popup_menu(
323    -name     => "focus",    -name     => "focus",
# Line 449  Line 449 
449    
450    
451  sub set_of_equivs {  sub set_of_equivs {
452   my ($fig, $cgi, $html)=@_;   ($fig, $cgi, $html)=@_;
453   foreach my $peg ($cgi->param('prot')) {   foreach my $peg ($cgi->param('prot')) {
454    my $cid=$fig->prot_to_cid($peg);    my $cid=$fig->prot_to_cid($peg);
455    my @equiv=$fig->cid_to_prots($cid);    my @equiv=$fig->cid_to_prots($cid);
# Line 487  Line 487 
487    
488    
489    $tab=&HTML::merge_table_rows($tab, {3=>1, 4=>1});    $tab=&HTML::merge_table_rows($tab, {3=>1, 4=>1});
490    my $col_hdrs=['CID', 'Protein', 'Function of Proteins', 'Family', 'Family Function', 'No. Prots In Family'];    my $radbut={
491       "1not2"=>"In family one and NOT family two\n",
492       "2not1"=>"In family two and NOT family one\n",
493       "1and2"=>"In both families\n"
494       };
495      my $col_hdrs=['CID', 'Protein', 'Function of Proteins', 'Family', 'Family Function', 'Ext. IDs In Family'];
496    push @$html, &HTML::make_table($col_hdrs, $tab, ""),  "\n", $cgi->p("To differentiate families in this table, please choose two families:"),    push @$html, &HTML::make_table($col_hdrs, $tab, ""),  "\n", $cgi->p("To differentiate families in this table, please choose two families:"),
497    "Family 1: &nbsp; ", $cgi->popup_menu(-name=>"family1", -values=>[sort {$a cmp $b} keys %$allfams], -labels=>$allfams),    "Family 1: &nbsp; ", $cgi->popup_menu(-name=>"family1", -values=>[sort {$a cmp $b} keys %$allfams], -labels=>$allfams, -default=>[sort {$a cmp $b} keys %$allfams]->[0]),
498    " &nbsp; Family 2: &nbsp; ", $cgi->popup_menu(-name=>"family2", -values=>[sort {$a cmp $b} keys %$allfams], -labels=>$allfams),    " <br /> Family 2: &nbsp; ", $cgi->popup_menu(-name=>"family2", -values=>[sort {$a cmp $b} keys %$allfams], -labels=>$allfams, -default=>[sort {$a cmp $b} keys %$allfams]->[1]),
   $cgi->p("Limit the display to proteins from ", &choose_focus($cgi), "\n"),  
499    $cgi->p("Show proteins:<br /><ul>\n",    $cgi->p("Show proteins:<br /><ul>\n",
500    $cgi->checkbox(-name=>"1not2", -label=>"In family one and NOT family two"), "<br />\n",    $cgi->radio_group(-name=>"diff", -values=>[keys %$radbut], -labels=>$radbut, -rows=>3),
501    $cgi->checkbox(-name=>"2not1", -label=>"In family two and NOT family one"), "<br />\n",    "</ul>\n"),
502    $cgi->checkbox(-name=>"1and2", -label=>"In both families"), "\n</ul>\n"),    $cgi->hidden(-name=>'prot', -value=>$peg),
503    $cgi->submit(-name=>"differentiate", -value=>"Differentiate these families"), $cgi->reset, $cgi->end_form();    $cgi->submit(-name=>"differentiate", -value=>"Differentiate these families"), $cgi->reset, $cgi->end_form();
504   }   }
505  }  }
506    
507    #  $cgi->p("I am most interested in proteins from ", &choose_focus($cgi), " that are missing from these families\n"),
508    
509  sub differentiate {  sub differentiate {
510     ($fig, $cgi, $html)=@_;
511    
512     #my $focus=$cgi->param('focus') or 'all'; # these are the things that we are interested in
513     #undef $focus if ($focus eq "all");
514     my $focus=$cgi->param('family2');
515     $focus =~ s/\|.*//;
516    
517     my ($fam_id1, $fam_id2)=($cgi->param('family1'), $cgi->param('family2'));
518     if ($fam_id1 eq $fam_id2)
519     {
520      push @$html, "<h2 style='color: red'>Please choose two different protein families</h2>";
521      return;
522     }
523     my ($fam1, $fam2)=([$fig->ids_in_family($fam_id1)], [$fig->ids_in_family($fam_id2)]);
524    
525    
526     # figure out all the families we know about
527     my %families;
528     #map
529     #{
530     # my $cid=$_;
531     # map
532     # {
533     #  $families{$_}=1;
534     # }
535     # $fig->in_family($cid);
536     #} @{&set_utilities::union($fam1, $fam2)};
537    
538     map {$families{$_}=1} $fig->in_family($cgi->param('querycid'));
539    
540     my @families=sort {$a cmp $b} grep {!/$fam_id1/} grep {!/$fam_id2/} keys %families;
541     unshift @families, ($fam_id1, $fam_id2);
542     my @source=@families;
543     map {/^(.*?)\|/; $_=$1} @source;
544    
545     # now figure out all the external IDs in those families
546     my $extids;
547     map
548     {
549      my $fam=$_;
550      map
551      {
552       $extids->{$_}->{$fam}=1;
553      } $fig->ext_ids_in_family($fam);
554     } @families;
555    
556     # finally generate the table. Note that there are three different arrays that we operate on depending on the user input
557     # but it really only changes which set algorith we use. Each array is handled identically.
558     my $tab;
559     my $column;
560     map
561     {
562      my $cid=$_;
563      my $row=["<a href='proteinfamilies.cgi?prot=$cid'>$cid</a>"];
564      my $seen; my $mismatch; my $mismatchcolor;
565      map
566      {
567       my $prot=$_;
568       map
569       {
570        # add the protein info to the cell in the table if it this family has that protein. Note that we have seen it, and increment the column counter
571        # this if is if the protein that we are looking at is in the family for this column then add it
572    
573        # if the protein is not added, we want to know if it has the same start characters as the family (i.e. from the same source), and note that.
574        ($extids->{$prot}->{$families[$_]}) ?
575        eval {$seen->{$prot}=1; $row->[$_+1] .= &protein_link($prot) . "<br />" ; $column->{$_+1}++} :
576        ($prot =~ /^$source[$_]/) ? eval {$mismatch->{$prot}=1; $mismatchcolor->{$_+1}=1; $row->[$_+1] .= &protein_link($prot) . "<br />" ; $column->{$_+1}++} :
577        1;
578       } (0 .. $#families);
579      } sort $fig->cid_to_prots($cid);
580      unless ($#$row == $#families+1) {$#$row=$#families+1}
581    
582      #$row->[1] = [join("<br />", map {&protein_link($_)} grep {/^$focus/} grep {!$seen->{$_}} $fig->cid_to_prots($cid)), "td style='background-color: #FF3366'"];
583      #$row->[1] = [join("<br />", map {&protein_link($_)} grep {/^$focus/} grep {!$mismatch->{$_}} grep {!$seen->{$_}} $fig->cid_to_prots($cid)), "td style='background-color: #FF3366'"];
584    
585      map {$row->[$_] = [$row->[$_], "td style='background-color: #FF3366'"]} keys %$mismatchcolor;
586      map {$row->[$_] = " &nbsp; " unless ($row->[$_])} (0 .. $#$row);
587      #push @$tab, $row if ($row->[1]->[0]);
588    
589      # if we want to show everything do so, otherwise only show the rows where there is a missing protein
590      if ($cgi->param('show') eq "all")
591      {
592       push @$tab, $row;
593      }
594      elsif ($row->[2] ne " &nbsp; ")
595      {
596       push @$tab, $row;
597      }
598     }
599     ($cgi->param("diff") eq "1and2") ? @{&set_utilities::intersection($fam1, $fam2)} :
600     ($cgi->param("diff") eq "1not2") ? @{&set_utilities::set_diff($fam1, $fam2)} :
601     ($cgi->param("diff") eq "2not1") ? @{&set_utilities::set_diff($fam2, $fam1)} : ();
602    
603    
604     my $title="Proteins in ";
605     ($cgi->param("diff") eq "1and2") ? $title.=$fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n" :
606     ($cgi->param("diff") eq "1not2") ? $title.=$fig->family_function($fam_id1). " ($fam_id1) BUT NOT in " . $fig->family_function($fam_id2). " ($fam_id2)\n" :
607     ($cgi->param("diff") eq "2not1") ? $title.=$fig->family_function($fam_id2). " ($fam_id2) BUT NOT in " . $fig->family_function($fam_id1). " ($fam_id1)\n" : 1;
608    
609     # add the count of the number of members in the family
610     #my @colcounts=map {$column->{$_}} (1 .. $#families+2); $colcounts[0] = [$colcounts[0], "td style='background-color: #FF3366'"];
611     #my @sz=map {$fig->ext_sz_family($_)} @families;
612     #unshift @$tab, [["# Ext. IDs in fam", "th "], ['', "td style='background-color: #FF3366'"], @sz];
613     #unshift @$tab, [["Ext. IDs shown", "th "], @colcounts];
614    
615     # remove empty columns from the table
616     #for (my $y=$#families+2; $y>3; $y--)
617     #{
618      # do it backwards so the splice still works, and stop at 3 since the first four columns are the ones we need
619      #next if ($column->{$y});
620      #splice(@families, $y-2, 1);
621      #map {splice(@$_, $y, 1)} @$tab;
622     #}
623    
624    
625     #my @headers=map {$_ = "$_: <a href='proteinfamilies.cgi?family=$families[$_]'>$source[$_]</a>"} (0..$#families);
626     my @headers=@families;
627     map {$_ = "<a href='proteinfamilies.cgi?family=$_'>$_</a>"} @headers;
628     #my $colhdrs=["CID", ["Proteins not in families", "th style='background-color: #FF3366'"], @headers];
629     my $colhdrs=["CID", @headers];
630     push @$html, HTML::make_table($colhdrs, $tab, $title);
631    }
632    
633    
634    sub old_differentiate {
635   my ($fig, $cgi, $html)=@_;   my ($fig, $cgi, $html)=@_;
636    
637   my $focus=$cgi->param('focus') or 'all'; # these are the things that we are interested in   my $focus=$cgi->param('focus') or 'all'; # these are the things that we are interested in
# Line 527  Line 658 
658    
659    
660   if ($cgi->param("2not1")) {   if ($cgi->param("2not1")) {
661    
662       ###########NOTICE THIS REDIRECT!!!
663       ($fam_id1, $fam_id2)=($fam_id2, $fam_id1);
664       ($fam1, $fam2)=($fam2, $fam1);
665       $cgi->param("1not2c", "1");
666      }
667      if (0) {
668    my $tab;    my $tab;
669    map {    map {
670      my $cid=$_;      my $cid=$_;
# Line 598  Line 736 
736    map {$skip->{$_+4}=1} (0 .. $#families);    map {$skip->{$_+4}=1} (0 .. $#families);
737    $tab=&HTML::merge_table_rows($tab, $skip);    $tab=&HTML::merge_table_rows($tab, $skip);
738    
739    map {s/\|/\|<br>/} @families;    map {$_ = "<a href='proteinfamilies.cgi?family=$_'>$_</a>"} @families;
740    my $colhdrs=["CID", "Protein", "Function", @families];    my $colhdrs=["CID", "Protein", "Function", @families];
741    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2
742    push @$html, HTML::make_table($colhdrs, $tab, $title);    push @$html, HTML::make_table($colhdrs, $tab, $title);
# Line 646  Line 784 
784    
785    $tab=&HTML::merge_table_rows($tab);    $tab=&HTML::merge_table_rows($tab);
786    
787    map {s/\|/\|<br>/} @families;    map {$_ = "<a href='proteinfamilies.cgi?family=$_'>$_</a>"} @families;
788    my $colhdrs=["CID", @families];    my $colhdrs=["CID", @families];
789    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2
790    push @$html, HTML::make_table($colhdrs, $tab, $title);    push @$html, HTML::make_table($colhdrs, $tab, $title);
# Line 682  Line 820 
820    map    map
821    {    {
822     my $cid=$_;     my $cid=$_;
823     my $row=[$cid];     my $row=["<a href='proteinfamilies.cgi?prot=$cid'>CID $cid</a>"];
824       my $seen;
825     map     map
826     {     {
827      my $prot=$_;      my $prot=$_;
828      map {($extids->{$prot}->{$families[$_]}) ? $row->[$_+1] = $prot : 1 } (0 .. $#families);      my $column;
829        map
830        {
831         ($extids->{$prot}->{$families[$_]}) ?
832         eval {$seen->{$prot}=1; $row->[$_+2] = &protein_link($prot) ; $column->{$_+2}++} :
833         1
834        } (0 .. $#families);
835     } sort grep {/^$focus/} $fig->cid_to_prots($cid);     } sort grep {/^$focus/} $fig->cid_to_prots($cid);
836     unless ($#$row == $#families+1) {$#$row=$#families+1}     unless ($#$row == $#families+2) {$#$row=$#families+2}
837    
838       $row->[1] = [join("<br />", map {&protein_link($_)} grep {!$seen->{$_}} $fig->cid_to_prots($cid)), "td style='background-color: #FF3366'"];
839    
840     push @$tab, $row;     push @$tab, $row;
841    } @{&set_utilities::set_diff($fam1, $fam2)};    } @{&set_utilities::set_diff($fam1, $fam2)};
842    
843    $tab=&HTML::merge_table_rows($tab);    $tab=&HTML::merge_table_rows($tab);
844    
845    map {s/\|/\|<br>/} @families;    map {$_ = "<a href='proteinfamilies.cgi?family=$_'>$_</a>"} @families;
846    my $colhdrs=["CID", @families];    my $colhdrs=["CID", "<span style='background-color: #FF3366'>Proteins not one of the families listed</span>", @families];
847    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) AND in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2    my $title="Proteins in ". $fig->family_function($fam_id1). " ($fam_id1) BUT NOT in " . $fig->family_function($fam_id2). " ($fam_id2)\n";#$fam_id1, $fam_id2
848    push @$html, HTML::make_table($colhdrs, $tab, $title);    push @$html, HTML::make_table($colhdrs, $tab, $title);
849   }   }
850    
# Line 772  Line 920 
920    
921    
922    
923    sub protein_link {
924     my $p=shift;
925     my %proteinbase=(
926      "fig"         => "protein.cgi?user=$user&prot=fig|",
927      "cog"  => "http://www.ncbi.nlm.nih.gov/COG/old/palox.cgi?",
928      "sp"   => "http://www.expasy.org/uniprot/",
929      "tr"   => "http://www.expasy.org/uniprot/",
930      "kegg" => "http://www.genome.jp/dbget-bin/www_bget?",
931     );
932    
933     map {($p =~ /^$_/) ? eval {$p =~ s/^(.*?)\|//; $p = "<a href='$proteinbase{$_}$p'>$1|$p</a>"} : 1;} keys %proteinbase;
934     return $p;
935    }
936    
937    
938    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3