[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.1, Mon Jun 27 15:26:45 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  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
85  exit;  exit;
86    
87  sub compute_desired_homologs {  sub compute_desired_homologs {
88      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
89    
90      my @pinned = &relevant_homologs($fig,$cgi,$peg);      my @pinned = &relevant_homologs($fig_or_sprout,$cgi,$peg);
91  #   print STDERR &Dumper(\@pinned);  #   print STDERR &Dumper(\@pinned);
92    
93  #    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);
94  #   print STDERR &Dumper(\@clusters);  #   print STDERR &Dumper(\@clusters);
95    
96  #    my @homologs = &extract_homologs($peg,\@pinned,\@clusters);  #    my @homologs = &extract_homologs($peg,\@pinned,\@clusters);
# Line 82  Line 99 
99      my $sc;      my $sc;
100      my @tab = map { ($peg,$sc) = @$_; [$sc,      my @tab = map { ($peg,$sc) = @$_; [$sc,
101                                         &HTML::fid_link($cgi,$peg),                                         &HTML::fid_link($cgi,$peg),
102                                         $fig->genus_species($fig->genome_of($peg)),                                         $fig_or_sprout->genus_species($fig_or_sprout->genome_of($peg)),
103                                         scalar $fig->function_of($peg,$cgi->param('user')),                                         scalar $fig_or_sprout->function_of($peg,$cgi->param('user')),
104                                         &HTML::set_prot_links($cgi,join( ', ', $fig->feature_aliases($peg) ))                                         &HTML::set_prot_links($cgi,join( ', ', $fig_or_sprout->feature_aliases($peg) ))
105                                        ] } @pinned;                                        ] } @pinned;
106      push(@$html,&HTML::make_table(["Score","PEG","Genome", "Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));      push(@$html,&HTML::make_table(["Score","PEG","Genome", "Function","Aliases"],\@tab,"PEGs that Might Be in Clusters"));
107  }  }
108    
109  sub relevant_homologs {  sub relevant_homologs {
110      my($fig,$cgi,$peg) = @_;      my($fig_or_sprout,$cgi,$peg) = @_;
111      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);      my($maxN,$maxP,$genome1,$sim,$id2,$genome2,%seen);
112    
113      $maxN = $cgi->param('maxN');      $maxN = $cgi->param('maxN');
# Line 99  Line 116 
116      $maxP = $cgi->param('maxP');      $maxP = $cgi->param('maxP');
117      $maxP = $maxP ? $maxP : 1.0e-10;      $maxP = $maxP ? $maxP : 1.0e-10;
118    
119      my @sims = $fig->sims( $peg, $maxN, $maxP, "fig");      my @sims = $fig_or_sprout->sims( $peg, $maxN, $maxP, "fig");
120    
121      my @homologs = ();      my @homologs = ();
122      $seen{&FIG::genome_of($peg)} = 1;      $seen{&FIG::genome_of($peg)} = 1;
# Line 108  Line 125 
125          $id2     = $sim->id2;          $id2     = $sim->id2;
126          $genome2 = &FIG::genome_of($id2);          $genome2 = &FIG::genome_of($id2);
127          my @coup;          my @coup;
128          if ((! $seen{$genome2}) && (@coup = $fig->coupled_to($id2)) && (@coup > 0))          if ((! $seen{$genome2}) && (@coup = $fig_or_sprout->coupled_to($id2)) && (@coup > 0))
129          {          {
130              $seen{$genome2} = 1;              $seen{$genome2} = 1;
131              push(@homologs,[$id2,scalar @coup]);              push(@homologs,[$id2,scalar @coup]);
# Line 118  Line 135 
135  }  }
136    
137  sub sets_of_homologs {  sub sets_of_homologs {
138      my($fig,$cgi,$given_peg,$pinned) = @_;      my($fig_or_sprout,$cgi,$given_peg,$pinned) = @_;
139      my($peg,$mid,$min,$max,$feat,$fid);      my($peg,$mid,$min,$max,$feat,$fid);
140    
141      my $bound = $cgi->param('bound');      my $bound = $cgi->param('bound');
# Line 127  Line 144 
144      my @pegs = ();      my @pegs = ();
145      foreach $peg (($given_peg,@$pinned))      foreach $peg (($given_peg,@$pinned))
146      {      {
147          my $loc = $fig->feature_location($peg);          my $loc = $fig_or_sprout->feature_location($peg);
148          if ($loc)          if ($loc)
149          {          {
150              my($contig,$beg,$end) = &FIG::boundaries_of($loc);              my($contig,$beg,$end) = &FIG::boundaries_of($loc);
# Line 137  Line 154 
154                  $min = $mid - $bound;                  $min = $mid - $bound;
155                  $max = $mid + $bound;                  $max = $mid + $bound;
156    
157                  ($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);
158                  foreach $fid (@$feat)                  foreach $fid (@$feat)
159                  {                  {
160                      if (&FIG::ftype($fid) eq "peg")                      if (&FIG::ftype($fid) eq "peg")
# Line 152  Line 169 
169      my %represents;      my %represents;
170      foreach $peg (@pegs)      foreach $peg (@pegs)
171      {      {
172          my $tmp = $fig->maps_to_id($peg);          my $tmp = $fig_or_sprout->maps_to_id($peg);
173          push(@{$represents{$tmp}},$peg);          push(@{$represents{$tmp}},$peg);
174    #       if ($tmp ne $peg) { push(@{$represents{$peg}},$peg) }
175      }      }
176      my($sim,%conn,$x,$y,$i,$j);      my($sim,%conn,$x,$y,$i,$j);
177      foreach $y (keys(%represents))      foreach $y (keys(%represents))
# Line 177  Line 195 
195    
196      foreach $peg (@pegs)      foreach $peg (@pegs)
197      {      {
198          foreach $sim ($fig->sims($peg,$maxN,$maxP,"raw"))          foreach $sim ($fig_or_sprout->sims( $peg, $maxN, $maxP, "raw"))
199          {          {
200              if (defined($x = $represents{$sim->id2}))              if (defined($x = $represents{$sim->id2}))
201              {              {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3