[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.35, Tue Dec 6 08:24:02 2005 UTC revision 1.36, Sat Dec 10 23:05:58 2005 UTC
# Line 66  Line 66 
66  unshift(@$html, "<TITLE>The SEED - Global Protein Families </TITLE>\n");  unshift(@$html, "<TITLE>The SEED - Global Protein Families </TITLE>\n");
67    
68    
69    if ($cgi->param("family"))
70    {
71     push @$html, $cgi->h1({class=>"center"}, $cgi->param("family"), " Family : ", $fig->family_function($cgi->param("family")), "\n");
72    }
73    
74    
75    
76  if ($cgi->param('equivalence'))  if ($cgi->param('equivalence'))
77  {  {
78   &set_of_equivs($fig,$cgi,$html);   &set_of_equivs($fig,$cgi,$html);
# Line 75  Line 82 
82   &show_sources;   &show_sources;
83   if ($cgi->param('family')) {&show_family($fig,$cgi,$html)}   if ($cgi->param('family')) {&show_family($fig,$cgi,$html)}
84  }  }
85    elsif ($cgi->param('freetextsearch'))
86    {
87     &freetextsearch($fig,$cgi,$html);
88    }
89  elsif ($cgi->param('differentiate'))  elsif ($cgi->param('differentiate'))
90  {  {
91   &set_of_equivs($fig,$cgi,$html) if ($cgi->param('prot'));   &set_of_equivs($fig,$cgi,$html) if ($cgi->param('prot'));
# Line 110  Line 121 
121   # generate a blank page   # generate a blank page
122    
123   # generate the buttons for each of the submits   # generate the buttons for each of the submits
124   my $fams=&families();   my $fams=&sources();
125   my $buttons="<table width=100%><tr>".   my $buttons="<table width=100%><tr>".
126               join("\n",               join("\n",
127                      map {"<td><input type='submit' name='bysource' value='".$fams->{$_}."' /></td>"} sort {$fams->{$a} cmp $fams->{$b}} keys %$fams                      map {
128                              "<td><p><center><input type='submit' name='bysource' value='".$fams->{$_}."' /></p><p>\n" .
129                              "(<a href=\"".&source_url($_)."\" target=\"window$$\">website</a>)</center></p></td>\n"
130                            }  sort {$fams->{$a} cmp $fams->{$b}} keys %$fams
131                   )."</tr></table>";                   )."</tr></table>";
132    
133   push @$html,   push @$html,
134   $cgi->start_form(-method=>'get'), "\n",   "<h1>Protein Families</h1>\n",
135   "<h2>Protein Families</h2>\n",  
136     $cgi->p("SEED Protein Families have been built from the sources shown below. This is a new interface designed to compare the different families"),
137    
138   $cgi->div({class=>'enterprotein'}, "<p>Please enter a protein ID . You will recieve a list of all the families that protein is in. \n",   $cgi->div(
139   "You can use a FIG ID such as fig|83333.1.peg.3, or an ID from SwissProt, KEGG, NCBI, and others.</p>\n",               {class=>"bordermargin"},
140                 $cgi->start_form(-method=>'get'), "\n",
141                 $cgi->p("You can enter a protein ID . You will recieve a list of all the families that protein is in. \n",
142                 "You can use a FIG ID such as fig|83333.1.peg.3, or an ID from SwissProt, KEGG, NCBI, and others.\n"),
143   "Please enter a protein id: ", $cgi->textfield(-name=>"prot", -size=>40), "<br>\n",   "Please enter a protein id: ", $cgi->textfield(-name=>"prot", -size=>40), "<br>\n",
144   $cgi->submit(-name=>'equivalence', -value=>"Show Protein Families"), "\n", $cgi->reset,),               $cgi->submit(-name=>'equivalence', -value=>"Show Protein Families"), "\n", $cgi->reset,
145                 $cgi->end_form(),
146               ),
147    
148   $cgi->div({class=>'byfamily'}, "<p>You can also select one of the data sources below to choose families for that family:</p>",   $cgi->div(
149   $buttons),               {class=>"bordermargin"},
150                 $cgi->start_form(-method=>'get'), "\n",
151                 "<p>You can select one of the data sources below to choose families from that source:</p>", $buttons,
152                 $cgi->end_form(),
153            ),
154     $cgi->div(
155                 {class=>"bordermargin"},
156                 $cgi->start_form(-method=>'get'), "\n",
157                 $cgi->p("You can search through the family functions for some text. Please note that at the moment this is a case sensitive search only."),
158                 $cgi->textfield(-name=>"freetext", -size=>40),
159                 $cgi->submit(-name=>"freetextsearch", -value=>'Text Search'), $cgi->reset,
160                 $cgi->end_form(),
161              ),
162    
163    
164    
# Line 134  Line 166 
166   return $html;   return $html;
167  }  }
168    
169    # CUT::             {class=>'bytext', style=>'border: solid 1px black; margin: 20px 20px; padding: 20px 20px'},
170    
171    
172  # "<p>Alternately, you can enter a family. Please enter a family name in the format pir|PIRSF001547 or fig|PF002363.</p>",  # "<p>Alternately, you can enter a family. Please enter a family name in the format pir|PIRSF001547 or fig|PF002363.</p>",
173  # "Please enter a family id:  ", $cgi->textfield(-name=>"family", -size=>40), "<br>",  # "Please enter a family id:  ", $cgi->textfield(-name=>"family", -size=>40), "<br>",
174  # $cgi->submit, $cgi->reset, $cgi->end_form;  # $cgi->submit, $cgi->reset, $cgi->end_form;
# Line 148  Line 183 
183    
184   # families table   # families table
185   my $tab2=[];   my $tab2=[];
186   my $colhdr2=["Family Function", "Number of proteins<br>in both families", "Combine with"];   my $colhdr2=["Source", "Family Function", "Number of proteins<br>in both families", "Combine with"];
187    
188   my $count=1;   my $count=1;
189   my $otherfamilies;   my $otherfamilies;
# Line 168  Line 203 
203   {   {
204    &comparepairs($fig, $cgi, $html);    &comparepairs($fig, $cgi, $html);
205   }   }
206   else  
207   {   foreach my $newfam (sort {&source_for_family($a) cmp &source_for_family($b) || $fig->sz_family($b) <=> $fig->sz_family($a)} keys %$otherfamilies)
    foreach my $newfam (keys %$otherfamilies)  
208     {     {
209        next if ($newfam eq $fam);
210      my $func=$fig->family_function($newfam);      my $func=$fig->family_function($newfam);
211      $func or ($func=$newfam);      $func or ($func=$newfam);
212      my $link="<a href=\'proteinfamilies.cgi?family=$newfam&user=$user\'>$func</a>";      my $link="<a href=\'proteinfamilies.cgi?family=$newfam&user=$user\'>$func</a>";
# Line 181  Line 216 
216  <a href="proteinfamilies.cgi?user=$user&family1=$fam&family2=$newfam&diff=1not2&differentiate=Compare+these+families" target="window_$$">Not</a>  <a href="proteinfamilies.cgi?user=$user&family1=$fam&family2=$newfam&diff=1not2&differentiate=Compare+these+families" target="window_$$">Not</a>
217    
218  EOF  EOF
219      push @$tab2, [$link, $otherfamilies->{$newfam}, $compare];      push @$tab2, [&source_for_family($newfam), $link, $otherfamilies->{$newfam}, $compare];
    }  
220   }   }
221   push @$html, "<h2>$fam Family : ", $fig->family_function($fam), "</h2>\n",   push @$html, (
222        $cgi->div(
223            {class=>"bordermargin"},
224   $cgi->p("The family $fam has the function <em>", $fig->family_function($fam), "</em>, and contains ", $fig->sz_family($fam), " proteins.",   $cgi->p("The family $fam has the function <em>", $fig->family_function($fam), "</em>, and contains ", $fig->sz_family($fam), " proteins.",
225   "Each of these proteins are present in other databases, and we have cross mapped them"),   "Each of these proteins are present in other databases, and we have cross mapped them"),
226   $cgi->p("The table below shows you the other families that proteins in $fam are also in, and the number of other proteins.",   $cgi->p("The table below shows you the other families that proteins in $fam are also in, and the number of other proteins.",
227   "Click on the family name to see that protein, or on the compare link to compare the two families",),   "Click on the family name to see that protein, or on the compare link to compare the two families",),
228    &HTML::make_table($colhdr2, $tab2, "Other families that these proteins are in"),    &HTML::make_table($colhdr2, $tab2, "Other families that these proteins are in"),
229    $cgi->h4("<a href=\"proteinfamilies.cgi?family=$fam&comparepairs=1&user=$user\">Compare this family to other protein families</a>"),          $cgi->h4("<a href=\"proteinfamilies.cgi?family=$fam&comparepairs=1&user=$user\" target=\"window$$\">Compare this family to these other protein families</a>"),
230        ),
231    
232   $cgi->hr, $cgi->p("This table shows you the ID of the identical proteins in other databases</p>\n",      $cgi->div(
233            {class=>"bordermargin"},
234            $cgi->p("This table shows you the ID of the identical proteins in other databases</p>\n",
235   "<p>The links will take you to the respective databases for each of the other protein families.\n</p>",),   "<p>The links will take you to the respective databases for each of the other protein families.\n</p>",),
236   &HTML::make_table($colhdr1, $tab1, "Proteins in " . $fig->family_function($fam) . " ($fam)");          &HTML::make_table($colhdr1, $tab1, "Proteins in " . $fig->family_function($fam) . " ($fam)"),
237        ),
238        );
239  }  }
240    
241  sub show_protein {  sub show_protein {
# Line 243  Line 284 
284    
285    
286    
   
 sub analyse_family {  
  my ($fig,$cgi,$html, $reverse)=@_;  
 # here are the questions:  
 # 1. Given a column in a spreadsheet:  
 # 2. Here are the proteins in that column  
 # 3. For each protein, here are the families that they are in. How many families are unique and how many families is every protein in?  
 #       if we start with a column of 10 proteins, and nine of them are all in the same families and one is not, we want to exclude the one and keep the nine.  
 #       so we recommend that a protein be removed from a family.  
 # 4. For each of the families that are good, which proteins are there in some/most of the families that are not in the column that we are looking at  
 # 5. For each of the families that are good, which proteins are only in one of those families and not in any others?  
   
 # Note that column == family, But start with fig and then  allow a replace ID feature like before.  
   
  my $focus=$cgi->param('focus') or 'all'; # these are the things that we are interested in  
  undef $focus if ($focus eq "all");  
   
  my @cols;  
  if ($cgi->param("allfams")) {@cols=grep {$cgi->param($_)} $cgi->param("allfams")}  
  elsif ($cgi->param("family")) {push @cols, $cgi->param('family')}  
  else {die "No families declared!"}  
   
  foreach my $col (@cols)  
  {  
   # $col is the column in the spreadsheet. This is really a family, but to visualize and code this I am doing it in a FIG-centric way  
   my $proteins_in_col;  
   map {$proteins_in_col->{$_}=1} $fig->ids_in_family($col);  
   
   # @proteins are the proteins in that column, although these are cids and not fids at the moment  
   my $familycount;  
   foreach my $prot (keys %$proteins_in_col) {  
    foreach my $fam ($fig->in_family($prot)) {  
     $familycount->{$fam}++;  
    }  
   }  
   
   my $count_of;  
   my $fams;  
   foreach my $f (sort {$familycount->{$b} <=> $familycount->{$a}} keys %$familycount)  
   {  
    if ($reverse) {($fams, $count_of)=&ids_missing_from_fam($fig, $f, $focus, $proteins_in_col, $fams, $count_of)}  
    else {($fams, $count_of)=&ids_are_in_fam($fig, $f, $focus, $proteins_in_col, $fams, $count_of)}  
   }  
   
   # create a list of families that we know about  
   my @fams=grep {$_ ne $col} sort {scalar(keys %{$fams->{$b}}) <=> scalar(keys %{$fams->{$a}})} keys %$fams;  
   unshift @fams, $col;  
   
   my $tab=[[["Number of proteins in family", "th colspan=4"], map {scalar(keys %{$fams->{$_}})} @fams]];  
   
   my @fids;  
   if ($cgi->param('sort') eq "genome")  
   {  
    @fids=sort {$fig->genome_of($a) <=> $fig->genome_of($b)} keys %$count_of;  
   }  
   elsif ($cgi->param('sort') eq "cid")  
   {  
    @fids=sort {$fig->prot_to_cid($a) <=> $fig->prot_to_cid($b)} keys %$count_of;  
   }  
   else  
   {  
    @fids=sort {scalar(keys %{$count_of->{$b}}) <=> scalar(keys %{$count_of->{$a}})} keys %$count_of;  
   }  
   
   my $rowcount;  
   foreach my $fid (@fids)  
   {  
    my @row=(++$rowcount, $fig->prot_to_cid($fid), $fid, scalar(keys %{$count_of->{$fid}}));  
   
    foreach my $fam (@fams) {  
     $count_of->{$fid}->{$fam} ? push @row, ["Y", "td style='background-color: lightgrey; text-align: center'"] : push @row, " &nbsp ";  
    }  
    push @$tab, \@row;  
   }  
   
   push @$html,  $cgi->start_form(-method=>'get'), $cgi->p("Sort the order by ", &choose_sort($cgi),"\n");  
   if ($reverse) {  
    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.");  
   } else {  
    push @$html, $cgi->p("These are proteins that ARE in ", $fig->family_function($col), " ($col) and are in other families that have proteins in this family.");  
   }  
   
   # merge cells in the table  
   my $skip;  
   map {$skip->{$_}=1} (0, 2 .. 40); # ignore everything except column 2  
   $tab=&HTML::merge_table_rows($tab, $skip);  
   
   push @$html,  
     $cgi->hidden(-name=>"family", -value=>@cols), $cgi->hidden("prot"), $cgi->hidden(-name=>"user"),  
     $cgi->submit(-name=>'analyse_family', -value=>"Show Proteins that are in family"),  
     $cgi->submit(-name=>'reverse_analyse_family', -value=>"Show Proteins that are NOT in family"),  
     &HTML::make_table(["Count", "Unique ID", "Protein ID", "Number of fams protein is in", @fams], $tab,' &nbsp; ');  
  }  
 }  
   
   
 sub ids_are_in_fam {  
    my ($fig, $f, $focus, $proteins_in_col, $fams, $count_of)=@_;  
    # It seems that $sz_family is not right  
    map {$fams->{$f}->{$_}++; $count_of->{$_}->{$f}++}  
         grep {/^$focus/}  
         map {$fig->cid_to_prots($_)}  
         grep {$proteins_in_col->{$_}}  
         ($fig->ids_in_family($f));  
    return ($fams, $count_of);  
 }  
   
 sub ids_missing_from_fam {  
    my ($fig, $f, $focus, $proteins_in_col, $fams, $count_of)=@_;  
    # It seems that $sz_family is not right  
    map {$fams->{$f}->{$_}++; $count_of->{$_}->{$f}++}  
         grep {/^$focus/}  
         map {$fig->cid_to_prots($_)}  
         grep {!$proteins_in_col->{$_}}  
         ($fig->ids_in_family($f));  
    return ($fams, $count_of);  
 }  
   
   
   
 sub families {  
  my %choices=(  
   "aclame"      => "Aclame",  
   "fig"         => "FIGfams",  
   "tigr"        => "TIGRfams",  
   "pfam"        => "PFAM",  
   "sp"          => "SwissProt",  
   "kegg"        => "KEGG",  
   "pir"         => "PIR SuperFams",  
   "mcl"         => "MCL",  
   "cog"         => "COG",  
  );  
  return \%choices;  
 }  
   
 sub choose_sort {  
  my ($cgi)=@_;  
  my %choices=(  
   "none"        => "Number of Proteins",  
   "genome"      => "Genome",  
   "cid"         => "Unique ID",  
  );  
   
  my $default = $cgi->param("sort"); unless ($default) {$default="none"}  
   
  return $cgi->popup_menu(  
   -name     => "sort",  
   -values   => [sort {$choices{$a} cmp $choices{$b}} keys %choices],  
   -labels   => \%choices,  
   -default  => $default,  
  );  
 }  
   
   
 sub comparefig2kegg {  
  my ($fig,$cgi,$html)=@_;  
   
  my $classification; my %subsystem;  
  # read classification from kegg file  
  if (open(IN, "$FIG_Config::global/ProteinFamilies/kegg_classificaation.txt")) {  
   while (<IN>) {  
    chomp;  
    my @a=split /\t/;  
    my $id=shift(@a);  
    $subsystem{"kegg|$id"}=pop(@a);  
    push @{$classification->{"kegg|$id"}}, \@a;  
   }  
  }  
   
   
  my $tab=[];  
  # find out what families our proteins are in  
  map {  
   my $prot=$_;  
   map {  
    my $fam=$_;  
    if ($fam =~ /^fig/) {  
     my %ss;  
     map {$ss{$_->[0]}++} ($fig->subsystems_for_role($fig->family_function($fam)));  
     map {my $ss=$_; push @$tab, [$prot, @{$fig->subsystem_classification($ss)}, $ss, $fam, $fig->family_function($fam)]} keys %ss;  
    }  
    else {  
     map {push @$tab, [$prot, @{$_}, $subsystem{$fam}, $fam, $fig->family_function($fam)]} @{$classification->{$fam}}  
    }  
    } grep {/^fig/ || /^kegg/} $fig->families_for_protein($prot);  
    } $cgi->param('proteins');  
   
  my $col_hdrs=['Protein', ['Classification', 'th colspan=2'], 'Subsystem', 'Family ID', 'Family Function'];  
  push @$html, &HTML::make_table($col_hdrs, $tab, "Families"),  "\n",  
 }  
   
 ## Based on request from Ross:  
 #       Subject:        Re: fig.pl  
 #       Date:   October 4, 2005 6:21:00 AM PDT  
 #       From:     Ross@theFIG.info  
 #       To:       raedwards@gmail.com  
 #  
 #Rob,  
 #  
 #It seems to me that you got that right, and the function is certainly at the  
 #core of what is needed.  I have been thinking about what I would want with  
 #protein families,  
 #and it goes something like this:  
 #  
 #1. Given a protein FIG1, you can get the set of proteins with the same CID  
 #(call it CID1).  Call this set EQUIV, since it is really a set of IDs that are  
 #equivalent.  
 #  
 #2. From the set of IDs in EQUIV, you can get the set of protein families (from  
 #all sources) that contain the IDs in EQUIV.  This gives a table  
 #  
 #  
 #            [,ID,Function,Family,FamilyFunction]  
 #  
 #    All of the table entries describe a family containing CID1.  
 #  
 #3.  From this table you select two Families to be compared (e.g., one KEGG  
 #family vs a FIG family).  This ends the first part -- selecting the precise  
 #two  
 #      families to be compared.  Each of the two families  should be thought of  
 #as [CID,ID,Family].  
 #  
 #4.  The comparison of SET1 and SET2 uses essentially the function you  
 #implemented.  You need to form three sets:  
 #  
 #            the intersection of SET1 and SET2  
 #            SET1 - SET2  
 #            SET2 - SET1  
 #  
 #       You may or may not wish to display each of the three sets.  The user  
 #should be able to select which.  When you think  
 #        of one of these sets, it is useful to think of  
 #{CID,Family,Set-of-CIDs}.  That is, it is not just a set of CIDs; it should be  
 #viewed as a  
 #        set of CIDs from a specific family that was chosen because it  
 #contained a specific CID.  
 #  
 #5. When displaying a set of proteins from a given family, you start with  
 #(CID,Family,Set-of-CIDs).  Each line should contain  
 #  
 #            1. A single CID from the Set-of-CIDs  (call this CID2).  
 #  
 #            2. A count of the number of sources that place both CID1 and CID2  
 #in the same family (note that this is not a count of the families that include  
 #both CID1 and CID2)  
 #  
 #            3.  For each source a "Y" or space indicating whether or not the  
 #source placed CID1 and CID2 into the same family (i.e., whether or not there  
 #                  is at least one family from the source that contains both  
 #CID1 and CID2).  
 #  
 #That is what I think should be done.  Can we discuss it?  
 #  
   
   
   
287  sub set_of_equivs {  sub set_of_equivs {
288   ($fig, $cgi, $html)=@_;   ($fig, $cgi, $html)=@_;
289   my $peg=$cgi->param('prot');   my $peg=$cgi->param('prot');
# Line 843  Line 628 
628   @$tab=sort {$b->[2] <=> $a->[2] || $b->[3] <=> $a->[3] || $a->[4] <=> $b->[4]} @$tab;   @$tab=sort {$b->[2] <=> $a->[2] || $b->[3] <=> $a->[3] || $a->[4] <=> $b->[4]} @$tab;
629    
630    
631   push @$html,   push @$html, (
632        $cgi->div(
633            {class=>"bordermargin"},
634    $cgi->h3("Comparisons between protein families"),    $cgi->h3("Comparisons between protein families"),
635    $cgi->p("The table below shows a comparison of <b>", $fig->family_function($fam), " ($fam)</b> with all the other protein families ",    $cgi->p("The table below shows a comparison of <b>", $fig->family_function($fam), " ($fam)</b> with all the other protein families ",
636    " that proteins in $fam are also present in. The link in the first column will take you to a table showing proteins that are in family two ",    " that proteins in $fam are also present in. The link in the first column will take you to a table showing proteins that are in family two ",
637    " that are not in $fam. These are proteins that you should investigate for being in your family. ",    " that are not in $fam. These are proteins that you should investigate for being in your family. ",
638    " The link in the second column will take you to that families page. The <b>frequency</b> is the number of proteins in $fam that are also in the second family.",          " The link in the second column will take you to that families page. The <b>frequency</b> is the number of proteins in $fam that are ",
639            " also in the second family.",
640    " The <b>For</b> score is the total number of proteins that agree both families are similar. The <b>Against</b> score is the total number of proteins ",    " The <b>For</b> score is the total number of proteins that agree both families are similar. The <b>Against</b> score is the total number of proteins ",
641    " that disagree that the two proteins are similar. These numbers are the sum of the for and against scores shown under the side-by-side comparison ",    " that disagree that the two proteins are similar. These numbers are the sum of the for and against scores shown under the side-by-side comparison ",
642    " when you click the link in column 1."),    " when you click the link in column 1."),
643    HTML::make_table(["Family 1", "Family 2", "Frequency", "For", "Against"], $tab, "Scores");          HTML::make_table(["Family 1", "Family 2", "Frequency", "For", "Against"], $tab, "Scores"),
644        ),
645     );
646  }  }
647    
648  sub score_two_families {  sub score_two_families {
# Line 915  Line 705 
705  sub show_sources {  sub show_sources {
706   my $source=$cgi->param('bysource');   my $source=$cgi->param('bysource');
707   # this is the display name and so we need to reverse map it to the source from $fams   # this is the display name and so we need to reverse map it to the source from $fams
708   my $fams=&families();   my $fams=&sources();
709   my $extrahtml;   my $extrahtml;
710   map {$source=$_ if ($source eq $fams->{$_})} keys %$fams;   map {$source=$_ if ($source eq $fams->{$_})} keys %$fams;
711   # now source will be something like fig, kegg, mcl, etc   # now source will be something like fig, kegg, mcl, etc
712   # get all families   # get all families
713   my @families = $fig->families_by_source($source);   my @families = $fig->families_by_source($source);
714   my $label;   my $label;
715   map {$label->{$_}=substr($fig->family_function($_), 0, 100)} @families;   map {$label->{$_}=substr($fig->family_function($_), 0, 100); unless ($label->{$_}) {$label->{$_}=$_}} @families;
716   @families=sort {$label->{$a} cmp $label->{$b}} @families;   @families=sort {$label->{$a} cmp $label->{$b}} @families;
717   # limit the families to some text   # limit the families to some text
718   if ($cgi->param('limitfamiliesto'))   if ($cgi->param('limitfamiliesto'))
# Line 944  Line 734 
734    $extrahtml.=$cgi->p("Limit to PIR SF: ", $cgi->popup_menu(-name=>"pirsflimit", -values=>[keys %$pirsflimits], -labels=>$pirsflimits));    $extrahtml.=$cgi->p("Limit to PIR SF: ", $cgi->popup_menu(-name=>"pirsflimit", -values=>[keys %$pirsflimits], -labels=>$pirsflimits));
735   }   }
736    
737     my $error="";
738     if (scalar(@families) > 1000)
739     {
740        $error .= "<p><b>Warning:</b> This list has been limited to 1,000 families so that it displays easily.<br>\n";
741        $error .= "Please use the text search function below to find the families your are interested in.</p>";
742        @families=splice(@families, 0, 1000);
743     }
744   my $sl=$cgi->scrolling_list(-name=>'family', -values=>\@families, -labels=>$label, -size=>10, -multiple=>0);   my $sl=$cgi->scrolling_list(-name=>'family', -values=>\@families, -labels=>$label, -size=>10, -multiple=>0);
745   push @$html,   push @$html,
746   $cgi->start_form(-method=>'get'), "\n",   $cgi->start_form(-method=>'get'), "\n",
747   "<h2>Protein Families</h2>\n",      $cgi->div({class=>'bordermargin'}, "<h2>These are ", scalar(@families), " protein families from the ", $fams->{$source}, " databse</h2>\n",
748        $error,
749   $cgi->div({class=>'enterprotein'}, "<h2>These are the ", scalar(@families), " protein families for ", $fams->{$source}, "</h2>\n",      "Please choose a protein family from the list and then you will be shown the proteins in that family</p>\n",
  "Please choose a protein family from the list and then you will be shown the proteins in that family",  
750   $sl,   $sl,
751   $cgi->p("You can limit this table to some text: ", $cgi->textfield(-name=>"limitfamiliesto", -value=>"", -size=>20)),   $cgi->p("You can limit this table to some text: ", $cgi->textfield(-name=>"limitfamiliesto", -value=>"", -size=>20)),
752   $extrahtml,   $extrahtml,
753   $cgi->hidden(-name=>'bysource', -value=>$fams->{$source}),   $cgi->hidden(-name=>'bysource', -value=>$fams->{$source}),
754   $cgi->p($cgi->submit(-name=>'bysource', -value=>"Rebuild table"), $cgi->submit('submit', 'Show Family'), $cgi->reset()),   $cgi->p($cgi->submit(-name=>'bysource', -value=>"Rebuild table"), $cgi->submit('submit', 'Show Family'), $cgi->reset()),
755     ),
756     $cgi->end_form;
757     return $html;
758    }
759    
760    
761   ),  sub sources {
762        my ($fam)=@_;
763        my %choices=(
764                "aclame"    => "Aclame",
765                "fig"       => "FIGfams",
766                "tigr"      => "TIGRfams",
767                "pfam"      => "PFAM",
768                "sp"        => "Prosite",
769                "kegg"      => "KEGG",
770                "pir"       => "PIR SuperFams",
771                "mcl"       => "MCL",
772                "cog"       => "COG",
773                );
774        if ($fam) {
775        return $choices{$fam}}
776        else {return \%choices}
777    }
778    
779    sub source_url {
780        my $fam=shift;
781        my %urls=(
782                "aclame"      => "http://aclame.ulb.ac.be/",
783                "fig"         => "proteinfamilies.cgi",
784                "tigr"        => "http://www.tigr.org/TIGRFAMs/",
785                "pfam"        => "http://pfam.wustl.edu/",
786                "sp"          => "http://www.expasy.org/prosite/",
787                "kegg"        => "http://www.genome.ad.jp/kegg/",
788                "pir"         => "http://pir.georgetown.edu/",
789                "mcl"         => "http://www.cbil.upenn.edu/gene-family/",
790                "cog"         => "http://www.ncbi.nlm.nih.gov/COG/",
791                );
792        return $urls{$fam};
793    }
794    
795   $cgi->end_form;  sub source_for_family {
796     my $fam=shift;
797     return unless ($fam);
798     $fam =~ /^(.*?)\|/;
799     return &sources($1) if ($1);
800    }
801    
802    
803    sub freetextsearch {
804        ($fig, $cgi, $html)=@_;
805    
806       my $text=$cgi->param("freetext");
807       my @tab=map {[&source_for_family($_), "<a href=\"proteinfamilies.cgi?family=$_\" target=\"window$$\">" . $fig->family_function($_) . "</a>", $fig->sz_family($_)]}
808                   sort {&source_for_family($a) cmp &source_for_family($b) || $fig->sz_family($b) <=> $fig->sz_family($a)} $fig->family_by_function($text);
809       push @$html,
810        $cgi->p("These are the protein families that have <b>$text</b> somewhere in their name. Please click on one of the families to see more information about them"),
811        &HTML::make_table(["Source", "Family", "Size"], \@tab, "");
812   return $html;   return $html;
813  }  }

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3