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

Annotation of /FigKernelScripts/apply_automatic_subsystem_updates.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1
2 :     #
3 :     # Given a file of the form
4 :     #
5 :     # 217.1 Phage_tail_proteins_2 6
6 :     # 217.1 RNA_modification_and_chromosome_partitioning_cluster 1
7 :     # 217.1 Streptococcal_Hyaluronic_Acid_Capsule 2
8 :     # 217.1 Tricarboxylate_transport_cassette 1
9 :     #
10 :     # determine the subsystems that can have the genomes automatically added.
11 :     # Look in the subsystems/bindings files in the genome directories to
12 :     # determine the roles populated.
13 :     #
14 :    
15 :     use strict;
16 :     use FIG;
17 :    
18 :     my $fig = new FIG;
19 :    
20 :     my %ss;
21 :     while (<>)
22 :     {
23 :     chomp;
24 :     my($genome, $ss, $variant) = split(/\t/);
25 :     push(@{$ss{$ss}}, [$genome, $variant]);
26 :     }
27 :    
28 :     for my $ss_name (sort keys %ss)
29 :     {
30 :     if (!$fig->ok_to_auto_update_subsys($ss_name))
31 :     {
32 :     # print "No update $ss_name\n";
33 :     next;
34 :     }
35 :     my $glist = $ss{$ss_name};
36 :     my @genomes = map { $_->[0] } @$glist;
37 :    
38 :     my $ss = Subsystem->new($ss_name, $fig);
39 :     my $curator = $ss->get_curator;
40 :     print "Update $ss_name ($curator): @genomes\n";
41 :    
42 :     my %has_genomes = map { $_ => 1 } $ss->get_genomes;
43 :    
44 :     for my $gent (@$glist)
45 :     {
46 :     my($genome, $variant) = @$gent;
47 :    
48 :     if ($has_genomes{$genome})
49 :     {
50 :     print "SS already has $genome\n";
51 :     next;
52 :     }
53 :     next unless $fig->is_prokaryotic($genome);
54 :    
55 :     $variant = "*$variant" unless $variant =~ /^\*/;
56 :    
57 :     my $bfile = $fig->organism_directory($genome) . "/Subsystems/bindings";
58 :     open(B, "<", $bfile) or die "Cannot open bindings $bfile: $!";
59 :     my %by_role;
60 :     while (<B>)
61 :     {
62 :     chomp;
63 :     my($bss, $role, $peg) = split(/\t/);
64 :     next unless $bss eq $ss_name;
65 :     push(@{$by_role{$role}}, $peg);
66 :     }
67 :     close(B);
68 :    
69 :     $ss->add_genome($genome);
70 :     my $gi = $ss->get_genome_index($genome);
71 :    
72 :     print "Add $ss_name $genome idx=$gi $variant\n";
73 :     $ss->set_variant_code($gi, $variant);
74 :    
75 :     for my $role ($ss->get_roles)
76 :     {
77 :     my $pegs = delete $by_role{$role};
78 :     next unless $pegs;
79 :     print " Role $role has @$pegs\n";
80 :     $ss->set_pegs_in_cell($genome, $role, $pegs);
81 :     }
82 :     if (%by_role)
83 :     {
84 :     print "Leftover roles: ", join(" " , keys %by_role), "\n";
85 :     }
86 :    
87 :     }
88 :     $ss->write_subsystem();
89 :     my $ss = Subsystem->new($ss_name, $fig);
90 :     $ss->db_sync();
91 :     }
92 :     $fig->mark_subsystems_modified();
93 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3