[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.3, Fri Jun 3 00:27:44 2005 UTC revision 1.3.2.3, Tue Jul 12 15:39:01 2005 UTC
# Line 1  Line 1 
1  #### start #####  #### start #####
2  use FIG;  use InterfaceRoutines;
3  my $fig = new FIG;  
4    
5  use HTML;  use HTML;
6  use strict;  use strict;
7  use CGI;  use CGI;
8  my $cgi = new CGI;  my $cgi = new CGI;
9    
10    use FIG;
11    my $sproutAvail = eval {
12        require SproutFIG;
13        require PageBuilder;
14    };
15    
16    my($fig_or_sprout);
17    my $is_sprout;
18    my $html = [];
19    
20    if ($cgi->param('SPROUT')) {
21        $is_sprout = 1;
22        $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
23        unshift @$html, "<TITLE>The NMPDR Homologs in Clusters Page</TITLE>\n";
24    } else {
25        $is_sprout = 0;
26        $fig_or_sprout = new FIG;
27        unshift @$html, "<TITLE>The SEED Homologs in  Clusters Page</TITLE>\n";
28    }
29    
30  if (0)  if (0)
31  {  {
32      my $VAR1;      my $VAR1;
# Line 36  Line 56 
56      exit;      exit;
57  }  }
58    
 my $html = [];  
 unshift @$html, "<TITLE>The SEED: Homologs in Clusters Page</TITLE>\n";  
   
59  my $prot = $cgi->param('prot');  my $prot = $cgi->param('prot');
60  if (! $prot)  if (! $prot)
61  {  {
# Line 50  Line 67 
67    
68  if ($prot !~ /^fig\|/)  if ($prot !~ /^fig\|/)
69  {  {
70      my @poss = $fig->by_alias($prot);      my @poss = $fig_or_sprout->by_alias($prot);
71      if (@poss > 0)      if (@poss > 0)
72      {      {
73          $prot = $poss[0];          $prot = $poss[0];
# Line 63  Line 80 
80      }      }
81  }  }
82    
83  &compute_desired_homologs($fig,$cgi,$html,$prot);  &compute_desired_homologs($fig_or_sprout,$cgi,$html,$prot);
84    
85    if ($is_sprout)
86    {
87        my $h = { homologs => $html };
88    
89        print "Content-Type: text/html\n";
90        print "\n";
91        my $templ = "$FIG_Config::fig/CGI/Html/Homologs_tmpl.html";
92        print PageBuilder::Build("<$templ", $h,"Html");
93    }
94    else
95    {
96  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
97    }
98  exit;  exit;
99    
100  sub compute_desired_homologs {  sub compute_desired_homologs {
101      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
102    
103      my @pinned = &relevant_homologs($fig,$cgi,$peg);      my @pinned = &relevant_homologs($fig_or_sprout,$cgi,$peg);
104  #   print STDERR &Dumper(\@pinned);  #   print STDERR &Dumper(\@pinned);
105    
106  #    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);
107  #   print STDERR &Dumper(\@clusters);  #   print STDERR &Dumper(\@clusters);
108    
109  #    my @homologs = &extract_homologs($peg,\@pinned,\@clusters);  #    my @homologs = &extract_homologs($peg,\@pinned,\@clusters);
110  #   print STDERR &Dumper(\@homologs);  #   print STDERR &Dumper(\@homologs);
111    
112      my $sc;      my $sc;
113      my @tab = map { ($peg,$sc) = @$_; [$sc,      my @tab = map { my($peg,$sc,$sim) = @$_; [$sim,$sc,
114                                         &HTML::fid_link($cgi,$peg),                                         &HTML::fid_link($cgi,$peg),
115                                         $fig->genus_species($fig->genome_of($peg)),                                         $fig_or_sprout->genus_species($fig_or_sprout->genome_of($peg)),
116                                         scalar $fig->function_of($peg,$cgi->param('user')),                                         scalar $fig_or_sprout->function_of($peg,$cgi->param('user')),
117                                         &HTML::set_prot_links($cgi,join( ', ', $fig->feature_aliases($peg) ))                                         &HTML::set_prot_links($cgi,join( ', ', $fig_or_sprout->feature_aliases($peg) ))
118                                        ] } @pinned;                                        ] } @pinned;
119      push(@$html,&HTML::make_table(["Score","PEG","Genome", "Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));      if (@tab > 0)
120        {
121            push(@$html,&HTML::make_table(["Sim. Sc.","Cluster Size","PEG","Genome", "Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));
122        }
123        else
124        {
125            push(@$html, $cgi->h1("Sorry, we have no clusters containing homologs of $peg"));
126        }
127  }  }
128    
129  sub relevant_homologs {  sub relevant_homologs {
130      my($fig,$cgi,$peg) = @_;      my($fig_or_sprout,$cgi,$peg) = @_;
131      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);
132    
133      $maxN = $cgi->param('maxN');      $maxN = $cgi->param('maxN');
# Line 99  Line 136 
136      $maxP = $cgi->param('maxP');      $maxP = $cgi->param('maxP');
137      $maxP = $maxP ? $maxP : 1.0e-10;      $maxP = $maxP ? $maxP : 1.0e-10;
138    
139      my @sims = $fig->sims( $peg, $maxN, $maxP, "fig");      my @sims = $fig_or_sprout->sims( $peg, $maxN, $maxP, "fig");
140    
141      my @homologs = ();      my @homologs = ();
142      $seen{&FIG::genome_of($peg)} = 1;      $seen{&FIG::genome_of($peg)} = 1;
# Line 108  Line 145 
145          $id2     = $sim->id2;          $id2     = $sim->id2;
146          $genome2 = &FIG::genome_of($id2);          $genome2 = &FIG::genome_of($id2);
147          my @coup;          my @coup;
148          if ((! $seen{$genome2}) && (@coup = $fig->coupled_to($id2)) && (@coup > 0))          if ((! $seen{$genome2}) && (@coup = $fig_or_sprout->coupled_to($id2)) && (@coup > 0))
149          {          {
150              $seen{$genome2} = 1;              $seen{$genome2} = 1;
151              push(@homologs,[$id2,scalar @coup]);              push(@homologs,[$id2,@coup+1,$sim->psc]);
152          }          }
153      }      }
154      return sort { $b->[1] <=> $a->[1] } @homologs;      return sort { $b->[1] <=> $a->[1] } @homologs;
155  }  }
156    
157  sub sets_of_homologs {  sub sets_of_homologs {
158      my($fig,$cgi,$given_peg,$pinned) = @_;      my($fig_or_sprout,$cgi,$given_peg,$pinned) = @_;
159      my($peg,$mid,$min,$max,$feat,$fid);      my($peg,$mid,$min,$max,$feat,$fid);
160    
161      my $bound = $cgi->param('bound');      my $bound = $cgi->param('bound');
# Line 127  Line 164 
164      my @pegs = ();      my @pegs = ();
165      foreach $peg (($given_peg,@$pinned))      foreach $peg (($given_peg,@$pinned))
166      {      {
167          my $loc = $fig->feature_location($peg);          my $loc = $fig_or_sprout->feature_location($peg);
168          if ($loc)          if ($loc)
169          {          {
170              my($contig,$beg,$end) = &FIG::boundaries_of($loc);              my($contig,$beg,$end) = &FIG::boundaries_of($loc);
# Line 137  Line 174 
174                  $min = $mid - $bound;                  $min = $mid - $bound;
175                  $max = $mid + $bound;                  $max = $mid + $bound;
176    
177                  ($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);
178                  foreach $fid (@$feat)                  foreach $fid (@$feat)
179                  {                  {
180                      if (&FIG::ftype($fid) eq "peg")                      if (&FIG::ftype($fid) eq "peg")
# Line 152  Line 189 
189      my %represents;      my %represents;
190      foreach $peg (@pegs)      foreach $peg (@pegs)
191      {      {
192          my $tmp = $fig->maps_to_id($peg);          my $tmp = $fig_or_sprout->maps_to_id($peg);
193          push(@{$represents{$tmp}},$peg);          push(@{$represents{$tmp}},$peg);
194    #       if ($tmp ne $peg) { push(@{$represents{$peg}},$peg) }
195      }      }
196      my($sim,%conn,$x,$y,$i,$j);      my($sim,%conn,$x,$y,$i,$j);
197      foreach $y (keys(%represents))      foreach $y (keys(%represents))
# Line 177  Line 215 
215    
216      foreach $peg (@pegs)      foreach $peg (@pegs)
217      {      {
218          foreach $sim ($fig->sims($peg,$maxN,$maxP,"raw"))          foreach $sim ($fig_or_sprout->sims( $peg, $maxN, $maxP, "raw"))
219          {          {
220              if (defined($x = $represents{$sim->id2}))              if (defined($x = $represents{$sim->id2}))
221              {              {

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.3.2.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3