[Bio] / SubsystemExtension / Cluster.pm Repository:
ViewVC logotype

Annotation of /SubsystemExtension/Cluster.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : heiko 1.1 package SubsystemExtension::Cluster;
2 :    
3 :    
4 :     use strict;
5 :     use warnings;
6 :     use Carp;
7 :     use Data::Dumper;
8 :     use Storable qw (nstore retrieve);
9 :    
10 :     use constant GENEWIDTH => 32;
11 :     use constant GENEHEIGHT => 12;
12 :     use constant SPACING => 5;
13 :    
14 :    
15 :     sub new {
16 :    
17 :     my ($class, $id) = @_;
18 :    
19 :     my $self;
20 :     $self->{id} = $id;
21 :     $self->{containedGenes} = {};
22 :     $self->{spanSeq} = {};
23 :     $self->{sortedLocations} = [];
24 :     $self->{map} = '';
25 :     $self->{joined} = 0;
26 :     # $self->{sequences} = $sequences;
27 :    
28 :     bless $self, $class;
29 :    
30 :     return $self;
31 :    
32 :     }
33 :    
34 :    
35 :     sub hasSequence {
36 :     my ($self, $seq) = @_;
37 :    
38 :     return $self->{spanSeq}->{$seq};
39 :    
40 :     }
41 :    
42 :    
43 :     sub hasGene {
44 :     my ($self, $gene) = @_;
45 :    
46 :     return $self->{containedGenes}->{$gene};
47 :    
48 :     }
49 :    
50 :     sub containedIn {
51 :    
52 :     # testet ob self in cluster enthalten ist
53 :     # d.h. alle self sequences, genes und locations muessen auch in cluster sein!
54 :     my ($self, $cluster) = @_;
55 :    
56 :     # zwei direkte abbruchbedingungen:
57 :     # $self hat mehr sequenzen oder $self hat mehr gene!
58 :    
59 :     return 0 if ($self->{sequencesCount} > $cluster->{sequencesCount});
60 :    
61 :     return 0 if ($self->{geneCount} > $cluster->{geneCount});
62 :    
63 :     # abbruch wenn eine sequenz in $self nicht in $cluster ist1
64 :    
65 :     foreach ($self->spannedSequences()) {
66 :     return 0 unless ($cluster->hasSequence($_));
67 :     }
68 :    
69 :     # abbruch wenn ein gen in $self nicht in $cluster ist!
70 :    
71 :     foreach ($self->containedGenes()) {
72 :     return 0 unless ($cluster->hasGene($_));
73 :     }
74 :    
75 :     foreach my $location (@{$self->{sortedLocations}}) {
76 :    
77 :     # diese location ist erstmal nicht vorhanden!
78 :     my $present = 0;
79 :     # iteriere ueber alle locations des zweiten clusters und vergleiche
80 :     # die locations
81 :     foreach my $cluster_location (@{$cluster->{sortedLocations}}) {
82 :    
83 :     if (($location->{sequence} == $cluster_location->{sequence}) &&
84 :     ($location->{start} >= $cluster_location->{start}) &&
85 :     ($location->{stop} <= $cluster_location->{stop})) {
86 :     $present = 1;
87 :     last;
88 :     }
89 :     }
90 :     return 0 unless $present;
91 :    
92 :     }
93 :    
94 :     return 1;
95 :     }
96 :    
97 :    
98 :     sub containedByElement {
99 :    
100 :     my ($self, $larger) = @_;
101 :    
102 :     # tests if all the own genes are contained in larger
103 :    
104 :     return if ($self->geneCount() > $larger->geneCount());
105 :    
106 :    
107 :     foreach ($self->containedGenes()) {
108 :     return unless $larger->{containedGenes}->{$_};
109 :     }
110 :    
111 :     return 1;
112 :     }
113 :    
114 :     sub containedByGenePercent {
115 :     my ($self, $percent, $larger) = @_;
116 :     my $match = 0;
117 :    
118 :     foreach (keys %{$self->{containedGenes}}) {
119 :     $match++ if ($larger->{containedGenes}->{$_});
120 :     }
121 :    
122 :     if ($match / scalar keys %{$self->{containedGenes}} > $percent/100) {
123 :     return 1;
124 :     } elsif ($match / scalar keys %{$larger->{containedGenes}} > ($percent/100)) {
125 :     return 1;
126 :     } else {
127 :     return 0;
128 :     }
129 :    
130 :     }
131 :    
132 :     sub toFile {
133 :    
134 :     my ($self, $filename) = @_;
135 :    
136 :     nstore $self, $filename;
137 :    
138 :     }
139 :    
140 :     sub fromFile {
141 :     my ($class, $filename) = @_;
142 :    
143 :     my $self;
144 :    
145 :     $self = retrieve $filename;
146 :    
147 :     return $self;
148 :     }
149 :    
150 :    
151 :     sub _clusterGeneSize {
152 :     my ($self) = @_;
153 :    
154 :     my %width;
155 :    
156 :     foreach my $location (@{$self->{sortedLocations}}) {
157 :    
158 :     $width{$location->{sequence}} += scalar @{$location->{genes}} + 1; # + 1 because of gap!
159 :     }
160 :    
161 :     my $max = 0;
162 :    
163 :     foreach (values %width) {
164 :     $max = $_ if ($_ > $max);
165 :     }
166 :    
167 :     return $max + 1; #+ 1 because of last gap number
168 :     }
169 :    
170 :    
171 :    
172 :    
173 :    
174 :     sub geneCount {
175 :     my ($self) = @_;
176 :    
177 :     return scalar keys %{$self->{containedGenes}};
178 :    
179 :     unless ($self->{geneCount}) {
180 :     $self->{geneCount} = scalar keys %{$self->{containedGenes}};
181 :     }
182 :    
183 :     return $self->{geneCount};
184 :    
185 :     }
186 :    
187 :     sub sequencesCount {
188 :     my ($self) = @_;
189 :    
190 :     unless ($self->{sequencesCount}) {
191 :     $self->{sequencesCount} = scalar keys %{$self->{spanSeq}};
192 :     }
193 :    
194 :     return $self->{sequencesCount};
195 :    
196 :     }
197 :    
198 :     sub containedGenes {
199 :    
200 :     my ($self) = @_;
201 :    
202 :     my @genes = sort {$a <=> $b} keys %{$self->{containedGenes}};
203 :    
204 :     if (wantarray) {
205 :     return @genes;
206 :     } else {
207 :     return \@genes;
208 :     }
209 :     }
210 :    
211 :     sub spannedSequences {
212 :     my ($self) = @_;
213 :    
214 :     my @seqs = sort {$a <=> $b} keys %{$self->{spanSeq}};
215 :    
216 :     if (wantarray) {
217 :     return @seqs;
218 :     } else {
219 :     return \@seqs;
220 :     }
221 :     }
222 :    
223 :     sub all_genes {
224 :     my ($self, $genome) = @_;
225 :    
226 :     my @genes;
227 :     foreach my $location (@{$self->{sortedLocations}}) {
228 :     foreach my $gene (@{$location->{genes}}) {
229 :     # print STDERR &Dumper($gene);
230 :     push @genes, $gene;
231 :     }
232 :     }
233 :    
234 :     return @genes;
235 :     }
236 :    
237 :     sub sortedLocations {
238 :    
239 :     my ($self) = @_;
240 :    
241 :     if (wantarray) {
242 :     return @{$self->{sortedLocations}};
243 :     } else {
244 :     return $self->{sortedLocations};
245 :     }
246 :    
247 :     }
248 :    
249 :    
250 :     sub to_table_row {
251 :     my ($self, $cgi) = @_;
252 :     my $html;
253 :     if (ref $cgi && $cgi->isa("CGI")) {
254 :     $html .= $cgi->Tr($cgi->td($cgi->checkbox({-name=>'cluster', -label=>'', -checked=>0, -value=>$self->{id}}).$cgi->a({-href=>$cgi->self_url()."#".$self->{id}},$self->{id})), $cgi->td(scalar keys %{$self->{containedGenes}}),$cgi->td(scalar keys %{$self->{spanSeq}}),$cgi->td("-"),$cgi->td(join ', ', sort {$a <=> $b} keys %{$self->{containedGenes}}));
255 :    
256 :     } else {
257 :    
258 :     $html .= sprintf ("<tr><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>", $self->{id}, scalar keys %{$self->{containedGenes}}, scalar keys %{$self->{spanSeq}} , join ', ', sort {$a <=> $b} keys %{$self->{containedGenes}});
259 :     }
260 :    
261 :     return $html;
262 :    
263 :     }
264 :    
265 :     sub to_string {
266 :    
267 :     my ($self) = @_;
268 :    
269 :     my $erg = "";
270 :    
271 :     my $containedGenesCount = scalar keys %{$self->{containedGenes}};
272 :     my $spanSeqCount = scalar keys %{$self->{spanSeq}};
273 :     $erg .= $self->{id}.": ";
274 :     $erg .= "#".$containedGenesCount."# ";
275 :     $erg .= "*".$spanSeqCount."* ";
276 :     foreach (@{$self->{sortedLocations}}) {
277 :     if (ref $_ eq "HASH") {
278 :     $erg .= "S".$_->{sequence}." (".$_->{start}.", ".$_->{stop}.") ";
279 :     }
280 :     }
281 :     $erg .= " Genes: [";
282 :     $erg .= join ', ', sort {$a <=> $b} keys %{$self->{containedGenes}};
283 :    
284 :     $erg .= "]\n";
285 :    
286 :     return $erg;
287 :     }
288 :    
289 :     sub id {
290 :    
291 :     my ($self) = @_;
292 :    
293 :     return $self->{id};
294 :     }
295 :    
296 :     sub genomes {
297 :    
298 :     my ($self) = @_;
299 :    
300 :     my %genomes;
301 :    
302 :     foreach my $location (@{$self->{sortedLocations}}) {
303 :     foreach my $gene (@{$location->{genes}}) {
304 :     if ($gene->{name} =~ /fig\|(\d+\.\d+)\./) {
305 :     $genomes{$1} = 1;
306 :     last;
307 :     }
308 :     }
309 :     }
310 :    
311 :     return keys %genomes;
312 :    
313 :    
314 :     }
315 :    
316 :    
317 :    
318 :    
319 :    
320 :     sub addRegion {
321 :    
322 :     my ($self, $sequenceIndex, $start, $stop, $genes, $sequenceName) = @_;
323 :    
324 :     foreach (@$genes) {
325 :     $self->{containedGenes}->{$_->{family}} = 1 if ($_->{family} && ($_->{family} > 0));
326 :     }
327 :    
328 :     unless (ref $self->{sortedLocations} eq "ARRAY") {
329 :     $self->{sortedLocations} = [];
330 :     }
331 :    
332 :     $self->{spanSeq}->{$sequenceIndex} = $sequenceName ? $sequenceName : 1;
333 :    
334 :     push @{$self->{sortedLocations}}, {sequence => $sequenceIndex, start => $start, stop => $stop, genes => $genes};
335 :    
336 :     @{$self->{sortedLocations}} = sort {$a->{start} <=> $b->{start}} @{$self->{sortedLocations}};
337 :    
338 :     $self->{geneCount} = scalar keys %{$self->{containedGenes}};
339 :    
340 :     $self->{sequencesCount} = scalar keys %{$self->{spanSeq}};
341 :    
342 :     }
343 :    
344 :    
345 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3