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

Diff of /FigWebServices/hope_tools.cgi

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

revision 1.2, Fri May 18 13:37:25 2007 UTC revision 1.3, Fri Nov 2 19:13:21 2007 UTC
# Line 1  Line 1 
1  use CGI;  #!/usr/bin/env /Users/fig/FIGdisk/env/mac/bin/perl
2    BEGIN {
3        @INC = qw(
4                  /Volumes/Bay3/FIGdisk.v5/dist/releases/dejongh/mac/lib
5                  /Volumes/Bay3/FIGdisk.v5/dist/releases/dejongh/mac/lib/FigKernelPackages
6                  /Users/fig/FIGdisk/dist/dejongh/mac/lib
7                  /Users/fig/FIGdisk/dist/dejongh/mac/lib/FigKernelPackages
8                  /Users/fig/FIGdisk/env/mac/lib/perl5/5.8.7/darwin-2level
9                  /Users/fig/FIGdisk/env/mac/lib/perl5/5.8.7
10                  /Users/fig/FIGdisk/env/mac/lib/perl5/site_perl/5.8.7/darwin-2level
11                  /Users/fig/FIGdisk/env/mac/lib/perl5/site_perl/5.8.7
12                  /Users/fig/FIGdisk/env/mac/lib/perl5/site_perl
13                  .
14                  /Users/fig/FIGdisk/config
15    
16                 );
17      }
18    use CGI;
19  use strict;  use strict;
20  use integer;  use integer;
21  use FIG;  use FIG;
# Line 8  Line 24 
24  use HTML;  use HTML;
25  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
26  use model;  use model;
27    use Switch;
28    
29  our $fig = new FIG;  our $fig = new FIG;
30  my $cgi = new CGI;  my $cgi = new CGI;
# Line 15  Line 32 
32  my($p, $v);  my($p, $v);
33    
34    
   
35  #-----------------------------------------------------------------------  #-----------------------------------------------------------------------
36  #  Initial tools page  #  Initial tools page
37  #-----------------------------------------------------------------------  #-----------------------------------------------------------------------
38  my $user = $cgi->param("user");  my $user = $cgi->param("user");
39    my %params = $cgi->Vars;
40    my $param;
41    
42  push @$html, "<TITLE>The SEED: Subsystem Tools</TITLE>\n";  push @$html, "<TITLE>The SEED: Subsystem Tools</TITLE>\n";
43  push (@$html , "<table width=\"100%\" cellspacing=2 ><tr><td bgcolor=\"lightblue\"><font size=\"+3\" >",  push (@$html , "<table width=\"100%\" cellspacing=2 ><tr><td bgcolor=\"lightblue\"><font size=\"+3\" >",
# Line 28  Line 46 
46  $cgi->submit(-name => 'find_kegg_id', -label =>"Find KEGG ID"),  $cgi->submit(-name => 'find_kegg_id', -label =>"Find KEGG ID"),
47  $cgi->submit(-name => 'find_kegg_reaction', -label =>"Find KEGG Reaction"),  $cgi->submit(-name => 'find_kegg_reaction', -label =>"Find KEGG Reaction"),
48  $cgi->submit(-name => 'EC_search', -label =>"EC Number Search"),  $cgi->submit(-name => 'EC_search', -label =>"EC Number Search"),
49          $cgi->submit(-name => 'create_maps_for_org', -label => "Reactions not in Subsystems"),
50          $cgi->submit(-name => 'update_kegg', -label => "Update KEGG"),
51          $cgi->submit(-name => 'update_hope', -label => "Update Hope Info"),
52  $cgi->hidden(-name => 'user', $user),  $cgi->hidden(-name => 'user', $user),
53  "</font></table>\n", $cgi->end_form);  "</font></table>\n", $cgi->end_form);
54    
55  #if($cgi->param("user")){  if($cgi -> param("kegg_name_id_org") eq "1 Select\tan\torganism")
56  #       push(@$html , $cgi->param("user"));    {
57  #}      delete $params{"kegg_name_id_org"};
   
 my $reaction = $cgi->param('kegg_reaction');  
   
 unless($cgi->param("find_kegg_reaction") || $cgi->param("kegg_reaction") || $cgi->param("kegg_id") || $cgi->param("EC_number") || $cgi->param("find_kegg_id") || $cgi->param("EC_search")){  
         Start_Page();  
58  }  }
59    if($cgi -> param("kegg_name_id_org_ec") eq "1 Select\tan\torganism")
60  if($cgi->param("find_kegg_id") || $cgi->param("kegg_id")){    {
61          find_kegg_id();      delete $params{"kegg_name_id_org_ec"};
62  }  }
63    if(defined $params{"user"})
64  if($cgi->param("find_kegg_reaction") || $cgi->param("kegg_reaction")){    {
65          find_kegg_reaction();      delete($params{"user"});
66      }
67    if(defined $params{"start_page"})
68      {
69        delete($params{"start_page"});
70      }
71    foreach (keys %params)
72      {
73        if($params{$_} ne "")
74          {
75            $param = $_;
76  }  }
   
 if($cgi->param("EC_search") || $cgi->param("EC_number")){  
         EC_search();  
77  }  }
78    
79  #push (@$html , "<br><br><br><table width=\"100%\" cellspacing=2 ><tr><td bgcolor=\"lightblue\"><font size=\"+3\" >");  switch ($param){
80      case "update_hope" {update_hope();}
81        case "find_kegg_id" {find_kegg_id();}
82          case "kegg_id" {find_kegg_id();}
83            case "update_kegg" {update_kegg();}
84              case "find_kegg_reaction" {find_kegg_reaction();}
85                case "kegg_reaction" {find_kegg_reaction();}
86                  case "EC_search" {EC_search();}
87                    case "EC_number" {EC_search();}
88                      case "create_maps_for_org" {create_maps_for_org();}
89                        case "kegg_name_id_org"{create_maps_for_org();}
90                          case "kegg_name_id_org_ec"{miss_react_by_subsystem();}
91                            case "kegg_name"{create_the_kegg_dir();}
92                                else  {Start_Page();}
93    }
94    
95  &HTML::show_page($cgi,$html, 1);  &HTML::show_page($cgi,$html, 1);
96  exit;  exit;
# Line 61  Line 98 
98  sub Start_Page {  sub Start_Page {
99          my $user = $cgi->param("user");          my $user = $cgi->param("user");
100    
101          push (@$html , "<center><h1>Welcome to Scenario Tools</h1></center>");    push (@$html , "<pre><center><h1>Welcome to Scenario Tools</h1></center>");
   
         #push(@$html, "<hr>");  
   
102          push (@$html , "<h3>User Login</h3>");          push (@$html , "<h3>User Login</h3>");
103          push (@$html ,          push (@$html ,
104          $cgi->start_form(-action => "hope_tools.cgi"),          $cgi->start_form(-action => "hope_tools.cgi"),
# Line 72  Line 106 
106          $cgi->textfield(-name => "user", -size => 20));          $cgi->textfield(-name => "user", -size => 20));
107    
108          if($user){          if($user){
109                  push (@$html , "<b><br>Logged in as: $user<br><br></b>");      push (@$html , "<b><br> Logged in as: $user</b>");
110          }          }
111    
112          #push(@$html, "<hr>");          #push(@$html, "<hr>");
113      my $temp = `find $FIG_Config::var/Models -name Scenarios 2>&1`;
114      my @files = split "\n", $temp;
115      my @ids;
116    
117      foreach my $file (@files)
118        {
119          if ($file =~ /Models\/(.*)\//)
120            {
121              if ($1 ne "All")
122                {
123                  push (@ids, $1);
124                }
125            }
126        }
127    
128      my @orgs;
129      foreach my $org (@ids)
130        {
131          my $gs = $fig->genus_species($org);
132          if ($fig->genome_domain($org) ne "Environmental Sample")
133            {
134              push @orgs, "$gs\t($org)";
135            }
136          else
137            {
138              push @orgs, "$gs\t($org)";
139            }
140        }
141    
142      foreach my $org (@orgs)
143        {
144          if($org =~ /\((.*)\)/)
145            {
146              my $file = "$FIG_Config::var/Models/$1/Curation/kegg_id";
147              open(FILE, $file) or next;
148              if(<FILE> =~ /([a-z][a-z][a-z])/)
149                {
150                  $org .= "\t$1";
151                }
152            }
153        }
154    
155      push(@orgs,"1 Select\tan\torganism");
156    
157    
158          push (@$html , "<br><h3>Find KEGG Compound</h3>",          push (@$html , "<br><h3>Find KEGG Compound</h3>",
159          "KEGG Compound ID: ",          "KEGG Compound ID: ",
# Line 90  Line 168 
168          "EC Number: ",          "EC Number: ",
169           $cgi->textfield(-name => "EC_number", -size => 20),           $cgi->textfield(-name => "EC_number", -size => 20),
170          "<br>Search subsystems for KEGG EC numbers<br><br>",          "<br>Search subsystems for KEGG EC numbers<br><br>",
171            "<h3>OR<br><br> Reactions not in Subsystems(by maps) </h3>",
172            $cgi->popup_menu( -name  => 'kegg_name_id_org', -values => [sort map {$_} @orgs], -default => "1 Select\tan\torganism"),
173            "<br> Returns maps of reactions that are not in subsystems yet<br><br>",
174            "<h3>OR<br><br> Reactions not in Subsystems (by subsystem)</h3>",
175            $cgi->popup_menu( -name  => 'kegg_name_id_org_ec', -values => [sort map {$_} @orgs], -default => "1 Select\tan\torganism"),
176            "<br> Returns missing reactions sorted by subsystems<br><br>",
177           $cgi->submit(-name => 'start_page', -label =>"Submit"),           $cgi->submit(-name => 'start_page', -label =>"Submit"),
178            "</pre>",
179           $cgi->end_form);           $cgi->end_form);
180  }  }
181    
# Line 112  Line 197 
197                  $EC = $cgi->param("EC_number");                  $EC = $cgi->param("EC_number");
198                  $EC =~ s/\./\\./g;                  $EC =~ s/\./\\./g;
199                  $temp = `find $FIG_Config::data/Subsystems -name spreadsheet -exec grep $EC {} \\\; -print`;                  $temp = `find $FIG_Config::data/Subsystems -name spreadsheet -exec grep $EC {} \\\; -print`;
200                  #push (@$html , $temp);      $temp .= `find $FIG_Config::data/Subsystems -name hope_kegg_info -exec grep $EC {} \\\; -print`;
201                  @data = split( /\n/, $temp);                  @data = split( /\n/, $temp);
202    
203                  if(@data){                  if(@data){
# Line 123  Line 208 
208                          }                          }
209                          if($line =~ /Subsystems\/(.*)\//){                          if($line =~ /Subsystems\/(.*)\//){
210                                  if(@functionalRole){                                  if(@functionalRole){
211                                          push(@$html , "<br><a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$1&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$1 Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes')\"><b>$1</b></a><br>");              push(@$html , "<br><a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$1&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$1 Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$1</b></a><br>");
212                                          foreach $role (@functionalRole){                                          foreach $role (@functionalRole){
213                                                  push(@$html , "$role<br>")                                                  push(@$html , "$role<br>")
214                                          }                                          }
# Line 157  Line 242 
242          if($cgi->param("kegg_reaction")){          if($cgi->param("kegg_reaction")){
243                  $reaction = $cgi->param("kegg_reaction");                  $reaction = $cgi->param("kegg_reaction");
244                  $temp = `find $FIG_Config::data/Subsystems -name hope_reactions -exec grep $reaction {} \\\; -print`;                  $temp = `find $FIG_Config::data/Subsystems -name hope_reactions -exec grep $reaction {} \\\; -print`;
245                  #push (@$html , $temp);      $temp .= `find $FIG_Config::data/Subsystems -name hope_kegg_info -exec grep $reaction {} \\\; -print`;
246                  @data = split( /\n/, $temp);                  @data = split( /\n/, $temp);
247    
248                  if(@data){                  if(@data){
# Line 168  Line 253 
253                          }                          }
254                          if($line =~ /Subsystems\/(.*)\//){                          if($line =~ /Subsystems\/(.*)\//){
255                                  if(@functionalRole){                                  if(@functionalRole){
256                                          push(@$html , "<br><a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$1&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$1 Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes')\"><b>$1</b></a><br>");              push(@$html , "<br><a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$1&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$1 Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$1</b></a><br>");
257                                          foreach $role (@functionalRole){                                          foreach $role (@functionalRole){
258                                                  push(@$html , "$role<br>")                                                  push(@$html , "$role<br>")
259                                          }                                          }
# Line 248  Line 333 
333                  my $inputs;                  my $inputs;
334                  push(@$html , "<h3>Inputs:</h3>");                  push(@$html , "<h3>Inputs:</h3>");
335                  for my $key (keys %input){                  for my $key (keys %input){
336                      push(@$html , "<a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$key&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$key Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes')\"><b>$key</b></a><br>");        push(@$html , "<a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$key&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$key Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$key</b></a><br>");
337                      foreach $inputs (@{$input{$key}}){                      foreach $inputs (@{$input{$key}}){
338                          foreach ($inputs){                          foreach ($inputs){
339                              push(@$html , "$_<br>");                              push(@$html , "$_<br>");
# Line 259  Line 344 
344                  my $outputs;                  my $outputs;
345                  push(@$html , "<br><h3>Outputs:</h3>");                  push(@$html , "<br><h3>Outputs:</h3>");
346                  for my $key (keys %output){                  for my $key (keys %output){
347                          push(@$html , "<a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$key&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$key Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes')\"><b>$key</b></a><br>");        push(@$html , "<a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$key&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$key Curation','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$key</b></a><br>");
348                          foreach $outputs (@{$output{$key}}){                          foreach $outputs (@{$output{$key}}){
349                                  foreach ($outputs){                                  foreach ($outputs){
350                                     push(@$html , "$_<br>");                                     push(@$html , "$_<br>");
# Line 273  Line 358 
358                  }                  }
359          }          }
360  }  }
361    
362    sub create_maps_for_org {
363      my $kegg_org = $cgi->param("kegg_name");
364      my $genome_id = $cgi ->param("genome_id");
365    
366      if($cgi->param("kegg_name") and  $cgi ->param("genome_id"))
367        {
368          my $gs = $fig->genus_species($genome_id);
369          push(@$html, "<h1> $gs\t$genome_id</h1>");
370        }
371      if ($cgi->param("kegg_name_id_org") ne "1 Select\tan\torganism")
372        {
373          my @name_id_org = split "\t", $cgi->param("kegg_name_id_org");
374          if(@name_id_org[2])
375            {
376              $genome_id = $name_id_org[1];
377              $kegg_org = $name_id_org[2];
378              push (@$html, "<h1>$name_id_org[0]\t$genome_id</h1>");
379            }
380          else
381            {
382              add_kegg_org();
383            }
384        }
385    
386      if($genome_id and $kegg_org)
387        {
388          my @files = `find $FIG_Config::data/Subsystems -name spreadsheet`;
389    
390          my %ec_to_sub;
391    
392          foreach my $file (@files){
393            my ($ss);
394            open (SUB, "<$file") or die "can't open file";
395            $/= "//";
396            my @lines = split "\n", <SUB>;
397    
398            if($file =~ /Subsystems\/(.*)\//){
399              $ss = $1;
400            }
401    
402            foreach my $l (@lines){
403              my $ec;
404              if($l =~ /\(EC\s+(\S+\.\S+\.\S+\.\S+)\)/){
405                $ec = $1;
406              }
407              $ec_to_sub{$ec}->{$ss}=1;
408            }
409            close SUB;
410          }
411    
412          open (ECFILE, "$FIG_Config::data/KEGG/reaction");
413          my (%reaction_to_EC, %all_reactions_to_EC);
414          $/ = "\n///\n";
415          while (<ECFILE>)
416            {
417              chomp;
418              my $reaction;
419              if($_ =~ /ENTRY\s+(R\d+)\s+/)
420                {
421                  $reaction = $1;
422                }
423              my $enzyme;
424              if($_ =~ /ENZYME\s+(\S+\.\S+\.\S+\.\S+)\s*/)
425                {
426                  $enzyme = $1;
427                }
428              if($enzyme)
429                {
430                  $all_reactions_to_EC{$reaction} = $enzyme;
431                }
432            }
433          close ECFILE;
434    
435          open(SUP, "<$FIG_Config::data/Global/Models/hope_supersets.txt");
436    
437          my @subsystems;
438          $/ = "\n";
439          while(<SUP>){
440            chomp;
441            my($junk, $ss) = split "\t", $_;
442            push(@subsystems, $ss);
443          }
444    
445          close SUP;
446    
447          my %map_to_subsystems;
448          foreach my $ss (@subsystems){
449            open(SS,"<$FIG_Config::data/Subsystems/$ss/hope_kegg_info") or next;
450            while(<SS>){
451              chomp;
452              if($_=~/(\d+)/)
453                {
454                  $map_to_subsystems{$1} -> {$ss} = 1;
455                }
456            }
457          }
458    
459          my $dir = "$FIG_Config::kgml_dir/$kegg_org/";
460          my @xmlfiles;
461          opendir(BIN, $dir) or next;
462          while( defined (my $file = readdir BIN) )
463            {
464              if($file =~ /\.xml$/)
465                {
466                  push(@xmlfiles,$dir.$file) if -T "$dir/$file";
467                }
468            }
469          closedir(BIN);
470    
471          my (%mapping, %map_path_name);
472    
473          foreach my $file (@xmlfiles)
474            {
475              my $path_id;
476    
477              if ($file =~ /$kegg_org(\d\d\d\d\d)/)
478                {
479                  $path_id = $1;
480                }
481              my @title = `grep "title=" $file`;
482    
483              foreach my $title (@title)
484                {
485                  chomp $title;
486                  if($title =~ /title=\"(.*)\"/)
487                    {
488                      $map_path_name{$path_id}= "$1";
489                    }
490                }
491              my @lines = `grep "type=\\"gene\\"" $file | grep reaction`;
492    
493              foreach my $line (@lines)
494                {
495                  chomp $line;
496    
497                  if ($line =~ /name=\"(.*)\" type.*reaction=\"(.*)\"/)
498                    {
499                      my $genelist = $1;
500                      my $reactionlist = $2;
501                      my @genes = split " ", $genelist;
502                      my @reactions = split " ", $reactionlist;
503                      foreach my $reaction (@reactions)
504                        {
505                          $reaction =~ s/rn://g;
506                          map { $mapping{$_}->{$reaction} = $path_id } @genes;
507                        }
508                    }
509                }
510            }
511    
512          #Creates a hash whose keys are all of the possible reactions.
513          my (%all_reaction_map, $keys, $total_reactions);
514          foreach my $gene (keys %mapping)
515            {
516              my (@reaction);
517              my %reaction_hash = %{$mapping{$gene}};
518              @reaction = sort keys %reaction_hash;
519              foreach (@reaction)
520                {
521                  $all_reaction_map{$_} = $reaction_hash{$_};
522                  $reaction_to_EC{$_} = $all_reactions_to_EC{$_};
523                  $total_reactions += 1;
524                }
525            }
526    
527          #Get's an array of all of the reactions covered by scenarios.
528          my $fig = new FIG;
529          my $superset_file = "$FIG_Config::global/Models/hope_supersets.txt";
530    
531          #load scenario information
532          model::load_superset_file($superset_file);
533          my ($all_rxn,$rxn_to_sub,$rxn_to_prod) = model::load_supersets("All");
534          my $reactions = join " ", sort keys %$all_rxn;
535          my @scenario_reactions= split " ", $reactions;
536    
537          #Removes the reactions that are already covered by scenarios.
538          foreach (@scenario_reactions)
539            {
540              delete $all_reaction_map{$_};
541              delete $reaction_to_EC{$_};
542            }
543    
544          my %EC_to_Reactions;
545          while (my ($key, $value) = each (%reaction_to_EC))
546            {
547              $EC_to_Reactions{$value}->{$key} = 1;
548            }
549    
550          my (%Path_Unacc_React, %number_of_reactions, %num_react_to_map);
551          while (my ($key, $value) = each (%all_reaction_map))
552            {
553              $Path_Unacc_React{$value}.= "+$key";
554              $number_of_reactions{$value}+= 1;
555            }
556          my $number_reactions_left;
557          $number_reactions_left = keys(%reaction_to_EC);
558          while (my ($key, $value) = each (%number_of_reactions))
559            {
560              $num_react_to_map{$value}.= "$key ";
561            }
562    
563          push @$html, "<b>There are currently this many reactions not yet in subsystems: $number_reactions_left</b><br>";
564          my $dec_done =  $number_reactions_left * 1000 /$total_reactions;
565          my $dec_ver = 1000 - $dec_done;
566          my $total_percentage = $dec_ver/10;
567          push @$html, "<b>The organism has approximately $total_percentage% of its reactions in subsystems</b><br>";
568    
569          my $linkindex = 0;
570          my $mappedindex = 0;
571          foreach my $key (sort {$b <=> $a} keys %num_react_to_map)
572            {
573              my @sortedkeys = split " ", $num_react_to_map{$key};
574    
575              foreach my $links (@sortedkeys)
576                {
577                  $linkindex++;
578                  push (@$html, "<br><a href=\"\#tips$linkindex\"> $map_path_name{$links} ($key Reactions)</a>");
579                }
580            }
581          foreach my $key (sort {$b <=> $a} keys %num_react_to_map)
582            {
583              my @sortedkeys = split " ", $num_react_to_map{$key};
584              foreach my $map (@sortedkeys)
585                {
586                  $mappedindex++;
587                  push(@$html, "<br><br><a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.jp/dbget-bin/show_pathway?rn$map$Path_Unacc_React{$map}','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><font size=+2><b>$map</b></a>\n</font>");
588                  push(@$html, "<a name=\"tips$mappedindex\"><font size=+2> <b>$map_path_name{$map}  ($key reactions)</b> </font></a>");
589                  push (@$html, "<a href=\"\#top\"><b> Back To Top </b> </a>");
590                  push(@$html, "<br><br> <b> Possible subsystems for the missing reactions based on EC #'s</b> <br>");
591    
592                  my @reactions = sort split m"\+", $Path_Unacc_React{$map};
593                  my %number_ss;
594                  my %unique_ss;
595                  my %react_for_EC;
596                  my %ss_to_EC;
597                  foreach my $reaction (@reactions)
598                    {
599                      if ($reaction)
600                        {
601                          my $EC = $reaction_to_EC{$reaction};
602                          if ($EC)
603                            {
604                              if ($ec_to_sub{$EC})
605                                {
606                                  my %ss = %{$ec_to_sub{$EC}};
607                                  if (%ss)
608                                    {
609                                      foreach my $ss (sort keys %ss)
610                                        {
611                                          $unique_ss{$ss}= 1;
612                                          $ss_to_EC{$ss} -> {$EC} = 1;
613                                          $react_for_EC{$EC} -> {$reaction} = 1;
614                                          $number_ss{$ss} += 1;
615                                        }
616                                    }
617                                }
618                            }
619                        }
620                    }
621                  my %num_each_ss;
622                  while (my ($key, $value) = each (%number_ss))
623                    {
624                      $num_each_ss{$value}.= "$key ";
625                    }
626                  foreach my $key (sort {$b <=> $a} keys %num_each_ss)
627                    {
628                      my @sortedkeys = split " ", $num_each_ss{$key};
629                      foreach my $ss (@sortedkeys)
630                        {
631                          push(@$html , "<br><br>  <a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$ss&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$ss ($number_ss{$ss} reactions matched based on E.C. #'s)</b></a><br>");
632    
633                          my @ECs = sort (keys %{$ss_to_EC{$ss}});
634                          foreach my $EC (@ECs)
635                            {
636                              push (@$html, "<br>");
637                              my $tempss= $ss;
638                              $tempss =~ s/\(/\\(/g;
639                              $tempss =~ s/\)/\\)/g;
640                              my $dir = "$FIG_Config::data/Subsystems/".$tempss."/spreadsheet";
641                              my $temp = `grep $EC $dir`;
642                              my @ECinfo = split "\n", $temp;
643                              if ($ECinfo[0] =~ /$EC\D/)
644                                {
645                                  push (@$html, $ECinfo[0]);
646                                }
647                              else
648                                {
649                                  push (@$html, "(EC $EC)");
650                                }
651                              my @reacts = sort (keys %{$react_for_EC{$EC}});
652                              foreach my $react (@reacts)
653                                {
654                                  push (@$html, " ");
655                                  push (@$html, "<a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.ad.jp/dbget-bin/www_bget?rn+$react','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\">$react</a>");
656                                  push (@$html, " ");
657                                }
658    
659                            }
660                        }
661                    }
662                  push(@$html, "<br><br><b> Subsystems that use the map in their scenarios </b>");
663                  if (defined $map_to_subsystems{$map})
664                  {
665                      my %sshash = %{$map_to_subsystems{$map}};
666                      foreach my $ss (keys %sshash)
667                        {
668                          push(@$html , "<pre> <a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$ss&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$ss</b></a> </pre>");
669                        }
670                    }
671                }
672            }
673        }
674      else
675        {
676          #push(@$html, "<hr>");
677          my $temp = `find $FIG_Config::var/Models -name Scenarios 2>&1`;
678          my @files = split "\n", $temp;
679          my @ids;
680    
681          foreach my $file (@files)
682            {
683              if ($file =~ /Models\/(.*)\//)
684                {
685                  if ($1 ne "All")
686                    {
687                      push (@ids, $1);
688                    }
689                }
690            }
691    
692          my @orgs;
693          foreach my $org (@ids)
694            {
695              my $gs = $fig->genus_species($org);
696              if ($fig->genome_domain($org) ne "Environmental Sample")
697                {
698                  push @orgs, "$gs\t($org)";
699                }
700              else
701                {
702                  push @orgs, "$gs\t($org)";
703                }
704            }
705    
706          foreach my $org (@orgs)
707            {
708              if($org =~ /\((.*)\)/)
709                {
710                  my $file = "$FIG_Config::var/Models/$1/Curation/kegg_id";
711                  open(FILE, $file) or next;
712                  if(<FILE> =~ /([a-z][a-z][a-z])/)
713                    {
714                      $org .= "\t$1";
715                    }
716                }
717            }
718    
719          push(@orgs,"1 Select\tan\torganism");
720    
721          push (@$html ,  "<h3>Reactions not in subsystems</h3>",
722                "<b>Pick an organism</b>",
723                $cgi->start_form(-action => "hope_tools.cgi"),
724                $cgi->popup_menu( -name  => 'kegg_name_id_org', -values => [sort map {$_} @orgs], -default => "1 Select\tan\torganism"),
725                "<br> Returns maps of reactions that are not in subsystems yet<br><br>",
726                $cgi->submit(-name => 'start_page', -label =>"Submit"),
727                "</pre>",
728                $cgi->end_form);
729        }
730    }
731    
732    sub update_kegg{
733      my $user = $cgi->param("user");
734    
735      push (@$html , $cgi->start_form(-action => "hope_tools.cgi"),
736            $cgi->hidden(-name => 'user', $user),
737            $cgi->end_form);
738    
739      open (BODY, "<$FIG_Config::fig_disk/dist/releases/dejongh/update_body");
740    
741      while(<BODY>){
742        if($user){
743          $_ =~ s/USERID/$user/g;
744        }
745        else{
746          $_ =~ s/USERID//g;
747        }
748        push (@$html, $_);
749      }
750    
751      close BODY;
752    }
753    
754    sub update_hope{
755      my $user = $cgi->param("user");
756    
757      push (@$html , $cgi->start_form(-action => "hope_tools.cgi"),
758            $cgi->hidden(-name => 'user', $user),
759            $cgi->end_form);
760    
761      open (BODY, "<$FIG_Config::fig_disk/dist/releases/dejongh/update_hope");
762    
763      while(<BODY>){
764        if($user){
765          $_ =~ s/USERID/$user/g;
766        }
767        else{
768          $_ =~ s/USERID//g;
769        }
770        push (@$html, $_);
771      }
772    
773      close BODY;
774    }
775    
776    sub add_kegg_org{
777      my $user = $cgi->param("user");
778      my $genome_id;
779      if($cgi->param("kegg_name_id_org") ne "1 Select\tan\torganism")
780        {
781          my @name_id_org = split "\t", $cgi->param("kegg_name_id_org");
782          $genome_id = $name_id_org[1];
783          $genome_id =~ s/\(//g;
784          $genome_id =~ s/\)//g;
785        }
786      if($cgi->param("kegg_name_id_org_ec") ne "1 Select\tan\torganism")
787        {
788          my @name_id_org = split "\t", $cgi->param("kegg_name_id_org_ec");
789          $genome_id = $name_id_org[1];
790          $genome_id =~ s/\(//g;
791          $genome_id =~ s/\)//g;
792        }
793    
794      (my $link_id, my $nothing) = split(/\./,  $genome_id);
795      if ($link_id)
796        {
797          push (@$html , "The three letter identifier is not defined, look in the link to find it and submit it.");
798          push (@$html , "<br> Look for something like \"gn:eco\". The letters \"eco\" would be the kegg name for this. <br>");
799          push (@$html , "<br><a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.jp/dbget-bin/www_bfind_sub?mode=bfind&max_hit=1000&dbkey=kegg&keywords=$link_id','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\">KEGG ID LINK</a><br><br>");
800          push (@$html ,
801                $cgi->start_form(-action => "hope_tools.cgi"),
802                "KEGG NAME: ",
803                $cgi->textfield(-name => "kegg_name", -size => 20),
804                $cgi->hidden(-name => 'user', $user),
805                "<br>Genome ID:",
806                $cgi->textfield(-name => 'genome_id',-default=> $genome_id),
807                $cgi->submit(-name => 'create_the_kegg_dir', -label =>"Submit"),
808                $cgi->end_form);
809        }
810    }
811    
812    sub create_the_kegg_dir {
813      my $kegg_name = $cgi->param("kegg_name");
814      my $genome_id = $cgi ->param("genome_id");
815    
816      my $file = "$FIG_Config::var/Models/$genome_id/Curation/kegg_id";
817    
818      #check if model directory exists
819      my $path = "/Users/fig/FIGdisk/FIG/var/Models/$genome_id/";
820      my $tmp = `find $path 2>&1`;
821    
822      if($tmp =~ /No such file or directory/){
823        print STDERR "creating directory $path\n";
824        mkdir($path);
825      }
826    
827      #check if curation directory exists for a particular model
828      #by implication if curation directory neither will necessary files within curation directory
829      $path .= "Curation";
830      $tmp = `find $path 2>&1`;
831    
832      if($tmp =~ /No such file or directory/){
833        print STDERR "creating directory $path\n";
834        mkdir($path);
835      }
836      unless($tmp =~ /kegg_id/s)
837        {
838          open(A, "+>>$path/kegg_id") or warn "unable to create $path/kegg_id";
839          print A "$kegg_name";
840          close A;
841        }
842      create_maps_for_org();
843    }
844    
845    
846    sub miss_react_by_subsystem {
847      my $kegg_org = $cgi->param("kegg_name");
848      my $genome_id = $cgi ->param("genome_id");
849    
850      if($cgi->param("kegg_name") and  $cgi ->param("genome_id"))
851        {
852          my $gs = $fig->genus_species($genome_id);
853          push(@$html, "<h1> $gs\t$genome_id</h1>");
854        }
855      my @name_id_org;
856      if ($cgi->param("kegg_name_id_org_ec") ne "1 Select\tan\torganism")
857        {
858          @name_id_org = split "\t", $cgi->param("kegg_name_id_org_ec");
859          if(@name_id_org[2])
860            {
861              $genome_id = $name_id_org[1];
862              $kegg_org = $name_id_org[2];
863              push (@$html, "<h1>$name_id_org[0]\t$genome_id</h1>");
864              $genome_id =~ s/\(//g;
865              $genome_id =~ s/\)//g;
866            }
867          else
868            {
869              add_kegg_org();
870            }
871        }
872    
873      if($genome_id and $kegg_org)
874        {
875    
876          my @files = `find $FIG_Config::data/Subsystems -name reactions`;
877    
878          my (%all_reactions_to_sub, %sub_to_reactions, %reactions_to_sub);
879    
880          foreach my $file (@files){
881            my ($ss);
882            open (SUB, "<$file") or die "can't open file";
883            $/= "//";
884            my @lines = split "\n", <SUB>;
885    
886            if($file =~ /Subsystems\/(.*)\//){
887              $ss = $1;
888            }
889    
890            foreach my $l (@lines)
891              {
892                my $react;
893                if($l =~ /(R\d+)/)
894                  {
895                    $react = $1;
896                  }
897                $sub_to_reactions{$ss}->{$react}=1;
898                $all_reactions_to_sub{$react}->{$ss}=1;
899              }
900            close SUB;
901          }
902    
903          open (ECFILE, "$FIG_Config::data/KEGG/reaction");
904          my (%reaction_to_EC, %all_reactions_to_EC);
905          $/ = "\n///\n";
906          while (<ECFILE>)
907            {
908              chomp;
909              my $reaction;
910              if($_ =~ /ENTRY\s+(R\d+)\s+/)
911                {
912                  $reaction = $1;
913                }
914              my $enzyme;
915              if($_ =~ /ENZYME\s+(\S+\.\S+\.\S+\.\S+)\s*/)
916                {
917                  $enzyme = $1;
918                }
919              if($enzyme)
920                {
921                  $all_reactions_to_EC{$reaction} = $enzyme;
922                }
923            }
924          close ECFILE;
925    
926    
927    
928    
929          open(SUP, "<$FIG_Config::data/Global/Models/hope_supersets.txt");
930    
931          my @subsystems;
932          $/ = "\n";
933          while(<SUP>){
934            chomp;
935            my($junk, $ss) = split "\t", $_;
936            push(@subsystems, $ss);
937          }
938    
939          close SUP;
940    
941          my (%subsystems_to_map, %map_to_subsystems);
942          foreach my $ss (@subsystems){
943            open(SS,"<$FIG_Config::data/Subsystems/$ss/hope_kegg_info") or next;
944            while(<SS>){
945              chomp;
946              if($_=~/^(\d+)/)
947                {
948                  $subsystems_to_map{$ss} -> {$1} = 1;
949                  $map_to_subsystems{$1} -> {$ss} = 1;
950                }
951            }
952          }
953    
954          my $dir = "$FIG_Config::kgml_dir/$kegg_org/";
955          my @xmlfiles;
956          opendir(BIN, $dir) or next;
957          while( defined (my $file = readdir BIN) )
958            {
959              if($file =~ /\.xml$/)
960                {
961                  push(@xmlfiles,$dir.$file) if -T "$dir/$file";
962                }
963            }
964          closedir(BIN);
965    
966          my (%mapping, %map_path_name);
967    
968          foreach my $file (@xmlfiles)
969            {
970              my $path_id;
971    
972              if ($file =~ /$kegg_org(\d\d\d\d\d)/)
973                {
974                  $path_id = $1;
975                }
976              my @title = `grep "title=" $file`;
977    
978              foreach my $title (@title)
979                {
980                  chomp $title;
981                  if($title =~ /title=\"(.*)\"/)
982                    {
983                      $map_path_name{$path_id}= "$1";
984                    }
985                }
986              my @lines = `grep "type=\\"gene\\"" $file | grep reaction`;
987    
988              foreach my $line (@lines)
989                {
990                  chomp $line;
991    
992                  if ($line =~ /name=\"(.*)\" type.*reaction=\"(.*)\"/)
993                    {
994                      my $genelist = $1;
995                      my $reactionlist = $2;
996                      my @genes = split " ", $genelist;
997                      my @reactions = split " ", $reactionlist;
998                      foreach my $reaction (@reactions)
999                        {
1000                          $reaction =~ s/rn://g;
1001                          map {$mapping{$_}->{$reaction} = $path_id } @genes;
1002                        }
1003                    }
1004                }
1005            }
1006    
1007          #Creates a hash whose keys are all of the possible reactions.
1008          my (%all_reaction_map, $keys, $total_reactions);
1009          foreach my $gene (keys %mapping)
1010            {
1011              my (@reaction);
1012              my %reaction_hash = %{$mapping{$gene}};
1013              @reaction = sort keys %reaction_hash;
1014              foreach (@reaction)
1015                {
1016                  $all_reaction_map{$_} = $reaction_hash{$_};
1017                  #$reaction_to_EC{$_} = $all_reactions_to_EC{$_};
1018                  if ($all_reactions_to_sub{$_})
1019                    {
1020                      $reactions_to_sub{$_} = $all_reactions_to_sub{$_};
1021                    }
1022                  $total_reactions += 1;
1023                }
1024            }
1025    
1026          #Get's an array of all of the reactions covered by scenarios.
1027          my $fig = new FIG;
1028          my $superset_file = "$FIG_Config::global/Models/hope_supersets.txt";
1029    
1030          #load scenario information
1031          model::load_superset_file($superset_file);
1032          my ($all_rxn,$rxn_to_sub,$rxn_to_prod) = model::load_supersets("$genome_id");
1033          my $reactions = join " ", sort keys %$all_rxn;
1034          my @scenario_reactions= split " ", $reactions;
1035    
1036          #Removes the reactions that are already covered by scenarios.
1037          foreach (@scenario_reactions)
1038            {
1039              delete $all_reaction_map{$_};
1040              delete $reactions_to_sub{$_};
1041            }
1042    
1043          my (%sub_to_reactions,%number_of_reactions, %num_react_to_sub);
1044          while (my ($key, $value) = each (%reactions_to_sub))
1045            {
1046              my @subsystems = sort (keys %{$value});
1047              foreach my $sub (@subsystems)
1048                {
1049                  $sub_to_reactions{$sub}->{$key} = 1;
1050                  $number_of_reactions{$sub}+= 1;
1051                }
1052            }
1053          my $react_not_in_ss_with_known_ss = keys(%reactions_to_sub);
1054          my $number_reactions_left;
1055          $number_reactions_left = keys(%all_reaction_map);
1056          while (my ($key, $value) = each (%number_of_reactions))
1057            {
1058              $num_react_to_sub{$value}.= "$key ";
1059            }
1060    
1061          push @$html, "<b>There are currently this many reactions not yet in subsystems: $number_reactions_left</b><br>";
1062          push @$html, "<b>There are currently this many reactions missing for $name_id_org[0] that have known Hope Scenarios, that are not yet in subsystems for $name_id_org[0]: $react_not_in_ss_with_known_ss</b> <br>";
1063          my $dec_done =  $number_reactions_left * 1000 /$total_reactions;
1064          my $dec_ver = 1000 - $dec_done;
1065          my $total_percentage = $dec_ver/10;
1066          push @$html, "<b>The organism has approximately $total_percentage% of its reactions in subsystems</b><br>";
1067    
1068          my $linkindex = 0;
1069          my $mappedindex = 0;
1070          foreach my $key (sort {$b <=> $a} keys %num_react_to_sub)
1071            {
1072              my @subsystems = split " ", $num_react_to_sub{$key};
1073    
1074              foreach my $links (@subsystems)
1075                {
1076                  $linkindex++;
1077                  push (@$html, "<br><a href=\"\#tips$linkindex\">  $links ($key Reactions)</a>");
1078                }
1079            }
1080          foreach my $key (sort {$b <=> $a} keys %num_react_to_sub)
1081            {
1082              my @sortedkeys = split " ", $num_react_to_sub{$key};
1083              foreach my $subsystem (@sortedkeys)
1084                {
1085                  $mappedindex++;
1086                  push(@$html, "<br><br><a name=\"tips$mappedindex\"><font size=+2><b>$subsystem ($key reactions)</b></a></font>",
1087                       "<a href=\"\#top\"><b> Back To Top </b> </a><br>");
1088                  push(@$html, "  <a href=\"javascript:void(0)\"onclick=\"window.open('subsys.cgi?user=$user&ssa_name=$subsystem&request=show_ssa&check=1&sort=&show_clusters=&show_minus1=','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$subsystem ($key reactions matched)</b></a><br>");
1089    
1090    
1091                  my @reactions = sort (keys%{$sub_to_reactions{$subsystem}});
1092                  my $reactlink;
1093                  push (@$html, "<br><b>Reactions missing from the subsystem</b><br>");
1094                  foreach my $react (@reactions)
1095                    {
1096                      $reactlink .= "+$react";
1097                      push (@$html, " ");
1098                      push (@$html, "<a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.ad.jp/dbget-bin/www_bget?rn+$react','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\">$react</a>");
1099                      push (@$html, " ");
1100                    }
1101                  push(@$html, "<br><br><b> Maps that use the given subsystem <b>");
1102                  my @maps = sort(keys%{$subsystems_to_map{$subsystem}});
1103                  foreach my $map (@maps)
1104                    {
1105                      push (@$html, "<br><a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.jp/dbget-bin/show_pathway?rn$map$reactlink','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\"><b>$map $map_path_name{$map}</b></a>\n");
1106                    }
1107                }
1108            }
1109        }
1110      else
1111        {
1112          #push(@$html, "<hr>");
1113          my $temp = `find $FIG_Config::var/Models -name Scenarios 2>&1`;
1114          my @files = split "\n", $temp;
1115          my @ids;
1116    
1117          foreach my $file (@files)
1118            {
1119              if ($file =~ /Models\/(.*)\//)
1120                {
1121                  if ($1 ne "All")
1122                    {
1123                      push (@ids, $1);
1124                    }
1125                }
1126            }
1127    
1128          my @orgs;
1129          foreach my $org (@ids)
1130            {
1131              my $gs = $fig->genus_species($org);
1132              if ($fig->genome_domain($org) ne "Environmental Sample")
1133                {
1134                  push @orgs, "$gs\t($org)";
1135                }
1136              else
1137                {
1138                  push @orgs, "$gs\t($org)";
1139                }
1140            }
1141    
1142          foreach my $org (@orgs)
1143            {
1144              if($org =~ /\((.*)\)/)
1145                {
1146                  my $file = "$FIG_Config::var/Models/$1/Curation/kegg_id";
1147                  open(FILE, $file) or next;
1148                  if(<FILE> =~ /([a-z][a-z][a-z])/)
1149                    {
1150                      $org .= "\t$1";
1151                    }
1152                }
1153            }
1154    
1155          push(@orgs,"1 Select\tan\torganism");
1156    
1157          push (@$html ,  "<h3>Reactions not in subsystems</h3>",
1158                "<b>Pick an organism</b>",
1159                $cgi->start_form(-action => "hope_tools.cgi"),
1160                $cgi->popup_menu( -name  => 'kegg_name_id_org_ec', -values => [sort map {$_} @orgs], -default => "1 Select\tan\torganism"),
1161                "<br> Returns maps of reactions that are not in subsystems yet<br><br>",
1162                $cgi->submit(-name => 'start_page', -label =>"Submit"),
1163                "</pre>",
1164                $cgi->end_form);
1165        }
1166    }
1167    
1168    
1169    
1170    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3