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

Diff of /FigWebServices/subsys.cgi

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

revision 1.75, Thu Apr 28 21:11:11 2005 UTC revision 1.76, Tue May 10 12:03:39 2005 UTC
# Line 409  Line 409 
409          {          {
410              $subsystem->write_subsystem();              $subsystem->write_subsystem();
411          }          }
412    
413    
414            my $col;
415            if (($col = $cgi->param('col_to_align')) && ($col =~ /^\s*(\d+)\s*$/))
416            {
417                &align_column($fig,$cgi,$html,$1,$subsystem);
418                $cgi->delete('col_to_align');
419            }
420            elsif (($col = $cgi->param('subcol_to_realign')) && ($col =~ /^\s*(\d+)\.(\d+)\s*$/))
421            {
422                &align_subcolumn($fig,$cgi,$html,$1,$2,$subsystem);
423                $cgi->delete('subcol_to_realign');
424            }
425          &produce_html_to_display_subsystem($fig,$subsystem,$cgi,$html,$ssa);          &produce_html_to_display_subsystem($fig,$subsystem,$cgi,$html,$ssa);
426      }      }
427  }  }
# Line 808  Line 821 
821      push(@$html,$cgi->checkbox(-name => 'show_coupled', -value => 1, -checked => 0, -override => 1,-label => 'show coupled PEGs[figure 2 minutes per PEG in spreadsheet]'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'show_coupled', -value => 1, -checked => 0, -override => 1,-label => 'show coupled PEGs[figure 2 minutes per PEG in spreadsheet]'),$cgi->br);
822      # RAE Hide -1 variants      # RAE Hide -1 variants
823      push(@$html,$cgi->checkbox(-name => 'hide_minus1', -value=> 1, -checked => 0, -label => 'hide -1 variants'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'hide_minus1', -value=> 1, -checked => 0, -label => 'hide -1 variants'),$cgi->br);
824      push(@$html,$cgi->br,"Align column (specify the number of the column): ",      push(@$html,$cgi->hr,
825                    $cgi->br,"Align column (specify the number of the column): ",
826                  $cgi->textfield(-name => "col_to_align", -size => 7),                  $cgi->textfield(-name => "col_to_align", -size => 7),
827                  $cgi->checkbox(-name => "show_align_input",  -checked => 0,                  $cgi->br,"Realign subgroup within a column (adding homologs): ",
828                                 -label => "show input to alignment tool"),                  $cgi->textfield(-name => "subcol_to_realign", -size => 7),
829                  $cgi->br,"Include homologs that pass the following threshhold: ",                  $cgi->br,"Include homologs that pass the following threshhold: ",
830                  $cgi->textfield(-name => "include_homo", -size => 10)," (leave blank to see just column)",                  $cgi->textfield(-name => "include_homo", -size => 10)," (leave blank to see just column)",
831                  " Max homologous seqs: ",$cgi->textfield(-name => "max_homo", -value => 100, -size => 6),                  " Max homologous seqs: ",$cgi->textfield(-name => "max_homo", -value => 100, -size => 6),
832                    $cgi->hr
833               );               );
834    
835       # RAE: A new function to reannotate a single column       # RAE: A new function to reannotate a single column
# Line 874  Line 889 
889    
890      my $target = "align$$";      my $target = "align$$";
891      my @roles = $subsystem->get_roles;      my @roles = $subsystem->get_roles;
     my $rolesA = [];  
892      my $i;      my $i;
893      my $dir = $subsystem->get_dir;      my $dir = $subsystem->get_dir;
894      for ($i=1; ($i <= @roles); $i++)      my $rolesA = &existing_trees($dir,\@roles);
895      {  
         if (-s "$dir/Alignments/$i/tree")  
         {  
             push(@$rolesA,"$i: $roles[$i-1]");  
         }  
     }  
896      if (@$rolesA > 0)      if (@$rolesA > 0)
897      {      {
898          push(@$html, $cgi->hr,          push(@$html, $cgi->hr,
# Line 942  Line 951 
951      }      }
952    
953      my $col;      my $col;
954      if ($col = $cgi->param('col_to_align'))      if ($col = $cgi->param('col_to_annotate'))
     {  
         &align_column($fig,$cgi,$html,$col,$subsystem);  
     }  
     elsif ($col = $cgi->param('col_to_annotate'))  
955      {      {
956          &annotate_column($fig,$cgi,$html,$col,$subsystem);          &annotate_column($fig,$cgi,$html,$col,$subsystem);
957      }      }
   
958  }  }
959    
960    
# Line 2498  Line 2502 
2502      my($fig,$cgi,$html,$col,$subsystem) = @_;      my($fig,$cgi,$html,$col,$subsystem) = @_;
2503      my $checked;      my $checked;
2504      my $roles = [$subsystem->get_roles];      my $roles = [$subsystem->get_roles];
2505      my $colN = &which_column($col,$roles);      my $role = &which_role_for_column($col,$roles);
2506      my @checked = &seqs_to_align($colN,$subsystem);      my @checked = &seqs_to_align($role,$subsystem);
2507      return undef unless (@checked);      return undef unless (@checked);
2508    
2509      # the following is read from fid_checked.cgi      # the following is read from fid_checked.cgi
# Line 2542  Line 2546 
2546  }  }
2547    
2548    
2549    
2550  sub align_column {  sub align_column {
2551      my($fig,$cgi,$html,$col,$subsystem) = @_;      my($fig,$cgi,$html,$colN,$subsystem) = @_;
2552      my($colN,@checked,$cutoff);      my(@pegs,$peg,$pseq,$role);
2553    
     my $checked;  
2554      my $roles = [$subsystem->get_roles];      my $roles = [$subsystem->get_roles];
2555        my $name = $subsystem->get_name;
2556        &check_index("$FIG_Config::data/Subsystems/$name/Alignments",$roles);
2557        if (($role = &which_role_for_column($colN,$roles)) &&
2558            ((@pegs = &seqs_to_align($role,$subsystem)) > 1))
2559        {
2560            my $tmpF = "/tmp/seqs.fasta.$$";
2561            open(TMP,">$tmpF") || die "could not open $tmpF";
2562    
2563      if (($colN = &which_column($col,$roles)) &&          foreach $peg (@pegs)
         ((@checked = &seqs_to_align($colN,$subsystem)) > 1))  
2564      {      {
2565          if ($cutoff = $cgi->param('include_homo'))              if ($pseq = $fig->get_translation($peg))
2566          {          {
2567              my $max = $cgi->param('max_homo');                  $pseq =~ s/[uU]/x/g;
2568              $max = $max ? $max : 100;                  print TMP ">$peg\n$pseq\n";
             push(@checked,&get_homologs($fig,\@checked,$cutoff,$max));  
2569          }          }
         $checked = join("\' \'",@checked);  
2570      }      }
2571      else          close(TMP);
2572    
2573            my $name = $subsystem->get_name;
2574            my $dir = "$FIG_Config::data/Subsystems/$name/Alignments/$colN";
2575    
2576            if (-d $dir)
2577      {      {
2578          push(@$html,"<h1>You need to check at least two sequences</h1>\n");              system "rm -rf \"$dir\"";
         return;  
2579      }      }
2580    
2581            &FIG::run("$FIG_Config::bin/split_and_trim_sequences \"$dir/split_info\" < $tmpF");
2582            unlink($tmpF);
2583    
2584      #          if (-s "$dir/split_info/set.sizes")
     # See if we want to produce the alignment, or just produce the  
     # input to the alignment.  
     #  
   
     if ($cgi->param("show_align_input"))  
2585      {      {
2586          push(@$html, "<pre>\n");              open(SZ,"<$dir/split_info/set.sizes") || die " could not open $dir/split_info/set.sizes";
2587          my $relabel;              while (defined($_ = <SZ>))
         foreach my $id (@checked)  
2588          {          {
2589              my $seq;                  if (($_ =~ /^(\d+)\t(\d+)/) && ($2 > 3))
             if ($seq = $fig->get_translation($id))  
2590              {              {
2591                  push(@$html,  ">$id\n$seq\n");                      my $n = $1;
2592                  my $func = $fig->function_of($id);                      &FIG::run("$FIG_Config::bin/make_phob_from_seqs \"$dir/$n\" < \"$dir/split_info\"/$n");
2593                  $relabel->{$id} = "$id: $func";                  }
2594                }
2595                close(SZ);
2596                &update_index("$FIG_Config::data/Subsystems/$name/Alignments/index",$colN,$role);
2597              }              }
2598              else              else
2599              {              {
2600                  push(@$html, "could not find translation for $id\n");              system("rm -rf \"$dir\"");
2601              }              }
2602          }          }
         push(@$html, "\n</pre>\n");  
2603      }      }
     else  
     {  
         push(@$html,"<pre>\n");  
         my %org = map { ( $_, $fig->org_of($_) ) } @checked;  
         #  Modified by GJO to compress tree and add organism names to tree:  
         #  push(@$html,`$FIG_Config::bin/align_with_clustal -org -func -tree \'$checked\'`);  
   
         #  Simpler version  
         # push @$html, map { chomp;  
         #                    /^   *\|[ |]*$/      # line that adds only tree height  
         #                    ? ()                 # remove it  
         #                    : /- ([a-z]+\|\S+):/ && defined( $org{$1} ) # tree id?  
         #                    ? "$_ [$org{$1}]\n"  # add the name  
         #                    : "$_\n"             # otherwise leave unmodified  
         #                  } `$FIG_Config::bin/align_with_clustal -org -func -tree \'$checked\'`;  
2604    
2605          #  More complex version the preserves double spaced tree tips  sub align_subcolumn {
2606          my $tip = 0;      my($fig,$cgi,$html,$colN,$subcolN,$subsystem) = @_;
2607          my @out = ();      my($role,@pegs,$cutoff,$peg);
2608    
2609          my $dir = "$FIG_Config::data/Subsystems/" .      my $name = $subsystem->get_name;
2610                    $cgi->param('ssa_name') .      my $dir = "$FIG_Config::data/Subsystems/$name/Alignments/$colN/$subcolN";
2611                    "/Alignments/" .      my $roles = [$subsystem->get_roles];
2612                    $cgi->param('col_to_align');      if (&check_index("$FIG_Config::data/Subsystems/$name/Alignments",$roles))
   
         $dir =~ s/ /_/g;  
         &FIG::verify_dir($dir);  
         foreach ( `$FIG_Config::bin/align_with_clustal -org -func -tree -UniProt \'-save=$dir\' \'$checked\'` )  
2613          {          {
2614              chomp;          my @pegs = map { $_ =~ /^(\S+)/; $1 } `cut -f2 $dir/ids`;
2615              if    ( /^   *\|[ |]*$/ ) {}  # line that adds only tree height  
2616              elsif ( /- ([a-z]+\|\S+):/ )  # line with tree tip          if ($cutoff = $cgi->param('include_homo'))
2617              {              {
2618                  if ( defined( $org{$1} ) ) { $_ .= " [$org{$1}]" }  # add org              my $max = $cgi->param('max_homo');
2619                  if ( $tip ) { push @out, "  |\n" }  # 2 tips in a row? add line              $max = $max ? $max : 100;
2620                  push @out, "$_\n";      # output current line              push(@pegs,&get_homologs($fig,\@pegs,$cutoff,$max));
                 $tip = 1;  
2621              }              }
2622              else                          # not a tip  
2623            system "rm -rf \"$dir\"";
2624            open(MAKE,"| make_phob_from_ids \"$dir\"") || die "could not make PHOB";
2625            foreach $peg (@pegs)
2626              {              {
2627                  push @out, "$_\n";              print MAKE "$peg\n";
                 $tip = 0;  
             }  
2628          }          }
2629          push(@$html,&set_links($cgi,\@out));          close(MAKE);
         push(@$html,"</pre>\n");  
2630      }      }
2631  }  }
2632    
2633  sub which_column {  sub which_role_for_column {
2634      my($col,$roles) = @_;      my($col,$roles) = @_;
2635      my($i);      my($i);
2636    
# Line 2656  Line 2645 
2645      my($role,$subsystem) = @_;      my($role,$subsystem) = @_;
2646      my($genome);      my($genome);
2647    
     my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );  
     my @subsetR = $subsystem->get_subsetR($active_subsetR);  
   
2648      my @seqs = ();      my @seqs = ();
2649      foreach $genome (@subsetR)      foreach $genome ($subsystem->get_genomes)
2650      {      {
2651          push(@seqs,$subsystem->get_pegs_from_cell($genome,$role));          push(@seqs,$subsystem->get_pegs_from_cell($genome,$role));
2652      }      }
# Line 2888  Line 2874 
2874   push @$tab, $row;   push @$tab, $row;
2875   return $tab;   return $tab;
2876  }  }
2877    
2878    sub existing_trees {
2879        my($dir,$roles) = @_;
2880        my(@rolesI,$roleI,@subrolesI,$subroleI);
2881    
2882        &check_index("$dir/Alignments",$roles);
2883    
2884        my @rolesA = ();
2885    
2886        if (opendir(DIR,"$dir/Alignments"))
2887        {
2888            @rolesI = grep { $_ =~ /^(\d+)$/ } readdir(DIR);
2889            closedir(DIR);
2890    
2891            foreach $roleI (@rolesI)
2892            {
2893                if ((-d "$dir/Alignments/$roleI/split_info") && opendir(SUBDIR,"$dir/Alignments/$roleI"))
2894                {
2895                    @subrolesI = grep { $_ =~ /^(\d+)$/ } readdir(SUBDIR);
2896                    closedir(SUBDIR);
2897    
2898                    foreach $subroleI (@subrolesI)
2899                    {
2900                        push(@rolesA,"$roleI.$subroleI: $roles->[$roleI-1]");
2901                    }
2902                }
2903            }
2904        }
2905    
2906        my($x,$y);
2907        return [sort { $a =~ /^(\d+\.\d+)/; $x = $1;
2908                       $b =~ /^(\d+\.\d+)/; $y = $1;
2909                       $x <=> $y
2910                      } @rolesA];
2911    }
2912    
2913    sub check_index {
2914        my($alignments,$roles) = @_;
2915    
2916        if (-s "$alignments/index")
2917        {
2918            my $ok = 1;
2919            foreach $_ (`cat \"$alignments/index\"`)
2920            {
2921                $ok = $ok && (($_ =~ /^(\d+)\t(\S.*\S)/) && ($roles->[$1 - 1] eq $2));
2922            }
2923            if (! $ok)
2924            {
2925                system "rm -rf \"$alignments\"";
2926                return 0;
2927            }
2928            return 1;
2929        }
2930        else
2931        {
2932            system "rm -rf \"$alignments\"";
2933        }
2934        return 0;
2935    }
2936    
2937    sub update_index {
2938        my($file,$colN,$role) = @_;
2939    
2940        my @lines = ();
2941        if (-s $file)
2942        {
2943            @lines = grep { $_ !~ /^$colN\t/ } `cat $file`;
2944        }
2945        push(@lines,"$colN\t$role\n");
2946        open(TMP,">$file") || die "could not open $file";
2947        foreach $_ (@lines)
2948        {
2949            print TMP $_;
2950        }
2951        close(TMP);
2952    }

Legend:
Removed from v.1.75  
changed lines
  Added in v.1.76

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3