[Bio] / FigKernelScripts / salvage_subsystem_rows.pl Repository:
ViewVC logotype

Annotation of /FigKernelScripts/salvage_subsystem_rows.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : olson 1.3 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : overbeek 1.1 use FIG;
19 :     my $fig = new FIG;
20 :    
21 : overbeek 1.2 my $usage = "usage: salvage_subsystem_rows From To Maps";
22 : overbeek 1.1
23 :     # Foreach Subsystem in To (a directory of subsystems), if Subsystem is in From,
24 :     # then each row representing an organism in Mapping will be "salvaged" and added
25 :     # to Subsystem in To
26 :     #
27 :    
28 :     (
29 :     ($from = shift @ARGV) &&
30 :     ($to = shift @ARGV) &&
31 :     ($mapping = shift @ARGV)
32 :     )
33 :     || die $usage;
34 :    
35 : overbeek 1.2 foreach $_ (`cat $mapping/*`)
36 : overbeek 1.1 {
37 :     if ($_ =~ /^(fig\|(\d+\.\d+)\.peg\.\d+)\t(fig\|(\d+\.\d+)\.peg\.(\d+))$/)
38 :     {
39 :     $old{$2} = $4;
40 :     $map{$1} = $5;
41 :     }
42 :     }
43 :    
44 :     opendir(SUBS,$to) || die "could not open $to";
45 :     @subs = grep { $_ !~ /^\./ } readdir(SUBS);
46 :     closedir(SUBS);
47 :    
48 :     foreach $sub (@subs)
49 :     {
50 :     next if (! -d "$from/$sub/spreadsheet");
51 :    
52 :     undef %salvaged;
53 :     open(IN,"<$from/$sub/spreadsheet") || die "$from/$sub/spreadsheet";
54 :     while (defined($_ = <IN>))
55 :     {
56 :     if (($_ =~ /^(\d+\.\d+)\t(\S+)\t(.*)$/) && ($new = $old{$1}))
57 :     {
58 :     $var = $2;
59 :     @old_pegs = split(/\t/,$3);
60 :     @new_pegs = ();
61 :     foreach $peg (@old_pegs)
62 :     {
63 :     if ($peg && ($pegN = $map{$peg}))
64 :     {
65 :     push(@new_pegs,"fig|$new\.peg\.$pegN");
66 :     }
67 :     else
68 :     {
69 :     push(@new_pegs,"");
70 :     }
71 :     }
72 :     salvaged{$new} = join("\t",($new,$var,@new_pegs));
73 :     }
74 :     }
75 :     close(IN);
76 :    
77 :     open(IN,"<$to/$sub/spreadsheet") || die "$to/$sub/spreadsheet";
78 :     $/ = "\n//\n";
79 :     @spreadsheet = <IN>;
80 :     close(IN);
81 :    
82 :     open(OUT,">$to/$sub/spreadsheet") || die "$to/$sub/spreadsheet";
83 :     for ($i=0; ($i < @spreadsheet); $i++)
84 :     {
85 :     if ($i != 2)
86 :     {
87 :     print OUT $spreadsheet[$i];
88 :     }
89 :     else
90 :     {
91 :     $_ = spreadsheet[$i];
92 :     chomp;
93 :     @lines = split(/\n/,$_);
94 :     %in_already = map { $_ =~ /^(\d+\.\d+)/; $1 => 1 } @lines;
95 :     foreach $new (keys(%salvaged))
96 :     {
97 :     if (($new =~ /^(\d+\.\d+)/) && (! $in_already{$1}))
98 :     {
99 :     push(@lines,$salvaged{$new});
100 :     }
101 :     }
102 :     print OUT join("\n",@lines),$/;
103 :     }
104 :     }
105 :     close(OUT);
106 :     $/ = "\n";
107 :     }
108 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3