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

Annotation of /FigKernelScripts/apply_peg_changes_to_subsystem.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1 #
2 : olson 1.3 # 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 :     #
19 : olson 1.1 # Given a set of peg-update transaction log files of the form:
20 :     #
21 :     # change old-id new-id contig protein-seq
22 :     # del id
23 :     # add id contig protein-seq
24 :     #
25 :     # And a list of subsystems, modify the subsystems in place (writing backups
26 :     # as usual) to remove the deleted ids and change any occurrences of the old ids to
27 :     # the corresponding new id.
28 :     #
29 :    
30 :     use strict;
31 :     use Data::Dumper;
32 :     use FIG;
33 :    
34 :     my $fig = new FIG;
35 :    
36 :     my $usage = "apply_peg_changes_to_subsystem transaction-log-files... [-subsystems subsystem names]";
37 :    
38 :     my(@trans_files, @subs);
39 :    
40 :     my $mode = 'trans';
41 :     while (@ARGV)
42 :     {
43 :     $_ = shift;
44 :     if (/^-(.*)/)
45 :     {
46 :     if ($1 eq "subsystems")
47 :     {
48 :     $mode = 'subsystems';
49 :     }
50 :     else
51 :     {
52 :     die $usage;
53 :     }
54 :     }
55 :     elsif ($mode eq 'trans')
56 :     {
57 :     push(@trans_files, $_);
58 :     }
59 :     elsif ($mode eq 'subsystems')
60 :     {
61 :     push(@subs, $_);
62 :     }
63 :     }
64 :    
65 :     my($trans_table, $genomes_seen) = read_trans_files(\@trans_files);
66 :    
67 :     if (@subs == 0)
68 :     {
69 : overbeek 1.2 @subs = sort $fig->all_subsystems();
70 : olson 1.1 }
71 :    
72 :     for my $sub (@subs)
73 :     {
74 :     fix_subsystem($sub, $trans_table, $genomes_seen);
75 :     }
76 :    
77 :     sub fix_subsystem
78 :     {
79 :     my($sname, $actions, $genomes_seen) = @_;
80 :    
81 :     my $sub = $fig->get_subsystem($sname);
82 :    
83 :     $sub or die "Cannot find subsystem $sname\n";
84 :    
85 :     my $modified;
86 :    
87 :     for my $genome (@$genomes_seen)
88 :     {
89 :     my $row_idx = $sub->get_genome_index($genome);
90 :    
91 :     next unless $row_idx;
92 :    
93 :     my $row = $sub->get_row($row_idx);
94 :    
95 :     my $tchange = 0;
96 :     my $tdel = 0;
97 :    
98 :     for my $cell (@$row)
99 :     {
100 :     my @ncell = ();
101 :     my $change = 0;
102 :     my $del = 0;
103 :    
104 :     for my $peg (@$cell)
105 :     {
106 :     my $action = $actions->{$peg};
107 :     if ($action eq 'del')
108 :     {
109 :     $del++;
110 :     }
111 :     elsif ($action =~ /^fig\|(\d+\.\d+)/)
112 :     {
113 :     if ($1 ne $genome)
114 :     {
115 :     die "Invalid replacement $peg -> $action in $sname";
116 :     }
117 :     push(@ncell, $action);
118 :     $change++;
119 :     }
120 :     else
121 :     {
122 :     push(@ncell, $peg);
123 :     }
124 :     }
125 :     if ($change or $del)
126 :     {
127 :     @$cell = @ncell;
128 :     $tdel += $del;
129 :     $tchange += $change;
130 :     }
131 :     }
132 :    
133 :     if ($tdel or $tchange)
134 :     {
135 :    
136 :     if (not $modified)
137 :     {
138 :     my $cur = $sub->get_curator;
139 :     print "$sname\t$cur\n";
140 :     }
141 :    
142 :     print " $genome\t$tdel deletes\t$tchange changes\n";
143 :     $modified++;
144 :     }
145 :     }
146 :    
147 :     if ($modified)
148 :     {
149 :     $sub->write_subsystem(1);
150 :     }
151 :    
152 :     }
153 :    
154 :     sub read_trans_files
155 :     {
156 :     my($files) = @_;
157 :    
158 :     my $actions = {};
159 :     my %genomes_seen;
160 :    
161 :     for my $file (@$files)
162 :     {
163 :     open(F, "<$file") or die "Cannot open transaction file $file: $!";
164 :    
165 :     while (<F>)
166 :     {
167 :     chomp;
168 :     my($type, @args) = split(/\t/);
169 :    
170 :     if ($type eq 'del')
171 :     {
172 :     $actions->{$args[0]} = 'del';
173 :    
174 :     $genomes_seen{$fig->genome_of($args[0])}++;
175 :     }
176 :     elsif ($type eq 'change')
177 :     {
178 :     $actions->{$args[0]} = $args[1];
179 :     $genomes_seen{$fig->genome_of($args[0])}++;
180 :     }
181 :     elsif ($type eq 'add')
182 :     {
183 :     }
184 :     else
185 :     {
186 :     die "Invalid action at $file line $.";
187 :     }
188 :     }
189 :     }
190 :     return $actions, [sort keys %genomes_seen];
191 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3