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

Diff of /FigWebServices/homologs_in_clusters.cgi

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

revision 1.1, Sun Oct 17 16:40:13 2004 UTC revision 1.14, Wed Oct 15 11:49:20 2008 UTC
# Line 1  Line 1 
1    #
2    # Copyright (c) 2003-2006 University of Chicago and Fellowship
3    # for Interpretations of Genomes. All Rights Reserved.
4    #
5    # This file is part of the SEED Toolkit.
6    #
7    # The SEED Toolkit is free software. You can redistribute
8    # it and/or modify it under the terms of the SEED Toolkit
9    # Public License.
10    #
11    # You should have received a copy of the SEED Toolkit Public License
12    # along with this program; if not write to the University of Chicago
13    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14    # Genomes at veronika@thefig.info or download a copy from
15    # http://www.theseed.org/LICENSE.TXT.
16    #
17    
18  #### start #####  #### start #####
19  use FIG;  use InterfaceRoutines;
20  my $fig = new FIG;  
21    
22  use HTML;  use HTML;
23  use strict;  use strict;
24  use CGI;  use CGI;
25  my $cgi = new CGI;  use FIG_CGI;
26    use FIG;
27    
28    my $sproutAvail = eval {
29        require SproutFIG;
30        require PageBuilder;
31    };
32    
33    my($fig_or_sprout, $cgi) = FIG_CGI::init();
34    if (ref $fig_or_sprout eq 'SFXlate') {
35        my $prot = $cgi->param('prot');
36        print $cgi->redirect(-uri => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/SeedViewer?page=Evidence;feature=$prot",
37                             -status => 301);
38    }
39    
40    my $html = [];
41    
42    unshift @$html, "<TITLE>The Homologs in  Clusters Page</TITLE>\n";
43    
44  if (0)  if (0)
45  {  {
# Line 36  Line 70 
70      exit;      exit;
71  }  }
72    
 my $html = [];  
 unshift @$html, "<TITLE>The SEED: Homologs in Clusters Page</TITLE>\n";  
   
73  my $prot = $cgi->param('prot');  my $prot = $cgi->param('prot');
74  if (! $prot)  if (! $prot)
75  {  {
# Line 50  Line 81 
81    
82  if ($prot !~ /^fig\|/)  if ($prot !~ /^fig\|/)
83  {  {
84      my @poss = $fig->by_alias($prot);      my @poss = $fig_or_sprout->by_alias($prot);
85      if (@poss > 0)      if (@poss > 0)
86      {      {
87          $prot = $poss[0];          $prot = $poss[0];
# Line 63  Line 94 
94      }      }
95  }  }
96    
97  &compute_desired_homologs($fig,$cgi,$html,$prot);  &compute_desired_homologs($fig_or_sprout,$cgi,$html,$prot);
98    
99    if (ref $fig_or_sprout eq 'SFXlate')
100    {
101        my $h = { homologs => $html,
102                  title => "NMPDR Homologs in Clusters Page"};
103    
104        print "Content-Type: text/html\n";
105        print "\n";
106        my $templ = "$FIG_Config::template_url/Homologs_tmpl.php";
107        print PageBuilder::Build("$templ", $h,"Html");
108    }
109    else
110    {
111  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
112    }
113  exit;  exit;
114    
115  sub compute_desired_homologs {  sub compute_desired_homologs {
116      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
117    
118      my @pinned = &relevant_homologs($fig,$cgi,$peg);      my @pinned = &relevant_homologs($fig_or_sprout,$cgi,$peg);
119  #   print STDERR &Dumper(\@pinned);  #   print STDERR &Dumper(\@pinned);
120    
121      my @clusters = sort { (@$b <=> @$a) } &sets_of_homologs($fig,$cgi,$peg,\@pinned);  #    my @clusters = sort { (@$b <=> @$a) } &sets_of_homologs($fig_or_sprout,$cgi,$peg,\@pinned);
122  #   print STDERR &Dumper(\@clusters);  #   print STDERR &Dumper(\@clusters);
123    
124      my @homologs = &extract_homologs($peg,\@pinned,\@clusters);  #    my @homologs = &extract_homologs($peg,\@pinned,\@clusters);
125  #   print STDERR &Dumper(\@homologs);  #   print STDERR &Dumper(\@homologs);
126    
127      my $sc;      my $sc;
128      my @tab = map { ($peg,$sc) = @$_; [$sc,      my @tab = map { my($peg,$sc,$sim) = @$_; [$sim,$sc,
129                                         &HTML::fid_link($cgi,$peg),                                         &HTML::fid_link($cgi,$peg),
130                                         scalar $fig->function_of($peg,$cgi->param('user')),                                         $fig_or_sprout->genus_species($fig_or_sprout->genome_of($peg)),
131                                         &HTML::set_prot_links($cgi,join( ', ', $fig->feature_aliases($peg) ))                                         scalar $fig_or_sprout->function_of($peg,$cgi->param('user')),
132                                        ] } @homologs;                                         &HTML::set_prot_links($cgi,join( ', ', $fig_or_sprout->feature_aliases($peg) ))
133      push(@$html,&HTML::make_table(["Crude Score","PEG","Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));                                        ] } @pinned;
134        if (@tab > 0)
135        {
136            push(@$html,&HTML::make_table(["Sim. Sc.","Cluster Size","PEG","Genome", "Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));
137        }
138        else
139        {
140            push(@$html, $cgi->h1("Sorry, we have no clusters containing homologs of $peg"));
141        }
142  }  }
143    
144  sub relevant_homologs {  sub relevant_homologs {
145      my($fig,$cgi,$peg) = @_;      my($fig_or_sprout,$cgi,$peg) = @_;
146      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);
147    
148      $maxN = $cgi->param('maxN');      $maxN = $cgi->param('maxN');
# Line 98  Line 151 
151      $maxP = $cgi->param('maxP');      $maxP = $cgi->param('maxP');
152      $maxP = $maxP ? $maxP : 1.0e-10;      $maxP = $maxP ? $maxP : 1.0e-10;
153    
154      my @sims = $fig->sims( $peg, $maxN, $maxP, "fig");      my @sims = $fig_or_sprout->sims( $peg, $maxN, $maxP, "fig");
155    
156      my @homologs = ();      my @homologs = ();
157      $seen{&FIG::genome_of($peg)} = 1;      $seen{&FIG::genome_of($peg)} = 1;
# Line 106  Line 159 
159      {      {
160          $id2     = $sim->id2;          $id2     = $sim->id2;
161          $genome2 = &FIG::genome_of($id2);          $genome2 = &FIG::genome_of($id2);
162          if (! $seen{$genome2})          my @coup;
163            if ((! $seen{$genome2}) && (@coup = $fig_or_sprout->coupled_to($id2)) && (@coup > 0))
164          {          {
165              $seen{$genome2} = 1;              $seen{$genome2} = 1;
166              push(@homologs,$id2);              push(@homologs,[$id2,@coup+1,$sim->psc]);
167          }          }
168      }      }
169      return @homologs;      return sort { $b->[1] <=> $a->[1] } @homologs;
170  }  }
171    
172  sub sets_of_homologs {  sub sets_of_homologs {
173      my($fig,$cgi,$given_peg,$pinned) = @_;      my($fig_or_sprout,$cgi,$given_peg,$pinned) = @_;
174      my($peg,$mid,$min,$max,$feat,$fid);      my($peg,$mid,$min,$max,$feat,$fid);
175    
176      my $bound = $cgi->param('bound');      my $bound = $cgi->param('bound');
# Line 125  Line 179 
179      my @pegs = ();      my @pegs = ();
180      foreach $peg (($given_peg,@$pinned))      foreach $peg (($given_peg,@$pinned))
181      {      {
182          my $loc = $fig->feature_location($peg);          my $loc = $fig_or_sprout->feature_location($peg);
183          if ($loc)          if ($loc)
184          {          {
185              my($contig,$beg,$end) = &FIG::boundaries_of($loc);          my($contig,$beg,$end) = $fig_or_sprout->boundaries_of($loc);
186              if ($contig && $beg && $end)              if ($contig && $beg && $end)
187              {              {
188                  $mid = int(($beg + $end) / 2);                  $mid = int(($beg + $end) / 2);
189                  $min = $mid - $bound;                  $min = $mid - $bound;
190                  $max = $mid + $bound;                  $max = $mid + $bound;
191    
192                  ($feat,undef,undef) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);                  ($feat,undef,undef) = &genes_in_region($fig_or_sprout,$cgi,&FIG::genome_of($peg),$contig,$min,$max);
193                  foreach $fid (@$feat)                  foreach $fid (@$feat)
194                  {                  {
195                      if (&FIG::ftype($fid) eq "peg")                      if (&FIG::ftype($fid) eq "peg")
# Line 150  Line 204 
204      my %represents;      my %represents;
205      foreach $peg (@pegs)      foreach $peg (@pegs)
206      {      {
207          my $tmp = $fig->maps_to_id($peg);          my $tmp = $fig_or_sprout->maps_to_id($peg);
208          push(@{$represents{$tmp}},$peg);          push(@{$represents{$tmp}},$peg);
209    #       if ($tmp ne $peg) { push(@{$represents{$peg}},$peg) }
210      }      }
211      my($sim,%conn,$x,$y,$i,$j);      my($sim,%conn,$x,$y,$i,$j);
212      foreach $y (keys(%represents))      foreach $y (keys(%represents))
# Line 175  Line 230 
230    
231      foreach $peg (@pegs)      foreach $peg (@pegs)
232      {      {
233          foreach $sim ($fig->sims($peg,$maxN,$maxP,"raw"))          foreach $sim ($fig_or_sprout->sims( $peg, $maxN, $maxP, "raw"))
234          {          {
235              if (defined($x = $represents{$sim->id2}))              if (defined($x = $represents{$sim->id2}))
236              {              {

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.14

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3