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

Annotation of /FigKernelPackages/FullLocation.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 : olson 1.10 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 : parrello 1.12 #
8 : olson 1.10 # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 : parrello 1.12 # Public License.
11 : olson 1.10 #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : parrello 1.1
20 :     package FullLocation;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use PageBuilder;
25 :     use BasicLocation;
26 :    
27 :     =head1 Full Location Object
28 :    
29 :     =head2 Introduction
30 :    
31 :     A I<full location object> describes a list of basic locations (segments) in a
32 :     particular genome. In addition to an array of basic location objects, it contains
33 :     a genome ID and a reference to a FIG-like object. The FIG-like object is always
34 :     accessed using the variable I<$fig>. This simplifies the process of determining which
35 :     FIG methods must be supported in order to make use of this object's features.
36 :    
37 :     The simplest way to create a full location object is by passing in the genome ID
38 :     and a location string. The location string contains a list of basic locations
39 :     separated by commas. These are converted into location objects and assembled into
40 :     the full location. The full location is considered I<bounded> by the first and last
41 :     basic locations in the list. This bounded region has a B<Left>, B<Right>, B<Begin>, and
42 :     B<Endpoint>, just like a basic location. So, for example, with a location list of
43 :    
44 :     RED_100_250, RED_275_325, RED_330_430
45 :    
46 :     the B<Left> and B<Begin> locations are C<RED_100>, while the B<Right> and B<EndPoint>
47 : parrello 1.23 locations are C<RED_430>. Similarly, with the location list
48 : parrello 1.1
49 :     BLUE_500_450, BLUE_425_300, BLUE_295_200
50 :    
51 : parrello 1.23 the B<Left> and B<EndPoint> locations are C<BLUE_200>, while the B<Right> and B<Begin>
52 : parrello 1.1 locations are C<BLUE_500>.
53 :    
54 :     A location can be converted to a DNA string using the genome ID and data accessible
55 :     through the fig-like object. A location also has a I<translation> that represents the
56 :     protein sequence produced DNA. The translation can be computed from the DNA or can be
57 :     provided by the client. If it is provided by the client, it will automatically be
58 :     extended when the boundaries are moved.
59 :    
60 :     Theoretically, a location can contain basic locations on different contigs and
61 :     pointing in different directions. In practice, this does not occur; therefore,
62 :     the location will be treated as a set of basic locations in a single direction
63 :     on a single contig. If this is not the case, problems will arise with some of
64 :     the methods.
65 :    
66 :     =cut
67 :    
68 :     #: Constructor FullLocation->new();
69 :    
70 :     =head2 Public Methods
71 :    
72 :     =head3 new
73 :    
74 : parrello 1.18 my $loc = FullLocation->new($fig, $genomeID, $locList, $translation, $code);
75 : parrello 1.1
76 :     Construct a new FullLocation object.
77 :    
78 :     =over 4
79 :    
80 :     =item fig
81 :    
82 :     A fig-like object that can be used to get the DNA and translation information.
83 :    
84 :     =item genomeID
85 :    
86 :     ID of the genome containing the location.
87 :    
88 :     =item locList
89 :    
90 :     List of locations. This can be a reference to a list of location strings, a
91 :     comma-delimited list of location strings, or a reference to a list of basic
92 :     location objects.
93 :    
94 :     =item translation (optional)
95 :    
96 :     Protein string representing the DNA inside the boundaries of the location.
97 :    
98 : parrello 1.14 =item code (optional)
99 :    
100 :     Translation code table to use for translating DNA triplets to proteins. If
101 :     none is specified, the standard code table will be used. If a number is
102 :     specified, then the appropriate NCBI code table will be requested from
103 : parrello 1.22 [[FigPm]].
104 : parrello 1.14
105 : parrello 1.1 =back
106 :    
107 :     =cut
108 :    
109 :     sub new {
110 :     # Get the parameters.
111 : parrello 1.14 my ($class, $fig, $genomeID, $locList, $translation, $code) = @_;
112 :     # If there's no code, default to the standard translation code.
113 :     if (! defined $code) {
114 :     $code = FIG::standard_genetic_code();
115 :     } elsif (! ref $code) {
116 :     $code = FIG::genetic_code($code);
117 :     }
118 : parrello 1.1 # Create the $loc object.
119 :     my $retVal = {
120 :     fig => $fig,
121 :     genomeID => $genomeID,
122 : parrello 1.14 translation => $translation,
123 :     code => $code
124 : parrello 1.1 };
125 :     # The tricky part is the location list. Regardless of its incoming format,
126 :     # we must convert it to a list of location objects.
127 :     my $locType = ref $locList;
128 :     if ($locType eq '') {
129 :     # Here we have a comma-delimited list of locations, so we convert it to
130 :     # an array reference.
131 :     $retVal->{locs} = _ParseLocations($retVal, split /\s*,\s*/, $locList);
132 :     } elsif ($locType eq 'ARRAY') {
133 :     # Here we have an array of location objects or strings, which we can
134 :     # pass directly to the parser.
135 :     $retVal->{locs} = _ParseLocations($retVal, @{$locList});
136 :     } else {
137 :     Confess("Invalid location list parameter of type $locType.");
138 :     }
139 :     # Scan the location array to determine the contig and direction. We choose
140 :     # the most popular contig and direction to represent all the locations.
141 :     my %contigs = ();
142 :     my %dirs = ( '+' => 0, '-' => 0 );
143 :     for my $loc (@{$retVal->{locs}}) {
144 :     $dirs{$loc->Dir}++;
145 :     $contigs{$loc->Contig}++
146 :     }
147 :     # Choose the most popular direction and contig.
148 :     $retVal->{dir} = GetBest(%dirs);
149 :     $retVal->{contig} = GetBest(%contigs);
150 :     if ($dirs{$retVal->{dir}} == 0) {
151 :     # Here the location list was empty.
152 :     Confess("Attempt to create a location for genome $genomeID that has no locations.");
153 :     }
154 :     # Bless and return the object.
155 :     bless $retVal, $class;
156 :     return $retVal;
157 :     }
158 :    
159 :     =head3 Locs
160 :    
161 : parrello 1.12 my $locObject = $loc->Locs->[$idx];
162 : parrello 1.1
163 :     Return a reference to the array of location objects.
164 :    
165 : parrello 1.13 B<NOTE>: Do not update the locations, as it will mess up the translation. Use the
166 :     L</Extend> method to change a full location's begin and/or end points.
167 :    
168 : parrello 1.1 =cut
169 :     #: Return Type $@;
170 :     sub Locs {
171 :     return $_[0]->{locs};
172 :     }
173 :    
174 :     =head3 Contig
175 :    
176 : parrello 1.12 my $contigID = $loc->Contig();
177 : parrello 1.1
178 :     Return the ID of the base contig for this location list. The base contig is the
179 :     contig used for most of the locations in the list.
180 :    
181 :     =cut
182 :     #: Return Type $;
183 :     sub Contig {
184 :     # Get the parameters.
185 :     my ($self) = @_;
186 :     # Return the result.
187 :     return $self->{contig};
188 :     }
189 :    
190 :     =head3 Dir
191 :    
192 : parrello 1.12 my $dir = $loc->Dir;
193 : parrello 1.1
194 :     Return the base direction for this location list. The base direction is the direction
195 :     (C<+> or C<->) used for most of the locations in the list.
196 :    
197 :     =cut
198 :     #: Return Type $;
199 :     sub Dir {
200 :     # Get the parameters.
201 :     my ($self) = @_;
202 :     # Return the result.
203 :     return $self->{dir};
204 :     }
205 :    
206 : parrello 1.25 =head3 Length
207 :    
208 :     my $len = $loc->Length
209 :    
210 :     Return the total length of all the locations.
211 :    
212 :     =cut
213 :    
214 :     sub Length {
215 :     # Get the parameters.
216 :     my ($self) = @_;
217 :     # Declare the result variable.
218 :     my $retVal = 0;
219 :     # Loop through the constituent locations.
220 :     for my $loc (@{$self->{locs}}) {
221 :     $retVal += $loc->Length;
222 :     }
223 :     # Return the total.
224 :     return $retVal;
225 :     }
226 :    
227 : parrello 1.2 =head3 NextPoint
228 :    
229 : parrello 1.12 my $offset = $loc->NextPoint;
230 : parrello 1.2
231 :     Return the location immediately after the end point of the last location.
232 :    
233 :     =cut
234 :     #: Return Type $;
235 :     sub NextPoint {
236 :     # Get the parameters.
237 :     my ($self) = @_;
238 :     # Get the last location.
239 :     my (undef, undef, $locN) = $self->GetBounds();
240 :     # Return the point after it.
241 :     return $locN->PointOffset($locN->Length);
242 :     }
243 :    
244 :     =head3 PrevPoint
245 :    
246 : parrello 1.12 my $offset = $loc->PrevPoint;
247 : parrello 1.2
248 :     Return the location immediately before the begin point of the first location.
249 :    
250 :     =cut
251 :     #: Return Type $;
252 :     sub PrevPoint {
253 :     # Get the parameters.
254 :     my ($self) = @_;
255 :     # Get the last location.
256 :     my (undef, $loc1, undef) = $self->GetBounds();
257 :     # Return the point after it.
258 :     return $loc1->PointOffset(-1);
259 :     }
260 :    
261 :     =head3 Begin
262 :    
263 : parrello 1.12 my $offset = $loc->Begin;
264 : parrello 1.2
265 :     Return the begin point of the first location.
266 :    
267 :     =cut
268 :     #: Return Type $;
269 :     sub Begin {
270 :     # Get the parameters.
271 :     my ($self) = @_;
272 : parrello 1.4 # Get the first location.
273 : parrello 1.2 my (undef, $loc1, undef) = $self->GetBounds();
274 :     # Return its begin point.
275 :     return $loc1->Begin;
276 :     }
277 :    
278 : parrello 1.4 =head3 EndPoint
279 :    
280 : parrello 1.12 my $offset = $loc->EndPoint;
281 : parrello 1.4
282 :     Return the end point of the last location.
283 :    
284 :     =cut
285 :     #: Return Type $;
286 :     sub EndPoint {
287 :     # Get the parameters.
288 :     my ($self) = @_;
289 :     # Get the last location.
290 :     my (undef, undef, $locN) = $self->GetBounds();
291 :     # Return its end point.
292 :     return $locN->EndPoint;
293 :     }
294 :    
295 : parrello 1.2 =head3 SeedString
296 :    
297 : parrello 1.12 my $string = $loc->SeedString;
298 : parrello 1.2
299 :     Return a comma-delimited list of this object's basic locations, in SEED format.
300 :    
301 :     =cut
302 :     #: Return Type $;
303 :     sub SeedString {
304 :     # Get the parameters.
305 :     my ($self) = @_;
306 :     # Map the location list to SEED strings.
307 :     my @seeds = map { $_->SeedString } @{$self->{locs}};
308 :     # Return the result.
309 :     return join ", ", @seeds;
310 :     }
311 :    
312 :     =head3 Adjusted
313 :    
314 : parrello 1.12 my $offset = $loc->Adjusted($oldOffset, $distance);
315 : parrello 1.2
316 :     Adjust the specified offset by the specified distance in the direction of this
317 :     location. If this is a forward location, the distance is added; if it is a backward
318 :     location, the distance is subtracted.
319 :    
320 :     =over 4
321 :    
322 :     =item oldOffset
323 :    
324 :     Offset to adjust.
325 :    
326 :     =item distance
327 :    
328 :     Distance by which to adjust the offset. This value can be negative.
329 :    
330 :     =item RETURN
331 :    
332 :     Returns a new offset formed by moving the specified distance from the original offset
333 :     in this location's direction.
334 :    
335 :     =back
336 :    
337 :     =cut
338 :     #: Return Type $;
339 :     sub Adjusted {
340 :     # Get the parameters.
341 :     my ($self, $oldOffset, $distance) = @_;
342 :     # Do the adjustment.
343 :     return $oldOffset + ($self->Dir eq '+' ? $distance : -$distance);
344 :     }
345 :    
346 : parrello 1.1 =head3 GetBest
347 :    
348 : parrello 1.12 my $bestKey = FullLocation::GetBest(%hash);
349 : parrello 1.1
350 :     Return the key of the hash element with the highest positive numeric value.
351 :    
352 :     =over 4
353 :    
354 :     =item hash
355 :    
356 :     A hash mapping keys to numbers.
357 :    
358 :     =item RETURN
359 :    
360 :     Returns the key having the highest value. If the hash is empty, or has no non-negative
361 : overbeek 1.6 values, returns C<undef>.
362 : parrello 1.1
363 :     =back
364 :    
365 :     =cut
366 :     #: Return Type $;
367 :     sub GetBest {
368 :     # Get the parameters.
369 :     my (%hash) = @_;
370 :     # Declare the return variable and initialize the best-count.
371 :     my ($retVal, $best) = (undef, 0);
372 :     # Search the hash.
373 :     for my $key (keys %hash) {
374 :     my $value = $hash{$key};
375 :     if ($value >= $best) {
376 :     $retVal = $key;
377 :     $best = $value;
378 :     }
379 :     }
380 :     # Return the result.
381 :     return $retVal;
382 :     }
383 :    
384 :     =head3 DNA
385 :    
386 : parrello 1.12 my $dnaString = $loc->DNA;
387 : parrello 1.1
388 :     Return the complete DNA string for this location.
389 :    
390 :     =cut
391 :     #: Return Type $;
392 :     sub DNA {
393 :     # Get the parameters.
394 :     my ($self) = @_;
395 :     my $fig = $self->{fig};
396 :     # Use the FIG object to extract the DNA.
397 :     my $retVal = $fig->dna_seq($self->{genomeID}, $self->Contig, map { $_->SeedString } @{$self->Locs});
398 :     # Return the result.
399 :     return $retVal;
400 :     }
401 :    
402 : parrello 1.2 =head3 Codon
403 :    
404 : parrello 1.12 my $codon = $loc->Codon($point);
405 : parrello 1.2
406 :     Return the DNA codon at the specified point on this location's contig in this
407 :     location's direction.
408 :    
409 :     =over 4
410 :    
411 :     =item point
412 :    
413 :     Offset into the contig of the codon.
414 :    
415 :     =item RETURN
416 :    
417 :     Returns a three-letter DNA codon from the specified point.
418 :    
419 :     =back
420 :    
421 :     =cut
422 :     #: Return Type $;
423 :     sub Codon {
424 :     # Get the parameters.
425 :     my ($self, $point) = @_;
426 :     # Get the FIG object.
427 :     my $fig = $self->{fig};
428 :     # Compute the codon location.
429 :     my $loc = $self->Contig . "_" . $point . "_" . $self->Adjusted($point,2);
430 :     # Return the DNA.
431 :     return $fig->dna_seq($self->{genomeID}, $loc);
432 :     }
433 :    
434 : parrello 1.1 =head3 Translation
435 :    
436 : parrello 1.12 my $proteinString = $loc->Translation($code, $fixStart);
437 : parrello 1.1
438 :     Return the protein translation of this location's DNA. The first time a
439 :     translation is requested, it will be cached in the object, and returned
440 :     unmodified. It is also possible that a translation specified in the
441 :     constructor exists, in which case it will be returned. Thus, the
442 :     I<$code> and I<$fixStart> parameters only matter on the first call.
443 :    
444 :     =over 4
445 :    
446 :     =item code (optional)
447 :    
448 :     Translation code table, in the form of a hash mapping DNA triples to protein
449 :     letters. If omitted, the standard translation table in C<FIG.pm> will be
450 :     used.
451 :    
452 :     =item fixStart (optional)
453 :    
454 :     TRUE if the first DNA triple should be given special handling, else FALSE.
455 :     If TRUE, then a value of C<TTG> or C<GTG> in the first position will be
456 :     translated to C<M> instead of the value specified in the translation code.
457 :    
458 :     =item RETURN
459 :    
460 :     Returns the protein translation for this location.
461 :    
462 :     =back
463 :    
464 :     =cut
465 :     #: Return Type $;
466 :     sub Translation {
467 :     # Get the parameters.
468 :     my ($self, $code, $fixStart) = @_;
469 :     # Declare the return variable.
470 :     my $retVal;
471 :     # Check for a cached translation.
472 :     if ($self->{translation}) {
473 :     # Return the cahced translation.
474 :     $retVal = $self->{translation};
475 :     } else {
476 : parrello 1.14 # Check for a translation code.
477 :     if (! defined $code) {
478 : olson 1.24 #
479 :     # Don't default to the standard one, you very carefully
480 :     # created one in the constructor. Why not use it.
481 :     #
482 :     $code = $self->{code};
483 : parrello 1.14 }
484 : parrello 1.1 # Here we have to do some work. Extract our DNA.
485 :     my $dna = $self->DNA;
486 :     # Translate it.
487 :     $retVal = FIG::translate($dna, $code, $fixStart);
488 : parrello 1.14 # Chop off the stop codon.
489 :     $retVal =~ s/\*$//;
490 : olson 1.24
491 : parrello 1.14 # Cache the translation and the code table.
492 : olson 1.24 #
493 :     # This probably should be cached based on the code table used. It maybe
494 :     # shouldn't even be cached at all.
495 : parrello 1.1 $self->{translation} = $retVal;
496 : olson 1.24
497 :     #
498 :     # Why would you cache this; it was probably passed in as an exceptional case.
499 :     #$self->{code} = $code;
500 : parrello 1.1 }
501 :     # Return the result.
502 :     return $retVal;
503 :     }
504 :    
505 : parrello 1.23 =head3 ConstrainPoint
506 : parrello 1.9
507 : parrello 1.23 my $constrainedPoint = $loc->ConstrainPoint($point);
508 : parrello 1.9
509 :     Change a point location value so that it fits inside the base contig. If the point
510 :     location is less than 1, it will be set to 1. If it's greater than the length of
511 :     the contig, it will be set to the length of the contig.
512 :    
513 :     =over 4
514 :    
515 :     =item point
516 :    
517 :     Location to be constrained.
518 :    
519 :     =item RETURN
520 :    
521 :     Returns the value of the nearest location that is on the base contig of this location.
522 :    
523 :     =back
524 :    
525 :     =cut
526 :     #: Return Type $;
527 : parrello 1.23 sub ConstrainPoint {
528 : parrello 1.9 # Get the parameters.
529 :     my ($self, $point) = @_;
530 :     # Declare the return variable.
531 :     my $retVal;
532 :     # Check for a value less than 1.
533 :     if ($point < 1) {
534 :     $retVal = 1;
535 :     } else {
536 :     # Check for a value off the end of the contig.
537 :     my $fig = $self->{fig};
538 :     my $contigEnd = $fig->contig_ln($self->{genomeID}, $self->Contig);
539 :     if ($point > $contigEnd) {
540 :     # Bring the point back onto the contig.
541 :     $retVal = $contigEnd;
542 :     } else {
543 :     # Return the incoming point unmodified.
544 :     $retVal = $point;
545 :     }
546 :     }
547 :     # Return the result.
548 :     return $retVal;
549 :     }
550 :    
551 : parrello 1.3 =head3 ExtremeCodon
552 :    
553 : parrello 1.12 my $loc->ExtremeCodon($dir);
554 : parrello 1.3
555 :     Return the most extreme codon in the specified direction. This is not always the most
556 :     extreme location, since the distance to the appropriate edge of the location must be
557 :     a multiple of 3.
558 :    
559 :     =over 4
560 :    
561 :     =item dir
562 :    
563 :     C<first> to get the codon moving away from the beginning of the location, C<last>
564 :     to get the codon moving away from the end of the location.
565 :    
566 :     =item RETURN
567 :    
568 : parrello 1.4 Returns the edge location of the desired codon. If we are going toward the left, this
569 :     is the left point in the codon; if we are going toward the right, this is the right
570 :     point in the codon.
571 : parrello 1.3
572 :     =back
573 :    
574 :     =cut
575 :    
576 :     sub ExtremeCodon {
577 :     # Get the parameters.
578 :     my ($self, $dir) = @_;
579 :     my $fig = $self->{fig};
580 :     # The first task is to determine the starting point and direction for the
581 :     # search. We start by converting the direction to the same format as the
582 :     # location direction.
583 :     my $parity = ($dir eq 'first' ? '-' : '+');
584 : parrello 1.4 # Get the contig length.
585 :     my $contig_len = $fig->contig_ln($self->{genomeID}, $self->Contig);
586 : parrello 1.8 # If we're moving in the opposite direction from the location, we're going to
587 : parrello 1.3 # go toward the beginning of the contig; otherwise, we're going toward the
588 :     # end.
589 :     my ($multiplier, $endPoint);
590 :     if ($parity ne $self->Dir) {
591 :     ($multiplier, $endPoint) = (-3, 1);
592 :     } else {
593 : parrello 1.4 ($multiplier, $endPoint) = (3, $contig_len);
594 : parrello 1.3 }
595 :     # Now we need the start point, which is determined by direction of this method.
596 : parrello 1.4 my $beginPoint = ($parity eq '-' ? $self->Begin : $self->EndPoint);
597 : parrello 1.3 # Compute the number of positions to move and add it to the begin point.
598 :     my $retVal = int(($endPoint - $beginPoint) / $multiplier) * $multiplier +
599 :     $beginPoint;
600 :     # Return the codon found.
601 :     return $retVal;
602 :     }
603 :    
604 : parrello 1.13
605 : parrello 1.2 =head3 Extend
606 :    
607 : parrello 1.12 my = $loc->Extend($newBegin, $newEnd, $trimFlag);
608 : parrello 1.2
609 :     Extend this gene to a new begin point and a new end point. If a translation exists,
610 : parrello 1.5 it will be updated to match the new locations. The I<$trimFlag> indicates whether
611 :     or not it is permissible to shrink the location at either end. If an attempt is made
612 :     to shrink and I<$trimFlag> is not specified, then a fatal error will occur.
613 : parrello 1.2
614 :     =over 4
615 :    
616 :     =item newBegin
617 :    
618 : parrello 1.13 Proposed new beginning offset. If undefined, the begin location will not be changed.
619 :    
620 :     =item newEnd
621 : parrello 1.2
622 : parrello 1.13 Proposed new ending offset. If undefined, the ending location will not be changed.
623 : parrello 1.2
624 : parrello 1.13 =item trimFlag
625 :    
626 :     If TRUE, the begin and end offsets can shrink the location.
627 : parrello 1.2
628 :     =back
629 :    
630 :     =cut
631 :     #: Return Type ;
632 :     sub Extend {
633 :     # Get the parameters.
634 : parrello 1.5 my ($self, $newBegin, $newEnd, $trimFlag) = @_;
635 : parrello 1.2 my $fig = $self->{fig};
636 :     # Get our boundaries.
637 :     my ($boundLoc, $loc1, $locN) = $self->GetBounds;
638 :     # Get the current length of the start location.
639 : parrello 1.5 my $len = $boundLoc->Length;
640 :     # Extend the beginning of the bounds.
641 : parrello 1.13 if (defined $newBegin) {
642 :     $boundLoc->SetBegin($newBegin);
643 :     my $excess = $boundLoc->Length - $len;
644 :     # Insure this is a real extension.
645 :     if ($excess < 0) {
646 :     # Find out if we can trim.
647 :     if (! $trimFlag) {
648 :     # We can't trim, so it's an error.
649 :     Confess("Invalid begin location $newBegin for location " . $boundLoc->String . ".");
650 :     } elsif ($self->{translation}) {
651 :     # We can trim, and a translation exists, so we lop some characters off
652 :     # the front. Note that we divide by -3 because if we're here, the excess
653 :     # is automatically negative.
654 :     my $proteinExcess = int($excess / -3);
655 :     $self->{translation} = substr $self->{translation}, $proteinExcess;
656 :     }
657 :     } elsif ($excess > 0 && $self->{translation}) {
658 :     # Here we have new stuff to translate. Get its location.
659 :     my $excessLoc = BasicLocation->new($loc1->Contig, $newBegin, $loc1->Dir, $excess);
660 :     # Extract its DNA and translate it.
661 :     my $newDNA = $fig->dna_seq($self->{genomeID}, $excessLoc->SeedString);
662 : parrello 1.14 my $newTran = FIG::translate($newDNA, $self->{code});
663 : parrello 1.13 # Prefix the new translation to the old one.
664 :     $self->{translation} = $newTran . $self->{translation};
665 :     }
666 :     # We successfully updated the translation (if necessary), so we adjust the
667 :     # start of the first location in the full location's list.
668 :     $loc1->SetBegin($newBegin);
669 :     # Get the new current length of the bounds location.
670 :     $len = $boundLoc->Length;
671 :     }
672 :     # Extend the ending.
673 :     if (defined $newEnd) {
674 :     $boundLoc->SetEnd($newEnd);
675 :     my $excess = $boundLoc->Length - $len;
676 :     # Insure this is a real extension.
677 :     if ($excess < 0) {
678 :     # Find out if we can trim.
679 :     if (! $trimFlag) {
680 :     # We can't trim, so it's an error.
681 :     Confess("Invalid end location $newEnd for location " . $boundLoc->String . ".");
682 :     } elsif ($self->{translation}) {
683 :     # We can trim, and a translation exists, so we lop off some proteins at
684 :     # the end. Note that we divide by 3 and the excess is negative, so the
685 :     # result will be negative. We use it as a negative length in the substr
686 :     # expression to trim end characters.
687 :     my $negativeProteinExcess = int($excess / 3);
688 :     $self->{translation} = substr $self->{translation}, 0, $negativeProteinExcess;
689 :     }
690 :     } elsif ($excess > 0 && $self->{translation}) {
691 :     # Here we have new stuff to translate. Get its location.
692 :     my $excessLoc = BasicLocation->new($locN->Contig, $boundLoc->PointOffset($len), $locN->Dir,
693 :     $excess);
694 :     # Extract its DNA and translate it.
695 :     my $newDNA = $fig->dna_seq($self->{genomeID}, $excessLoc->SeedString);
696 : parrello 1.14 my $newTran = FIG::translate($newDNA, $self->{code});
697 : parrello 1.13 # Append the new translation to the old one.
698 :     $self->{translation} .= $newTran;
699 :     }
700 :     # Here we sucessfully updated the translation and the update is legal, so
701 :     # we can modify the end of the last location.
702 :     $locN->SetEnd($newEnd);
703 :     }
704 : parrello 1.15 if ($self->{translation}) {
705 :     # Chop the stop codon off the end of the translation.
706 :     $self->{translation} =~ s/\*$//;
707 :     }
708 : parrello 1.2 }
709 :    
710 : parrello 1.14 =head3 ConstrainCodon
711 :    
712 :     my $point = $loc->ConstrainCodon($point, $codonPoint);
713 :    
714 :     Constrain the specified point so that it is inside the bounds of this
715 :     location's contig and its distance to the specified codon point is a
716 :     multiple of 3.
717 :    
718 :     =over 4
719 :    
720 :     =item point
721 :    
722 :     Point index (relative to the contig) to be constrained.
723 :    
724 :     =item codonPoint
725 :    
726 :     Index (relative to the contig) of a point that is the start of a codon.
727 :    
728 :     =item RETURN
729 :    
730 :     Returns the constrained index.
731 :    
732 :     =back
733 :    
734 :     =cut
735 :    
736 :     sub ConstrainCodon {
737 :     # Get the parameters.
738 :     my ($self, $point, $codonPoint) = @_;
739 :     # Declare the return variable.
740 :     my $retVal = $point;
741 :     # Check for too far left.
742 :     if ($retVal < 1) {
743 :     $retVal = ($codonPoint - 1) % 3 + 1;
744 :     } else {
745 :     # Check for too far right.
746 :     my $contigLen = $self->{fig}->contig_ln($self->{genomeID}, $self->Contig);
747 :     if ($retVal > $contigLen) {
748 :     $retVal = $contigLen - ($contigLen - $codonPoint) % 3;
749 :     }
750 :     }
751 :     # Return the result.
752 :     return $retVal;
753 :     }
754 :    
755 :    
756 : parrello 1.1 =head3 GetBounds
757 :    
758 : parrello 1.13 my ($boundLoc, $loc1, $locN) = $loc->GetBounds;
759 : parrello 1.1
760 :     Analyze this location and return information about its boundaries. This includes
761 :     a location for the bounds, the first location, and the last location. The
762 :     bounds essentially define the location as it would be if it were all on a single
763 :     contig in the same direction and had no gaps. The first location is the location
764 :     object containing the begin point of the bounds, and the last location is the
765 :     location object containing the end point of the bounds.
766 :    
767 :     =cut
768 :    
769 :     sub GetBounds {
770 :     # Get the parameters.
771 :     my ($self) = @_;
772 :     # Declare the return variables.
773 :     my ($boundLoc, $loc1, $locN);
774 :     # Get a reference to the location list.
775 :     my $locList = $self->Locs;
776 :     # The most common case is a singleton location list. We handle that first.
777 :     if (@{$locList} == 1) {
778 :     my $bloc = $locList->[0];
779 :     $boundLoc = BasicLocation->new($bloc);
780 :     $loc1 = $bloc;
781 :     $locN = $bloc;
782 :     } else {
783 :     # Here we have a multiple-location list. We search for the leftmost left
784 :     # and rightmost right on the base contig. To do that, we first extract
785 :     # all the eligible locations.
786 :     my $baseContig = $self->Contig;
787 :     my @baseLocs = grep { $_->Contig eq $baseContig } @{$locList};
788 :     # Next we prime the loop with a location popped off the list.
789 :     my $loc0 = pop @baseLocs;
790 :     my ($leftLoc, $rightLoc) = ($loc0, $loc0);
791 :     # Search for the leftmost and rightmost locations.
792 :     for my $loci (@baseLocs) {
793 :     if ($loci->Left < $leftLoc->Left) {
794 :     $leftLoc = $loci;
795 :     }
796 :     if ($loci->Right > $rightLoc->Right) {
797 :     $rightLoc = $loci;
798 :     }
799 :     }
800 :     # Now we have enough information to build the bounding location. First,
801 :     # we get the length.
802 :     my $len = $rightLoc->Right - $leftLoc->Left + 1;
803 :     # Next, we arrange the left and right locations according to the direction.
804 :     if ($self->Dir eq '+') {
805 :     ($loc1, $locN) = ($leftLoc, $rightLoc);
806 :     } else {
807 :     ($loc1, $locN) = ($rightLoc, $leftLoc);
808 :     }
809 :     # Finally, we create the bounding location.
810 :     $boundLoc = BasicLocation->new($baseContig, $loc1->Begin, $self->Dir, $len);
811 :     }
812 :     # Return the results.
813 :     return ($boundLoc, $loc1, $locN);
814 :     }
815 :    
816 : parrello 1.21 =head2 Codon Search Methods
817 :    
818 :     =head3 UpstreamSearch
819 :    
820 :     my $loc = $floc->UpstreamSearch($pattern, $limit);
821 :    
822 :     Search upstream from this location for a codon as identified by the
823 :     specified pattern, stopping at the end of the contig or when the
824 :     specified limit is reached.
825 :    
826 :     =over 4
827 :    
828 :     =item pattern
829 :    
830 :     Codon pattern to search for, expressed as a bar-delimited list of base triplets.
831 :     For example, C<taa|tag|tga> would search for a stop codon.
832 :    
833 :     =item limit (optional)
834 :    
835 :     Maximum number of base pairs to search. Must be a multiple of 3.
836 :    
837 :     =item RETURN
838 :    
839 :     Returns a [[BasicLocationPm]] object for the codon found.
840 :    
841 :     =back
842 :    
843 :     =cut
844 :    
845 :     sub UpstreamSearch {
846 :     # Get the parameters.
847 :     my ($self, $pattern, $limit) = @_;
848 :     # Get the FIG object.
849 :     my $fig = $self->{fig};
850 :     # Declare the return variable.
851 :     my $retVal;
852 :     # Locate the starting and ending positions for the search. The search
853 :     # ends immediately upstream of our begin point.
854 :     my $end = $self->PrevPoint;
855 :     my $start = $end - ($self->Dir . 1) * ($limit - 1);
856 :     # Constrain these values to the inside of the contig.
857 :     $start = $self->ConstrainCodon($start, $self->Begin);
858 :     $end = $self->ConstrainCodon($end, $self->Begin + ($self->Dir . 2));
859 :     # Get the DNA to search. Note we convert it automatically to lower case.
860 :     my $dna = lc $fig->dna_seq($self->{genomeID}, $self->Contig . "_${start}_${end}");
861 :     # Insure the pattern is also lower-case.
862 :     $pattern = lc $pattern;
863 :     # Get the location of the last codon in the dna sequence.
864 :     my $i1 = length($dna) - 3;
865 :     Trace("$i1 base pairs in search.") if T(4);
866 :     Trace("Upsearch DNA translation\n" . FIG::translate($dna, $self->{code})) if T(4);
867 :     for (my $i = $i1; $i >= 0 && ! defined($retVal); $i -= 3) {
868 :     # Check for a match.
869 :     if (substr($dna, $i, 3) =~ /$pattern/) {
870 :     # Compute the actual return value. This will also stop the loop.
871 :     $retVal = BasicLocation->new($self->Contig, $i * ($self->Dir . 1) + $start, $self->Dir, 3);
872 :     }
873 :     }
874 :     # Return the result.
875 :     return $retVal;
876 :     }
877 :    
878 :    
879 :     =head3 DownstreamSearch
880 :    
881 :     my $loc = $floc->DownstreamSearch($pattern, $limit);
882 :    
883 :     Search downstream from this location for a codon as identified by the
884 :     specified pattern, stopping at the end of the contig or when the
885 :     specified limit is reached.
886 :    
887 :     =over 4
888 :    
889 :     =item pattern
890 :    
891 :     Codon pattern to search for, expressed as a bar-delimited list of base triplets.
892 :     For example, C<taa|tag|tga> would search for a stop codon.
893 :    
894 :     =item limit (optional)
895 :    
896 :     Maximum number of base pairs to search. Must be a multiple of 3.
897 :    
898 :     =item RETURN
899 :    
900 : parrello 1.22 Returns a [[BasicLocationPm]] object for the codon found.
901 : parrello 1.21
902 :     =back
903 :    
904 :     =cut
905 :    
906 :     sub DownstreamSearch {
907 :     # Get the parameters.
908 :     my ($self, $pattern, $limit) = @_;
909 :     # Get the FIG object.
910 :     my $fig = $self->{fig};
911 :     # Declare the return variable.
912 :     my $retVal;
913 :     # Locate the starting and ending positions for the search. The search starts
914 :     # immediately downstream of our end point.
915 :     my $start = $self->NextPoint;
916 :     my $end = $start + ($self->Dir . 1) * ($limit - 1);
917 :     # Do a down search to find the codon.
918 :     $retVal = $self->DownSearch($pattern, $start, $end);
919 :     # Return the result.
920 :     return $retVal;
921 :     }
922 :    
923 :    
924 :     =head3 InsideSearch
925 :    
926 :     my $loc = $floc->InsideSearch($pattern);
927 :    
928 :     Search inside this location for a codon as identified by the
929 :     specified pattern.
930 :    
931 :     =over 4
932 :    
933 :     =item pattern
934 :    
935 :     Codon pattern to search for, expressed as a bar-delimited list of base triplets.
936 :     For example, C<taa|tag|tga> would search for a stop codon.
937 :    
938 :     =item RETURN
939 :    
940 :     Returns a [[BasicLocationPm]] object for the codon found.
941 :    
942 :     =back
943 :    
944 :     =cut
945 :    
946 :     sub InsideSearch {
947 :     # Get the parameters.
948 :     my ($self, $pattern, $limit) = @_;
949 :     # Get the FIG object.
950 :     my $fig = $self->{fig};
951 :     # Declare the return variable.
952 :     my $retVal;
953 :     # Locate the starting and ending positions for the search. The search
954 :     # is entirely inside the location.
955 :     my $start = $self->Begin;
956 :     my $end = $self->EndPoint;
957 :     # Do a down search to find the codon.
958 :     $retVal = $self->DownSearch($pattern, $start, $end);
959 :     # Return the result.
960 :     return $retVal;
961 :     }
962 :    
963 :     =head3 DownSearch
964 :    
965 :     my $loc = $floc->DownSearch($pattern, $start, $end);
966 :    
967 :     Search parallel to this location for a codon as identified by the
968 :     specified pattern, starting at the specified start point and stopping
969 :     at the specified end point.
970 :    
971 :     =over 4
972 :    
973 :     =item pattern
974 :    
975 :     Codon pattern to search for, expressed as a bar-delimited list of base triplets.
976 :     For example, C<taa|tag|tga> would search for a stop codon.
977 :    
978 :     =item $start
979 :    
980 :     Starting position for search.
981 :    
982 :     =item $end
983 :    
984 :     Ending position for search.
985 :    
986 :     =item RETURN
987 :    
988 :     Returns a [[BasicLocationPm]] object for the codon found.
989 :    
990 :     =back
991 :    
992 :     =cut
993 :    
994 :     sub DownSearch {
995 :     # Get the parameters.
996 :     my ($self, $pattern, $start, $end) = @_;
997 :     # Get the FIG object.
998 :     my $fig = $self->{fig};
999 :     # Declare the return variable.
1000 :     my $retVal;
1001 :     # Insure we're inside the contig.
1002 :     my $realStart = $self->ConstrainCodon($start, $start);
1003 :     my $realEnd = $self->ConstrainCodon($end, $start + ($self->Dir . 2));
1004 :     # Get the DNA to search. Note we convert it automatically to lower case.
1005 :     my $dna = lc $fig->dna_seq($self->{genomeID}, $self->Contig . "_${realStart}_${realEnd}");
1006 :     # Insure the pattern is also lower-case.
1007 :     $pattern = lc $pattern;
1008 :     # Get the length of the dna sequence.
1009 :     my $i1 = length($dna);
1010 :     Trace("$i1 base pairs in search.") if T(4);
1011 :     Trace("Downsearch DNA translation\n" . FIG::translate($dna, $self->{code})) if T(4);
1012 :     for (my $i = 0; $i < $i1 && ! defined($retVal); $i += 3) {
1013 :     # Check for a match.
1014 :     if (substr($dna, $i, 3) =~ /$pattern/) {
1015 :     # Compute the actual return value. This will also stop the loop.
1016 :     $retVal = BasicLocation->new($self->Contig, $i * ($self->Dir . 1) + $realStart, $self->Dir, 3);
1017 :     }
1018 :     }
1019 :     # Return the result.
1020 :     return $retVal;
1021 :     }
1022 :    
1023 : parrello 1.14 =head3 PickGeneBoundaries
1024 :    
1025 : parrello 1.19 my $rc = $floc->PickGeneBoundaries(-stop => $stopPattern,
1026 :     -start => $startPattern, -limit => $limit);
1027 : parrello 1.14
1028 :     Update this location so that it has a valid start and stop. The basic
1029 :     algorithm used is to search upstream and downstream for stop codons, then
1030 :     search between the stop codons for the first start codon.
1031 :    
1032 :     =over 4
1033 :    
1034 : parrello 1.19 =item stop (optional)
1035 : parrello 1.14
1036 :     Search pattern for the stop codon, encoded as a bar-delimited list of DNA triplets
1037 :     (e.g. C<tta|ata|tag>). If omitted, the default is to look for stop codons in the
1038 :     attached genetic code table.
1039 :    
1040 : parrello 1.19 =item start (optional)
1041 : parrello 1.14
1042 :     Search pattern for the start codon, encoded as a bar-delimited list of DNA triplets.
1043 :     If omitted, the default is C<atg|gtg|ttg>.
1044 :    
1045 :     =item limit (optional)
1046 :    
1047 : parrello 1.18 If a number, then the maximum distance to search when attempting to extend the
1048 :     location. If a [[BasicLocationPm]] object or a location string, then none of the searches will
1049 :     go outside the region spanned by the location. If omitted, the default is a scalar value of C<9000>.
1050 : parrello 1.14
1051 :     =item RETURN
1052 :    
1053 : parrello 1.20 Returns TRUE if successful, FALSE if the process fails.
1054 : parrello 1.14
1055 :     =back
1056 :    
1057 :     =cut
1058 :    
1059 :     sub PickGeneBoundaries {
1060 :     # Get the parameters.
1061 : parrello 1.19 my ($self, %parms) = @_;
1062 : parrello 1.14 # Declare the return variable.
1063 :     my $retVal;
1064 : parrello 1.19 # Get the stop pattern.
1065 :     my $stopPattern = $parms{-stop} || lc join("|", grep { $self->{code}->{$_} eq '*' } keys %{$self->{code}});
1066 :     # Get the start pattern.
1067 :     my $startPattern = $parms{-start} || 'atg|gtg|ttg';
1068 :     # Compute the limits. We have an upstream limit and a downstream limit.
1069 :     my $limit = $parms{-limit};
1070 : parrello 1.18 my ($upLimit, $downLimit);
1071 :     if (! defined $limit) {
1072 :     $upLimit = 9000;
1073 :     $downLimit = 9000;
1074 :     } elsif ($limit =~ /^\d+$/) {
1075 :     $upLimit = $limit;
1076 :     $downLimit = $limit;
1077 :     } else {
1078 :     my $limitLoc = (! ref $limit ? new BasicLocation($limit) : $limit);
1079 :     $upLimit = abs($limitLoc->Begin - $self->Begin);
1080 :     $downLimit = abs($limitLoc->EndPoint - $self->EndPoint);
1081 :     }
1082 : parrello 1.21 # Insure the limits are on codon boundaries.
1083 :     $upLimit -= $upLimit % 3;
1084 :     $downLimit -= $downLimit % 3;
1085 : parrello 1.20 # Save the current boundaries.
1086 :     my $oldBegin = $self->Begin;
1087 :     my $oldEnd = $self->EndPoint;
1088 : parrello 1.21 # Get the contig boundaries.
1089 :     my $contigBegin = $self->ExtremeCodon('first');
1090 :     my $contigEnd = $self->ExtremeCodon('last');
1091 :     # Get the distance to each extreme.
1092 :     my $upExtreme = abs($contigBegin - $oldBegin);
1093 :     my $downExtreme = abs($contigEnd - $oldEnd);
1094 :     Trace("Up: limit = $upLimit, extreme = $upExtreme. Down: limit = $downLimit, extreme = $downExtreme.") if T(4);
1095 : parrello 1.14 # Search upstream for a stop.
1096 : parrello 1.18 my $upLoc = $self->UpstreamSearch($stopPattern, $upLimit);
1097 : parrello 1.15 # Check to see if we found one.
1098 :     my $newBegin;
1099 : parrello 1.21 if (defined $upLoc) {
1100 :     # Here we found a stop, so the new beginning is after the codon found.
1101 :     my $newOrfBegin = $upLoc->PointOffset(3);
1102 :     $self->Extend($newOrfBegin);
1103 : parrello 1.18 # Now look for a start between the stop codon found and the end of the location.
1104 :     my $startLoc = $self->InsideSearch($startPattern);
1105 : parrello 1.21 if (! defined $startLoc) {
1106 : parrello 1.19 Trace("New start not found for " . $self->SeedString() . ".") if T(3);
1107 :     } else {
1108 : parrello 1.21 # We found the start, so it becomes our new beginning.
1109 :     $newBegin = $startLoc->Begin;
1110 :     }
1111 :     } elsif ($upExtreme <= $upLimit) {
1112 :     # Here we fell off the end of the contig while searching, so this is ok.
1113 :     Trace("Contig beginning used for stop codon after upstream search.") if T(3);
1114 :     $newBegin = $contigBegin;
1115 :     } else {
1116 :     Trace("Upstream stop not found for " . $self->SeedString() . ".") if T(3);
1117 :     }
1118 :     # Only proceed if we have a new beginning.
1119 :     if (defined $newBegin) {
1120 :     # Search downstream for a stop codon.
1121 :     my $stopLoc = $self->DownstreamSearch($stopPattern, $downLimit);
1122 :     # Check the result.
1123 :     my $endPoint;
1124 :     if (defined $stopLoc) {
1125 :     # Here we found the end point.
1126 :     $endPoint = $stopLoc->EndPoint;
1127 :     } elsif ($downLimit >= $downExtreme) {
1128 :     # Here we fell off the end, so we use the end.
1129 :     $endPoint = $contigEnd;
1130 :     Trace("Contig end used for stop codon after downstream search.") if T(3);
1131 :     } else {
1132 :     Trace("Downsream stop not found for " . $self->SeedString() . ".") if T(3);
1133 :     }
1134 :     if (defined $endPoint) {
1135 :     # Extend the location to the start and stop found. This will almost certainly
1136 :     # require trimming in the start-codon direction.
1137 :     $self->Extend($newBegin, $endPoint, 'trim');
1138 :     # Denote we've succeeded.
1139 :     $retVal = 1;
1140 : parrello 1.18 }
1141 : parrello 1.14 }
1142 : parrello 1.20 # If we failed, restore the location.
1143 :     if (! $retVal) {
1144 :     $self->Extend($oldBegin, $oldEnd, 'trim');
1145 :     }
1146 : parrello 1.14 # Return the success indicator.
1147 :     return $retVal;
1148 :     }
1149 :    
1150 : parrello 1.9
1151 : parrello 1.1 =head2 Internal Methods
1152 :    
1153 :     =head3 ParseLocations
1154 :    
1155 :     Parse an array into a list of basic location objects. The array can contain
1156 :     basic location objects or location strings. The first parameter must be the
1157 :     full location object being constructed.
1158 :    
1159 :     This is a static method.
1160 :    
1161 :     =cut
1162 :    
1163 :     sub _ParseLocations {
1164 :     # Get the location list.
1165 :     my ($parent, @locs) = @_;
1166 :     # Create the return array.
1167 :     my @retVal = ();
1168 :     # Create a location index counter.
1169 :     my $idx = 0;
1170 :     # Loop through the locations.
1171 :     for my $loc (@locs) {
1172 :     # Create a variable to hold the location object created.
1173 :     my $locObject;
1174 :     # Check to see if this is a string or a location object.
1175 :     if (ref $loc eq '') {
1176 :     # It's a string, so parse it into a location object.
1177 :     $locObject = BasicLocation->new($loc, $parent, $idx);
1178 :     } elsif (UNIVERSAL::isa($loc, "BasicLocation")) {
1179 :     # It's a location object, so copy it and set the parent and
1180 :     # index.
1181 :     $locObject = BasicLocation->new($loc);
1182 :     $locObject->Attach($parent, $idx);
1183 :     } else {
1184 :     # Here we have an error.
1185 :     my $type = ref $loc;
1186 :     Confess("Invalid location object of type $type found at index $idx.");
1187 :     }
1188 :     # Add the location to the list.
1189 :     push @retVal, $locObject;
1190 :     $idx++;
1191 :     }
1192 :     # Return a reference to the location list.
1193 :     return \@retVal;
1194 :     }
1195 :    
1196 :     =head3 FindPattern
1197 :    
1198 :     Locate the index of a specified pattern in a DNA string.
1199 :    
1200 :     This is a static method.
1201 :    
1202 :     =over 4
1203 :    
1204 :     =item dna
1205 :    
1206 :     DNA string to search.
1207 :    
1208 :     =item pattern
1209 :    
1210 : parrello 1.2 Pattern for which to search (see L</Search>).
1211 : parrello 1.1
1212 :     =item RETURN
1213 :    
1214 :     Returns the index of the specified pattern, or C<undef> if the pattern is not found.
1215 :    
1216 :     =back
1217 :    
1218 :     =cut
1219 :     #: Return Type $;
1220 :     sub _FindPattern {
1221 :     # Get the parameters.
1222 : parrello 1.2 my ($dna, $pattern) = @_;
1223 : parrello 1.1 # Declare the return variable.
1224 :     my $retVal;
1225 :     # Insure the pattern is lower case.
1226 :     my $realPattern = lc $pattern;
1227 : parrello 1.9 # Start at the beginning of the string. We will chop stuff off the string
1228 :     # as we search through it. This smount chopped must then be added to the offset
1229 :     # of the found string in order to get the return value.
1230 :     my $pos = 0;
1231 :     # Do the search. We search for stop codons, and stop at the first one
1232 :     # that lies on a codon boundary.
1233 :     while (!defined($retVal) && $dna =~ m/$realPattern/g) {
1234 :     # We have a match. Get its location. Note that the "pos" function returns
1235 :     # the point where the search left off, so we have to back off a bit to
1236 :     # get the starting point of the codon.
1237 :     my $newPos = (pos $dna) - 3;
1238 :     # See if this is on a codon boundary.
1239 :     my $mod = $newPos % 3;
1240 :     if ($mod == 0) {
1241 :     # It is, so return the offset from the original start of the string.
1242 :     $retVal = $pos + $newPos;
1243 :     } else {
1244 :     # Here we need to keep searching. First, however, we move the search
1245 :     # position forward to the next codon boundary. This avoids useless checking
1246 :     # of the next byte or two and insures that we don't find the same value
1247 :     # again.
1248 :     $newPos += 3 - $mod;
1249 :     $pos += $newPos;
1250 :     $dna = substr($dna, $newPos);
1251 :     }
1252 :     }
1253 :     # Return the result.
1254 :     return $retVal;
1255 :     }
1256 :    
1257 : parrello 1.1
1258 :     1;
1259 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3