[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.1 - (view) (download) (as text)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3