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

Diff of /FigWebServices/find_poss_subsys_instances.cgi

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

revision 1.1, Thu Nov 15 21:06:50 2007 UTC revision 1.2, Sun Nov 18 15:09:30 2007 UTC
# Line 37  Line 37 
37  #   print STDERR &Dumper($cgi);  #   print STDERR &Dumper($cgi);
38  }  }
39    
40  if (1)  if (0)
41  {  {
42      print $cgi->header;      print $cgi->header;
43      my @params = $cgi->param;      my @params = $cgi->param;
# Line 47  Line 47 
47          print "$_\t:",join(",",$cgi->param($_)),":\n";          print "$_\t:",join(",",$cgi->param($_)),":\n";
48      }      }
49    
50      if (1)      if (0)
51      {      {
52          if (open(TMP,">/tmp/find_subsys_parms"))          if (open(TMP,">/tmp/find_subsys_parms"))
53          {          {
# Line 58  Line 58 
58      exit;      exit;
59  }  }
60    
61    use FigFams;
62    my $figfams = new FigFams($fig);
63    
64    use ToCall;
65    
66  my $html = [];  my $html = [];
67  unshift @$html, "<TITLE>Find Instances of a Subsystem</TITLE>\n";  unshift @$html, "<TITLE>Find Instances of a Subsystem</TITLE>\n";
68    
# Line 67  Line 72 
72  my $rules        = $cgi->param('rules');  my $rules        = $cgi->param('rules');
73  my @orgs         = $cgi->param('korgs');  my @orgs         = $cgi->param('korgs');
74  @orgs            = map { $_ =~ /(\d+\.\d+)/; $1 } @orgs;  @orgs            = map { $_ =~ /(\d+\.\d+)/; $1 } @orgs;
   
75  my(@rolesI,@rulesI,@definitionsI);  my(@rolesI,@rulesI,@definitionsI);
76  if ($roles =~ /\S/)  if ($roles =~ /\S/)
77  {  {
# Line 89  Line 93 
93    
94  my %org_labels;  my %org_labels;
95    
96  if ((! $subsys) || (@rolesI < 1) || (@rulesI < 1))  if ((! $subsys) || (@rolesI < 1) || (@rulesI < 1) || (@orgs < 1))
97  {  {
98      my @orgs = ();      my @orgs = ();
99      foreach my $org ($fig->genomes('complete'))      foreach my $org ($fig->genomes('complete'))
# Line 121  Line 125 
125  }  }
126  else  else
127  {  {
128      my $col_headers_undef = ["Predicted Variant","Genome","Genus/Species"];      my %genomesS = map { $_ => 1 } @orgs;
     my $tab_undef = [];  
     my $col_headers_mismatch = ["Actual Variant","Predicted Variant","Genome","Genus/Species"];  
     my $tab_mismatch = [];  
   
     my $subO = new Subsystem($subsys,$fig);  
     my %genomesS = map { $_ => 1 } $subO->get_genomes;  
129    
130      my $encoding = [[],0];   # Encoding is a 2-tuple [Memory,NxtAvail]      my $encoding = [[],0];   # Encoding is a 2-tuple [Memory,NxtAvail]
131      my $abbrev_to_loc = {};      my $abbrev_to_loc = {};
# Line 154  Line 152 
152              else              else
153              {              {
154                  my $n = @rules;                  my $n = @rules;
                 push(@$html,$cgi->h2("successfully parsed $n rules"));  
                 my $role_to_pegs = {};  
                 foreach my $role (@roles)  
                 {  
                     $role_to_pegs->{$role} = [ sort { &FIG::by_fig_id($a,$b) }  
                                                $fig->role_to_pegs($role)  
                                                ];  
                 }  
   
155                  my $operational = 0;                  my $operational = 0;
156                  foreach my $genome (map { $_->[0] }                  foreach my $genome (map { $_->[0] }
157                                      sort { $a->[1] cmp $b->[1] }                                      sort { $a->[1] cmp $b->[1] }
158                                      map { [$_,$fig->genus_species($_)] }                                      map { [$_,$fig->genus_species($_)] }
159                                      $fig->genomes('complete'))                                      @orgs)
                 {  
                     my $vcT = &find_vc($encoding,$role_to_pegs,$abbrev_to_loc,\@rules,$fig,$genome);  
                     if ($vcT > 0) { $operational++ }  
   
                     if (! $genomesS{$genome})  
                     {  
                         push(@$tab_undef,[$vcT,$genome,$fig->genus_species($genome)]);  
                     }  
                     else  
                     {  
                         my $vcS = $subO->get_variant_code_for_genome($genome);  
                         if ($vcT ne $vcS)  
                         {  
                             push(@$tab_mismatch,[$vcS,$vcT,$genome,$fig->genus_species($genome)]);  
                         }  
                     }  
                 }  
                 push(@$html,$cgi->h2("Got $operational operational variants"));  
   
                 if (@$tab_undef > 0)  
160                  {                  {
161                      push(@$html,&HTML::make_table($col_headers_undef,$tab_undef,"Genomes to Be Added To Subsystem"),$cgi->br,$cgi->br);                      my($vcT,$tab) = &find_vc($encoding,\@roles,$figfams,$abbrev_to_loc,\@rules,$fig,$genome,$cgi);
162                  }                      my $gs = $fig->genus_species($genome);
163                        push(@$html,$cgi->h1("$vcT for $genome [$gs]"),$tab);
                 if (@$tab_mismatch > 0)  
                 {  
                     push(@$html,&HTML::make_table($col_headers_mismatch,$tab_mismatch,"Genomes With Mismatching Variant Codes"));  
164                  }                  }
165              }              }
166          }          }
# Line 204  Line 170 
170    
171    
172  sub find_vc {  sub find_vc {
173      my($encoding,$role_to_pegs,$abbrev_to_loc,$rules,$fig,$genome) = @_;      my($encoding,$roles,$figfams,$abbrev_to_loc,$rules,$fig,$genome,$cgi) = @_;
174    
175      my $vcT = undef;      my $vcT = undef;
176      my $rule;      my $rule;
177    
178      my $role;      my $role;
179      my $relevant_genes = {};      my $relevant_genes = {};
180      foreach $role (sort keys(%$role_to_pegs))      my $tab = [];
181        foreach $role (@$roles)
182      {      {
183          $relevant_genes->{$role} = &gather_genes($fig,$genome,$role,$role_to_pegs);          $relevant_genes->{$role} = &gather_genes($fig,$genome,$figfams,$role);
184            foreach my $x (@{$relevant_genes->{$role}})
185            {
186                my($peg,$func) = @$x;
187                my $link = &HTML::fid_link($cgi,$peg,1);
188                push(@$tab,[$link,$func]);
189            }
190      }      }
191    
192      my($i,$matched);      my($i,$matched);
# Line 223  Line 196 
196      }      }
197    
198      my $vcT = defined($matched) ? $matched : -1;      my $vcT = defined($matched) ? $matched : -1;
199      return $vcT;      my $pegs = &HTML::make_table(["PEG","Proposed Function"],$tab,"PEGs with Relevant Functions");
200        return ($vcT,$pegs);
201  }  }
202    
203  sub load_roles {  sub load_roles {
# Line 351  Line 325 
325      return ($s =~ /^\s*<(\d+)>\s*$/) ? $1 : undef;      return ($s =~ /^\s*<(\d+)>\s*$/) ? $1 : undef;
326  }  }
327    
   
328  sub gather_genes {  sub gather_genes {
329      my($fig,$genome,$role,$role_to_pegs) = @_;      my($fig,$genome,$figfams,$role) = @_;
330        my($fam_id,$peg,$hit,%found);
331    
332    #   print STDERR "Gathering for role=$role\n";
333    
334      return [sort { &FIG::by_fig_id($a,$b) }      my $genomeO = new ToCall("$FIG_Config::organisms/$genome");
335              grep { &FIG::genome_of($_) eq $genome }      my @fam_ids = $figfams->families_with_functional_role($role);
336              @{$role_to_pegs->{$role}} ];  #   print STDERR "Families for role: ",join(",",@fam_ids),"\n";
337    
338        foreach $fam_id (@fam_ids)
339        {
340            my $figfam = new FigFam($fig,$fam_id);
341            my $query;
342    
343            foreach $query ($figfam->representatives)
344            {
345                foreach $hit ($genomeO->candidate_orfs(-seq => $query))
346                {
347    #               print STDERR "        candidate=",$hit->get_fid,"\n";
348                    my $hit_seq = $hit->seq;
349                    my($ok,undef) = $figfam->should_be_member($hit_seq);
350                    if ($ok)
351                    {
352    #                   print STDERR "             match\n";
353                        $found{$hit->get_fid} = $figfam->family_function;
354                    }
355                }
356            }
357        }
358        return [sort { &FIG::by_fig_id($a->[0],$b->[0]) } map { [$_,$found{$_}] } keys(%found)];
359  }  }
360    
361  sub is_rule_true {  sub is_rule_true {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3