[Bio] / FigKernelPackages / ANNO.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/ANNO.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1 #!/usr/bin/perl -w
2 :     use strict;
3 :    
4 :     #
5 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
6 :     # for Interpretations of Genomes. All Rights Reserved.
7 :     #
8 :     # This file is part of the SEED Toolkit.
9 :     #
10 :     # The SEED Toolkit is free software. You can redistribute
11 :     # it and/or modify it under the terms of the SEED Toolkit
12 :     # Public License.
13 :     #
14 :     # You should have received a copy of the SEED Toolkit Public License
15 :     # along with this program; if not write to the University of Chicago
16 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
17 :     # Genomes at veronika@thefig.info or download a copy from
18 :     # http://www.theseed.org/LICENSE.TXT.
19 :     #
20 :     package ANNO;
21 :    
22 :     use strict;
23 :     use ERDB;
24 :     use Tracer;
25 :     use SeedUtils;
26 :     use ServerThing;
27 :    
28 :     sub new {
29 :     my ($class) = @_;
30 :     # Create the sapling object.
31 :     my $sap = ERDB::GetDatabase('Sapling');
32 :     # Create the server object.
33 :     my $retVal = { db => $sap };
34 :     # Bless and return it.
35 :     bless $retVal, $class;
36 :     return $retVal;
37 :     }
38 :    
39 :    
40 :     =head2 Primary Methods
41 :    
42 :     =head3 methods
43 :    
44 :     my $methodList = $ssObject->methods();
45 :    
46 :     Return a list of the methods allowed on this object.
47 :    
48 :     =cut
49 :    
50 :     use constant METHODS => [qw(metabolic_reconstruction
51 :     assign_function_to_prot
52 :     call_genes
53 :     find_rnas
54 :     assign_functions_to_DNA
55 :     )];
56 :    
57 :     sub methods {
58 :     # Get the parameters.
59 :     my ($self) = @_;
60 :     # Return the result.
61 :     return METHODS;
62 :     }
63 :    
64 :     #
65 :     # Docs are in ANNOserver.pm.
66 :     #
67 :    
68 :     sub metabolic_reconstruction {
69 :     # Get the parameters.
70 :     my ($self, $args) = @_;
71 :    
72 :     my $sapling = $self->{db};
73 :     my $retVal = [];
74 :    
75 :     # This counter will be used to generate user IDs for roles without them.
76 :     my $next = 1000;
77 :    
78 :     my $id_roles = $args->{-roles};
79 :     my @id_roles1 = map { (ref $_ ? $_ : [$_, "FR" . ++$next]) } @$id_roles;
80 :    
81 :     my @id_roles = ();
82 :     foreach my $tuple (@id_roles1)
83 :     {
84 :     my($function,$id) = @$tuple;
85 :     foreach my $role (split(/(; )|( [\]\@] )/,$function))
86 :     {
87 :     push(@id_roles,[$role,$id]);
88 :     }
89 :     }
90 :    
91 :     my %big;
92 :     my $id_display = 1;
93 :     map {push(@{$big{$_->[0]}}, $_->[1])} @id_roles;
94 :     my @resultRows = $sapling->GetAll("Subsystem Includes Role",
95 :     'ORDER BY Subsystem(id), Includes(sequence)', [],
96 :     [qw(Subsystem(id) Role(id) Includes(abbreviation))]);
97 :     my %ss_roles;
98 :     foreach my $row (@resultRows) {
99 :     my ($sub, $role, $abbr) = @$row;
100 :     $ss_roles{$sub}->{$role} = $abbr;
101 :     }
102 :     foreach my $sub (keys %ss_roles) {
103 :     my $roles = $ss_roles{$sub};
104 :    
105 :     my @abbr = map{$roles->{$_}} grep { $big{$_}} keys %$roles;
106 :     my $set = join(" ", @abbr);
107 :     if (@abbr > 0) {
108 :     my ($variant, $size) = $self->get_max_subset($sub, $set);
109 :     if ($variant) {
110 :     foreach my $role (keys %$roles) {
111 :     if ($id_display) {
112 :     foreach my $id (@{$big{$role}}) {
113 :     push (@$retVal, [$variant, $role, $id]);
114 :     }
115 :     } else {
116 :     push (@$retVal, [$variant, $role]);
117 :     }
118 :     }
119 :     }
120 :     }
121 :     }
122 :     # Return the result.
123 :     return $retVal;
124 :     }
125 :    
126 :     =head2 Internal Utility Methods
127 :    
128 :     =head3 get_max_subset
129 :    
130 :     my ($max_variant, $max_size) = $ssObject->get_max_subset($sub, $setA);
131 :    
132 :     Given a subsystem ID and a role rule, return the ID of the variant for
133 :     the subsystem that matches the most roles in the rule and the number of
134 :     roles matched.
135 :    
136 :     =over 4
137 :    
138 :     =item sub
139 :    
140 :     Name (ID) of the subsystem whose variants are to be examined.
141 :    
142 :     =item setA
143 :    
144 :     A space-delimited list of role abbreviations, lexically ordered. This provides
145 :     a unique specification of the roles in the set.
146 :    
147 :     =item RETURN
148 :    
149 :     Returns a 2-element list consisting of the ID of the variant found and the number
150 :     of roles matched.
151 :    
152 :     =back
153 :    
154 :     =cut
155 :    
156 :     sub get_max_subset {
157 :     my ($self, $sub, $setA) = @_;
158 :     my $sapling = $self->{db};
159 :     my $max_size = 0;
160 :     my $max_set;
161 :     my $max_variant;
162 :     my %set_hash;
163 :     my $qh = $sapling->Get("Subsystem Describes Variant", 'Subsystem(id) = ? AND Variant(type) = ?', [$sub, 'normal']);
164 :     while (my $resultRow = $qh->Fetch()) {
165 :     my @variantRoleRule = $resultRow->Value('Variant(role-rule)');
166 :     my ($variantCode) = $resultRow->Value('Variant(code)');
167 :     my $variantId = $sub.":".$variantCode;
168 :     foreach my $setB (@variantRoleRule) {
169 :     my $size = is_A_a_superset_of_B($setA, $setB);
170 :     if ($size && $size > $max_size) {
171 :     $max_size = $size;
172 :     $max_set = $setB;
173 :     $max_variant = $variantId;
174 :     }
175 :     }
176 :     }
177 :     #if ($max_size) {
178 :     #print STDERR "Success $max_variant, $max_set\n";
179 :     #}
180 :     return($max_variant, $max_size);
181 :     }
182 :    
183 :    
184 :     =head3 is_A_a_superset_of_B
185 :    
186 :     my $size = SS::is_A_a_superset_of_B($a, $b);
187 :    
188 :     This method takes as input two role rules, and returns 0 if the first
189 :     role rule is NOT a superset of the second; otherwise, it returns the size
190 :     of the second rule. A role rule is a space-delimited list of role
191 :     abbreviations in lexical order. This provides a unique identifier for a
192 :     set of roles in a subsystem.
193 :    
194 :     =over 4
195 :    
196 :     =item a
197 :    
198 :     First role rule.
199 :    
200 :     =item b
201 :    
202 :     Second role rule.
203 :    
204 :     =item RETURN
205 :    
206 :     Returns 0 if the first rule is NOT a superset of the second and the size of the
207 :     second rule if it is. As a result, if the first rule IS a superset, this method
208 :     will evaluate to TRUE, and to FALSE otherwise.
209 :    
210 :     =back
211 :    
212 :     =cut
213 :    
214 :     sub is_A_a_superset_of_B {
215 :     my ($a, $b) = @_;
216 :     my @a = split(" ", $a);
217 :     my @b = split(" ", $b);
218 :     if (@b > @a) {
219 :     return(0);
220 :     }
221 :     my %given;
222 :     map { $given{$_} = 1} @a;
223 :     map { if (! $given{$_}) {return 0}} split(" ", $b);
224 :     my $l = scalar(@b);
225 :     return scalar(@b);
226 :     }
227 :    
228 :    
229 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3