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

Annotation of /FigKernelPackages/BasicLocation.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.5 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : parrello 1.1 package BasicLocation;
19 :    
20 :     use strict;
21 :     use Tracer;
22 :    
23 :     =head1 Basic Location Object
24 :    
25 :     =head2 Introduction
26 :    
27 :     A I<basic location> defines a region of a contig. Because of the way genetic features
28 :     work, a basic location has a direction associated with it. The traditional method for encoding
29 :     a basic location is to specify the contig ID, the starting offset, and the ending offset. If the
30 :     start is before the end, we have a forward basic location, and if the start is after the end, we
31 :     have a backward basic location.
32 :    
33 :     =over 4
34 :    
35 :     =item C<RED_1_400>
36 :    
37 :     is the first 400 nucleotides of the RED contig, processed forward.
38 :    
39 :     =item C<NC_000913_500_401>
40 :    
41 :     is a 100-nucleotide region in NC_000913 that is processed backward from the 500th nucleotide.
42 :    
43 :     =back
44 :    
45 :     Note that even though they are called "offsets", location indices are 1-based.
46 :     Note also that the possibility of an underscore in the contig ID makes the parsing a little
47 :     tricky.
48 :    
49 :     The Sprout uses a slightly different format designed to allow for the possibility of
50 :     zero-length regions. Instead of a starting and ending position, we specify the start position,
51 :     the direction (C<+> or C<->), and the length. The Sprout versions of the two example locations
52 :     above are
53 :    
54 :     =over 4
55 :    
56 :     =item C<RED_1+400>
57 :    
58 :     corresponds to C<RED_1_400>
59 :    
60 :     =item C<NC_000913_500-100>
61 :    
62 :     corresponds to C<NC_000913_500_401>
63 :    
64 :     =back
65 :    
66 :     Working with the raw location string is difficult because it can have one of two formats
67 :     and it is constantly necessary to ask if the location is forward or backward. The basic location
68 :     object seeks to resolve these differences by providing a single interface that can be
69 :     used regardless of the format or direction.
70 :    
71 :     It is frequently useful to keep additional data about a basic location while it is being passed
72 :     around. The basic location object is a PERL hash, and this additional data is kept in the object
73 :     by adding hash keys. The internal values used by the object have keys preceded by an
74 :     underscore, so any keys not beginning with underscores are considered to be additional
75 :     values. The additional values are called I<augments>.
76 :    
77 :     When a basic location is in its string form, the augments can be tacked on using parentheses
78 :     enclosing a comma-delimited list of assignments. For example, say we want to describe
79 :     the first 400 base pairs in the contig B<RED>, and include the fact that it is the second
80 :     segment of feature B<fig|12345.1.peg.2>. We could use the key C<fid> for the feature ID and
81 :     C<idx> for the segment index (0-based), in which case the location string would be
82 :    
83 :     RED_1+400(fid=fig|12345.1.peg.2,idx=1)
84 :    
85 :     When this location string is converted to a location object in the variable C<$loc>, we
86 :     would have
87 :    
88 :     $loc->{fig} eq 'fig|12345.1.peg.2'
89 :     $loc->{idx} == 1
90 :    
91 :     Spaces can be added for readability. The above augmented location string can also be
92 :     coded as
93 :    
94 :     RED_1+400(fid = fig|12345.1.peg.2, idx = 1)
95 :    
96 :     A basic location is frequently part of a full location. Full locations are described by the
97 :     B<FullLocation> object. A full location is a list of basic locations associated with a genome
98 :     and a FIG-like object. If the parent full location is known, we can access the basic location's
99 :     raw DNA. To construct a basic location that is part of a full location, we add the parent full
100 :     location and the basic location's index to the constructor. In the constructor below,
101 :     C<$parent> points to the parent full location.
102 :    
103 :     my $secondLocation = BasicLocation->new("RED_450+100", $parent, 1);
104 :    
105 :     =cut
106 :    
107 :     #: Constructor BasicLocation->new('NC_000913_499_400');
108 :    
109 :     =head2 Public Methods
110 :    
111 :     =head3 new
112 :    
113 :     C<< my $loc = BasicLocation->new($locString, $parentLocation, $idx); >>
114 :    
115 :     Construct a basic location from a location string. A location string has the form
116 :     I<contigID>C<_>I<begin>I<dir>I<len> where I<begin> is the starting position,
117 :     I<dir> is C<+> for a forward transcription or C<-> for a backward transcription,
118 :     and I<len> is the length. So, for example, C<1999.1_NC123_4000+200> describes a
119 :     location beginning at position 4000 of contig C<1999.1_NC123> and ending at
120 :     position 4199. Similarly, C<1999.1_NC123_2000-400> describes a location in the
121 :     same contig starting at position 2000 and ending at position 1601.
122 :    
123 :     Augments can be specified as part of the location string using parentheses and
124 :     a comma-delimited list of assignments. For example, the following constructor
125 :     creates a location augmented by a feature ID called C<fid> and an index value
126 :     called C<idx>.
127 :    
128 :     my $loc = BasicLocation->new("NC_000913_499_400(fid = fig|83333.1.peg.10, idx => 2)");
129 :    
130 :     All fields internal to the location object have names beginning with an
131 :     underscore (C<_>), so as long as the value name begins with a letter,
132 :     there should be no conflict.
133 :    
134 :     =over 4
135 :    
136 :     =item locString
137 :    
138 :     Location string, as described above.
139 :    
140 :     =item parentLocation (optional)
141 :    
142 :     Full location that this basic location is part of (if any).
143 :    
144 :     =item idx (optional)
145 :    
146 :     Index of this basic location in the parent full location.
147 :    
148 :     =back
149 :    
150 :     C<< my $loc = BasicLocation->new($location, $contigID); >>
151 :    
152 :     Construct a location by copying another location and plugging in a new contig ID.
153 :    
154 :     =over 4
155 :    
156 :     =item location
157 :    
158 :     Location whose data is to be copied.
159 :    
160 :     =item contigID (optional)
161 :    
162 :     ID of the new contig to be plugged in.
163 :    
164 :     =back
165 :    
166 :     C<< my $loc = BasicLocation->new($contigID, $beg, $dir, $len, $augments, $parentLocation, $idx); >>
167 :    
168 :     Construct a location from specific data elements, in particular the contig ID, the starting
169 :     offset, the direction, and the length.
170 :    
171 :     =over 4
172 :    
173 :     =item contigID
174 :    
175 :     ID of the contig on which the location occurs.
176 :    
177 :     =item beg
178 :    
179 :     Starting offset of the location.
180 :    
181 :     =item dir
182 :    
183 :     Direction of the location: C<+> for a forward location and C<-> for a backward location. If
184 :     C<_> is specified instead, it will be presumed that the fourth argument is an endpoint and not
185 :     a length.
186 :    
187 :     =item len
188 :    
189 :     Length of the location. If the direction is an underscore (C<_>), it will be the endpoint
190 :     instead of the length.
191 :    
192 :     =item augments (optional)
193 :    
194 :     Reference to a hash containing any augment values for the location.
195 :    
196 :     =item parentLocation (optional)
197 :    
198 :     Full location that this basic location is part of (if any).
199 :    
200 :     =item idx (optional)
201 :    
202 :     Index of this basic location in the parent full location.
203 :    
204 :     =back
205 :    
206 :     =cut
207 :    
208 :     sub new {
209 :     # Get the parameters.
210 :     my ($class, @p) = @_;
211 :     # Declare the data variables.
212 :     my ($contigID, $beg, $dir, $len, $end, $parent, $idx, $augments, $augmentString);
213 :     # Determine the signature type.
214 :     if (@p >= 4) {
215 :     # Here we have specific incoming data.
216 :     ($contigID, $beg, $dir, $len, $augments, $parent, $idx) = @p;
217 :     } elsif (UNIVERSAL::isa($p[0],__PACKAGE__)) {
218 :     # Here we have a source location and possibly a new contig ID.
219 :     $contigID = (defined $p[1] ? $p[1] : $p[0]->{_contigID});
220 :     ($beg, $dir, $len) = ($p[0]->{_beg}, $p[0]->{_dir}, $p[0]->{_len});
221 :     if (exists $p[0]->{_parent}) {
222 :     ($parent, $idx) = ($p[0]->{_parent}, $p[0]->{_idx});
223 :     }
224 :     # Get the augments (if any) from the source location. We want these
225 :     # copied to the new location.
226 :     $augments = { };
227 :     for my $key (keys %{$p[0]}) {
228 :     if (substr($key, 0, 1) ne '_') {
229 :     $augments->{$key} = $p[0]->{$key};
230 :     }
231 :     }
232 :     } else {
233 :     # Here we have a source string and possibly augments. We first parse
234 :     # the source string.
235 :     $p[0] =~ /^(.+)_(\d+)(\+|\-|_)(\d+)($|\(.*\)$)/;
236 :     ($contigID, $beg, $dir, $len, $augmentString) = ($1, $2, $3, $4, $5);
237 :     # Check for augments.
238 :     if ($augmentString) {
239 :     # Here we have an augment string. First, we strip the enclosing
240 :     # parentheses.
241 :     $augmentString = substr $augmentString, 1, length($augmentString) - 2;
242 :     # Now we parse out the assignments and put them in a hash.
243 :     my %augmentHash = map { split /\s*,\s*/, $_ } split /\s*=\s*/, $augmentString;
244 :     $augments = \%augmentHash;
245 :     }
246 :     # Pull in the parent location and index, if applicable.
247 :     ($parent, $idx) = ($p[1], $p[2]);
248 :     }
249 :     # Determine the format.
250 :     if ($dir eq '_') {
251 :     # Here we have the old format. The endpoint was parsed as the length.
252 :     $end = $len;
253 :     # Compare the start and end to get the direction and compute the true length.
254 :     if ($beg > $end) {
255 :     ($dir, $len) = ('-', $beg - $end + 1);
256 :     } else {
257 :     ($dir, $len) = ('+', $end - $beg + 1);
258 :     }
259 :     } else {
260 :     # Here we have the new format. We compute the endpoint
261 :     # from the direction.
262 :     $end = (($dir eq '+') ? $beg + $len - 1 : $beg - $len + 1);
263 :     }
264 :     # Create the return structure.
265 :     my $retVal = { _contigID => $contigID, _beg => $beg, _dir => $dir,
266 :     _end => $end, _len => $len, _parent => $parent,
267 :     _idx => $idx };
268 :     # Add the augments.
269 :     if ($augments) {
270 :     for my $key (keys %{$augments}) {
271 :     $retVal->{$key} = $augments->{$key};
272 :     }
273 :     }
274 :     # Bless the location with the appropriate package name.
275 :     if ($dir eq '+') {
276 :     bless $retVal, "FBasicLocation";
277 :     } else {
278 :     bless $retVal, "BBasicLocation";
279 :     }
280 :     # Return the blessed object.
281 :     return $retVal;
282 :     }
283 :    
284 :     =head3 Contig
285 :    
286 :     C<< my $contigID = $loc->Contig; >>
287 :    
288 :     Return the location's contig ID.
289 :    
290 :     =cut
291 :     #: Return Type $;
292 :     sub Contig {
293 :     return $_[0]->{_contigID};
294 :     }
295 :    
296 :     =head3 Begin
297 :    
298 :     C<< my $beg = $loc->Begin; >>
299 :    
300 :     Return the location's starting offset.
301 :    
302 :     =cut
303 :     #: Return Type $;
304 :     sub Begin {
305 :     return $_[0]->{_beg};
306 :     }
307 :    
308 :     =head3 Dir
309 :    
310 :     C<< my $dirChar = $loc->Dir; >>
311 :    
312 :     Return the location's direction: C<+> for a forward location and C<-> for a backward one.
313 :    
314 :     =cut
315 :     #: Return Type $;
316 :     sub Dir {
317 :     return $_[0]->{_dir};
318 :     }
319 :    
320 :     =head3 Length
321 :    
322 :     C<< my $len = $loc->Length; >>
323 :    
324 :     Return the location's length (in nucleotides).
325 :    
326 :     =cut
327 :     #: Return Type $;
328 :     sub Length {
329 :     return $_[0]->{_len};
330 :     }
331 :    
332 :     =head3 EndPoint
333 :    
334 :     C<< my $offset = $loc->EndPoint; >>
335 :    
336 :     Return the location's ending offset.
337 :    
338 :     =cut
339 :     #: Return Type $;
340 :     sub EndPoint {
341 :     return $_[0]->{_end};
342 :     }
343 :    
344 :     =head3 Parent
345 :    
346 :     C<< my $parentLocation = $loc->Parent; >>
347 :    
348 :     Return the full location containing this basic location (if any).
349 :    
350 :     =cut
351 :     #: Return Type %;
352 :     sub Parent {
353 :     return $_[0]->{_parent};
354 :     }
355 :    
356 :     =head3 Index
357 :    
358 :     C<< my $idx = $loc->Index; >>
359 :    
360 :     Return the index of this basic location inside the parent location (if any).
361 :    
362 :     =cut
363 :     #: Return Type $;
364 :     sub Index {
365 :     return $_[0]->{_idx};
366 :     }
367 :    
368 :     =head3 String
369 :    
370 :     C<< my $string = $loc->String; >>
371 :    
372 :     Return a Sprout-format string representation of this location.
373 :    
374 :     =cut
375 :     #: Return Type $;
376 :     sub String {
377 :     my ($self) = @_;
378 :     return $self->{_contigID} . "_" . $self->{_beg} . $self->{_dir} . $self->{_len};
379 :     }
380 :    
381 :     =head3 SeedString
382 :    
383 :     C<< my $string = $loc->SeedString; >>
384 :    
385 :     Return a SEED-format string representation of this location.
386 :    
387 :     =cut
388 :     #: Return Type $;
389 :     sub SeedString {
390 :     my ($self) = @_;
391 :     return $self->{_contigID} . "_" . $self->{_beg} . "_" . $self->{_end};
392 :     }
393 :    
394 :     =head3 AugmentString
395 :    
396 :     C<< my $string = $loc->AugmentString; >>
397 :    
398 :     Return a Sprout-format string representation of this location with augment data
399 :     included. The augment data will be appended as a comma-delimited list of assignments
400 :     enclosed in parentheses, the exact format expected by the single-argument location object
401 :     constructor L</new>.
402 :    
403 :     =cut
404 :     #: Return Type $;
405 :     sub AugmentString {
406 :     # Get this instance.
407 :     my ($self) = @_;
408 :     # Get the pure location string.
409 :     my $retVal = $self->String;
410 :     # Create the augment string. We build it from all the key-value pairs in the hash
411 :     # for which the key does not being with an underscore.
412 :     my @augmentStrings = ();
413 :     for my $key (sort keys %{$self}) {
414 :     if (substr($key,0,1) ne "_") {
415 :     push @augmentStrings, "$key = " . $self->{$key};
416 :     }
417 :     }
418 :     # If any augments were found, we concatenate them to the result string.
419 :     if (@augmentStrings > 0) {
420 :     $retVal .= "(" . join(", ", @augmentStrings) . ")";
421 :     }
422 :     # Return the result.
423 :     return $retVal;
424 :     }
425 :    
426 :     =head3 IfValid
427 :    
428 :     C<< my $distance = IfValid($distance); >>
429 :    
430 :     Return a distance if it is a valid offset inside this location, and an undefined value otherwise.
431 :    
432 :     =over 4
433 :    
434 :     =item distance
435 :    
436 :     Relevant distance inside this location.
437 :    
438 :     =item RETURN
439 :    
440 :     Returns the incoming distance if it is non-negative and less than the location length, and an
441 :     undefined value otherwise.
442 :    
443 :     =back
444 :    
445 :     =cut
446 :     #: Return Type $;
447 :     sub IfValid {
448 :     # Get the parameters.
449 :     my ($self, $distance) = @_;
450 :     # Return the appropriate result.
451 :     return (($distance >= 0 && $distance < $self->{_len}) ? $distance : undef);
452 :     }
453 :    
454 :     =head3 Cmp
455 :    
456 :     C<< my $compare = BasicLocation::Cmp($a, $b); >>
457 :    
458 :     Compare two locations.
459 :    
460 :     The ordering principle for locations is that they are sorted first by contig ID, then by
461 :     leftmost position, in reverse order by length, and then by direction. The effect is that
462 :     within a contig, the locations are ordered first and foremost in the way they would
463 :     appear when displayed in a picture of the contig and second in such a way that embedded
464 :     locations come after the locations in which they are embedded. In the case of two
465 : parrello 1.3 locations that represent the exact same base pairs, the forward (C<+>) location is
466 :     arbitrarily placed first.
467 : parrello 1.1
468 :     =over 4
469 :    
470 :     =item a
471 :    
472 :     First location to compare.
473 :    
474 :     =item b
475 :    
476 :     Second location to compare.
477 :    
478 :     =item RETURN
479 :    
480 :     Returns a negative number if the B<a> location sorts first, a positive number if the
481 :     B<b> location sorts first, and zero if the two locations are the same.
482 :    
483 :     =back
484 :    
485 :     =cut
486 :     #: Return Type $;
487 :     sub Cmp {
488 :     # Get the parameters.
489 :     my ($a, $b) = @_;
490 :     # Compare the locations.
491 :     my $retVal = ($a->Contig cmp $b->Contig);
492 :     if ($retVal == 0) {
493 :     $retVal = ($a->Left <=> $b->Left);
494 :     if ($retVal == 0) {
495 :     $retVal = ($b->Length <=> $a->Length);
496 :     if ($retVal == 0) {
497 :     $retVal = ($a->Begin <=> $b->Begin);
498 :     }
499 :     }
500 :     }
501 :     # Return the result.
502 :     return $retVal;
503 :     }
504 :    
505 :     =head3 Matches
506 :    
507 :     C<< my $flag = BasicLocation::Matches($locA, $locB); >>
508 :    
509 :     Return TRUE if the two locations contain the same data, else FALSE. Augment data is included
510 :     in the comparison.
511 :    
512 :     =over 4
513 :    
514 :     =item locA, locB
515 :    
516 :     Locations to compare.
517 :    
518 :     =item RETURN
519 :    
520 :     Returns TRUE if the two locations contain the same data, else FALSE.
521 :    
522 :     =back
523 :    
524 :     =cut
525 :     #: Return Type $;
526 :     sub Matches {
527 :     # Get the parameters.
528 :     my ($locA, $locB) = @_;
529 :     # Declare the return variable.
530 :     my $retVal = 0;
531 :     # Verify that the major data items are the same.
532 :     if ($locA->Contig eq $locB->Contig && $locA->Begin eq $locB->Begin &&
533 :     $locA->Dir eq $locB->Dir && $locA->Length == $locB->Length) {
534 :     # Here the locations are the same, so we need to check augment data.
535 :     # First, we loop through all the augment keys in the A location.
536 :     my @aKeys = grep { /^[^_]/ } keys %{$locA};
537 :     # Assume we have a match until we find a mis-match.
538 :     $retVal = 1;
539 :     for (my $i = 0; $i <= $#aKeys && $retVal; $i++) {
540 :     my $aKey = $aKeys[$i];
541 :     $retVal = ((exists $locB->{$aKey}) && ($locA->{$aKey} eq $locB->{$aKey}));
542 :     }
543 :     # If we're still matching, verify that B doesn't have any
544 :     # keys not in A.
545 :     my @bKeys = keys %{$locB};
546 :     for (my $i = 0; $i <= $#bKeys && $retVal; $i++) {
547 :     $retVal = exists $locA->{$bKeys[$i]};
548 :     }
549 :     }
550 :     # Return the result.
551 :     return $retVal;
552 :     }
553 :    
554 :     =head3 Attach
555 :    
556 :     C<< my = $loc->Attach($parent, $idx); >>
557 :    
558 :     Point this basic location to a parent full location. The basic location will B<not> be
559 :     inserted into the full location's data structures.
560 :    
561 :     =over 4
562 :    
563 :     =item parent
564 :    
565 :     Parent full location to which this location should be attached.
566 :    
567 :     =item idx
568 :    
569 :     Index of this location in the full location.
570 :    
571 :     =back
572 :    
573 :     =cut
574 :     #: Return Type ;
575 :     sub Attach {
576 :     # Get the parameters.
577 :     my ($self, $parent, $idx) = @_;
578 :     # Save the parent location and index in our data structures.
579 :     $self->{_idx} = $idx;
580 :     $self->{_parent} = $parent;
581 :     }
582 :    
583 : parrello 1.7 =head3 FixContig
584 :    
585 :     C<< $loc->FixContig($genomeID); >>
586 :    
587 :     Insure the genome ID is included in the Contig string. Some portions of the system
588 :     store the contig ID in the form I<genome>C<:>I<contig>, while some use only the contig ID.
589 :     If this location's contig ID includes a genome ID, nothing will happen, but if it does
590 :     note, the caller-specified genome ID will be prefixed to the contig string.
591 :    
592 :     =over 4
593 :    
594 :     =item genomeID
595 :    
596 :     ID of the genome for this location's contig.
597 :    
598 :     =back
599 :    
600 :     =cut
601 :     #: Return Type ;
602 :     sub FixContig {
603 :     # Get the parameters.
604 :     my ($self, $genomeID) = @_;
605 :     # Check the contig string for the presence of a genome ID.
606 :     my $contigID = $self->{_contigID};
607 :     if ($contigID !~ /:/) {
608 :     # There's no colon, so we have to prefix the genome ID.
609 :     $self->{_contigID} = "$genomeID:$contigID";
610 :     }
611 :     }
612 :    
613 : parrello 1.8 =head3 Parse
614 :    
615 :     C<< my ($contig, $beg, $end) = BasicLocation::Parse($locString); >>
616 :    
617 :     Parse a location string and return the contig ID, start position, and end position.
618 :    
619 :     =over 4
620 :    
621 :     =item locString
622 :    
623 :     Location string to parse. It may be either Sprout-style or SEED-style.
624 :    
625 :     =item RETURN
626 :    
627 :     Returns the contig ID, start position, and end position as a three-element list.
628 :    
629 :     =back
630 :    
631 :     =cut
632 :     #: Return Type @;
633 :     sub Parse {
634 :     # Get the parameters.
635 :     my ($locString) = @_;
636 :     # Create a location object from the string.
637 :     my $loc = BasicLocation->new($locString);
638 :     # Return the desired data.
639 :     return ($loc->Contig, $loc->Begin, $loc->EndPoint);
640 :     }
641 :    
642 : parrello 1.9 =head3 Overlap
643 :    
644 :     C<< my $len = $loc->Overlap($b,$e); >>
645 :    
646 :     Determine how many positions in this location overlap the specified region. The region is defined
647 :     by its leftmost and rightmost positions.
648 :    
649 :     =over 4
650 :    
651 :     =item b
652 :    
653 :     Leftmost position in the region to check.
654 :    
655 :     =item e
656 :    
657 :     Rightmost position in the region to check.
658 :    
659 :     =item RETURN
660 :    
661 :     Returns the number of overlapping positions, or 0 if there is no overlap.
662 :    
663 :     =back
664 :    
665 :     =cut
666 :     #: Return Type $%;
667 :     sub Overlap {
668 :     # Get the parameters.
669 :     my ($self, $b, $e) = @_;
670 :     # Declare the return variable.
671 :     my $retVal;
672 :     # Process according to the type of overlap.
673 :     if ($b < $self->Left) {
674 :     # Here the other region extends to our left.
675 :     if ($e >= $self->Left) {
676 :     # The other region's right is past our left, so we have overlap. The overlap length
677 :     # is determined by whether or not we are wholly inside the region.
678 :     if ($e < $self->Right) {
679 :     $retVal = $e - $self->Left + 1;
680 :     } else {
681 :     $retVal = $self->Length;
682 :     }
683 :     } else {
684 :     # The other region ends before we start, so no overlap.
685 :     $retVal = 0;
686 :     }
687 :     } elsif ($b > $self->Right) {
688 :     # The other region starts after we end, so no overlap.
689 :     $retVal = 0;
690 :     } else {
691 :     # The other region starts inside us.
692 :     $retVal = $self->Right - $b + 1;
693 :     }
694 :     # Return the result.
695 :     return $retVal;
696 :     }
697 :    
698 : parrello 1.1 =head2 Virtual Methods
699 :    
700 :     These methods are implemented by the subclasses. They are included here for documentation
701 :     purposes.
702 :    
703 :     =head3 Left
704 :    
705 :     C<< my $leftPoint = $loc->Left; >>
706 :    
707 :     Return the offset of the leftmost point of the location.
708 :    
709 :     =cut
710 :     #: Return Type $;
711 :    
712 :     =head3 Right
713 :    
714 :     C<< my $rightPoint = $loc->Right; >>
715 :    
716 :     Return the offset of the rightmost point of the location.
717 :    
718 :     =cut
719 :     #: Return Type $;
720 :    
721 :     =head3 Compare
722 :    
723 :     C<< my ($distance, $cmp) = $loc->Compare($point); >>
724 :    
725 :     Determine the relative location of the specified point on the contig. Returns a distance,
726 :     which indicates the location relative to the leftmost point of the contig, and a comparison
727 :     number, which is negative if the point is to the left of the location, zero if the point is
728 :     inside the location, and positive if the point is to the right of the location.
729 :    
730 :     =cut
731 :     #: Return Type @;
732 :    
733 :     =head3 Split
734 :    
735 :     C<< my $newLocation = $loc->Split($offset); >>
736 :    
737 :     Split this location into two smaller ones at the specified offset from the left endpoint. The
738 :     new location split off of it will be returned.
739 :    
740 :     =over 4
741 :    
742 :     =item offset
743 :    
744 :     Offset into the location from the left endpoint of the point at which it should be split.
745 :    
746 :     =item RETURN
747 :    
748 :     The new location split off of this one.
749 :    
750 :     =back
751 :    
752 :     =cut
753 :     #: Return Type $%;
754 :    
755 :     =head3 Reverse
756 :    
757 :     C<< $loc->Reverse; >>
758 :    
759 :     Change the polarity of the location. The location will have the same nucleotide range, but
760 :     the direction will be changed.
761 :    
762 :     =cut
763 :     #: Return Type ;
764 :    
765 :     =head3 Index
766 :    
767 :     C<< my $index = $loc->Index($point); >>
768 :    
769 :     Return the index of the specified point in this location. The value returned is the distance
770 :     from the beginning. If the specified point is not in the location, an undefined value is returned.
771 :    
772 :     =over 4
773 :    
774 :     =item point
775 :    
776 :     Offset into the contig of the point in question.
777 :    
778 :     =item RETURN
779 :    
780 :     Returns the distance of the point from the beginning of the location, or an undefined value if the
781 :     point is outside the location.
782 :    
783 :     =back
784 :    
785 :     =cut
786 :     #: Return Type $;
787 :    
788 :     =head3 PointOffset
789 :    
790 :     C<< my $offset = $loc->PointOffset($index); >>
791 :    
792 :     Return the offset into the contig of the point at the specified position in the location. A position
793 :     of 0 will return the beginning point, a position of 1 returns the point next to that, and a position
794 :     1 less than the length will return the ending point.
795 :    
796 :     =over 4
797 :    
798 :     =item index
799 :    
800 :     Index into the location of the relevant point.
801 :    
802 :     =item RETURN
803 :    
804 :     Returns an offset into the contig of the specified point in the location.
805 :    
806 :     =back
807 :    
808 :     =cut
809 :     #: Return Type $;
810 :    
811 :     =head3 Peel
812 :    
813 :     C<< my $peel = $loc->Peel($length); >>
814 :    
815 :     Peel a specified number of positions off the beginning of the location. Peeling splits
816 :     a location at a specified offset from the beginning, while splitting takes it at a
817 :     specified offset from the left point. If the specified length is equal to or longer
818 :     than the location's length, an undefined value will be returned.
819 :    
820 :     =over 4
821 :    
822 :     =item length
823 :    
824 :     Number of positions to split from the location.
825 :    
826 :     =item RETURN
827 :    
828 :     Returns a new location formed by splitting positions off of the existing location, which is
829 :     shortened accordingly. If the specified length is longer than the location's length, an
830 :     undefined value is returned and the location is not modified.
831 :    
832 :     =back
833 :    
834 :     =cut
835 :     #: Return Type $%;
836 :    
837 : parrello 1.2
838 :     =head3 SetBegin
839 :    
840 :     C<< $loc->SetBegin($newBegin); >>
841 :    
842 :     Change the begin point of this location without changing the endpoint.
843 :    
844 :     =over 4
845 :    
846 :     =item newBegin
847 :    
848 :     Proposed new beginning point.
849 :    
850 :     =back
851 :    
852 :     =cut
853 :     #: Return Type ;
854 :    
855 :     =head3 SetEnd
856 :    
857 :     C<< $loc->SetEnd($newEnd); >>
858 :    
859 :     Change the endpoint of this location without changing the begin point.
860 :    
861 :     =over 4
862 :    
863 :     =item newEnd
864 :    
865 :     Proposed new ending point.
866 :    
867 :     =back
868 :    
869 :     =cut
870 :     #: Return Type ;
871 :    
872 : parrello 1.6 =head3 Widen
873 :    
874 :     C<< my = $loc->Widen($distance, $max); >>
875 :    
876 :     Add the specified distance to each end of the location, taking care not to
877 :     extend past either end of the contig. The contig length must be provided
878 :     to insure we don't fall off the far end; otherwise, only the leftward
879 :     expansion is limited.
880 :    
881 :     =over 4
882 :    
883 :     =item distance
884 :    
885 :     Number of positions to add to both ends of the location.
886 :    
887 :     =item max (optional)
888 :    
889 :     Maximum possible value for the right end of the location.
890 :    
891 :     =back
892 :    
893 :     =cut
894 :     #: Return Type ;
895 :    
896 : parrello 1.9 =head3 Upstream
897 :    
898 :     C<< my $newLoc = $loc->Upstream($distance, $max); >>
899 :    
900 :     Return a new location upstream of the given location, taking care not to
901 :     extend past either end of the contig.
902 :    
903 :     =over 4
904 :    
905 :     =item distance
906 :    
907 :     Number of positions to add to the front (upstream) of the location.
908 :    
909 :     =item max (optional)
910 :    
911 :     Maximum possible value for the right end of the location.
912 :    
913 :     =item RETURN
914 :    
915 :     Returns a new location object whose last position is next to the first
916 :     position of this location.
917 :    
918 :     =back
919 :    
920 :     =cut
921 :     #: Return Type $%;
922 :    
923 :     =head3 Truncate
924 :    
925 :     C<< $loc->Truncate($len); >>
926 :    
927 :     Truncate the location to a new length. If the length is larger than the location length, then
928 :     the location is not changed.
929 :    
930 :     =over 4
931 :    
932 :     =item len
933 :    
934 :     Proposed new length for the location.
935 :    
936 :     =back
937 :    
938 :     =cut
939 :     #: Return Type $%;
940 :    
941 : parrello 1.1 1;
942 :    
943 :    
944 :     package FBasicLocation;
945 :    
946 :     @FBasicLocation::ISA = qw(BasicLocation);
947 :    
948 :     =head1 Forward Basic Location Object
949 :    
950 :     =head2 Introduction
951 :    
952 :     A I<forward location object> is a location in a contig that is transcribed from left to right.
953 :     It is a subclass of the B<BasicLocation> object, and contains methods that require different
954 :     implementation for a forward location than a backward location.
955 :    
956 :     =head2 Override Methods
957 :    
958 :     =head3 Left
959 :    
960 :     C<< my $leftPoint = $loc->Left; >>
961 :    
962 :     Return the offset of the leftmost point of the location.
963 :    
964 :     =cut
965 :    
966 :     sub Left {
967 :     return $_[0]->{_beg};
968 :     }
969 :    
970 :     =head3 Right
971 :    
972 :     C<< my $rightPoint = $loc->Right; >>
973 :    
974 :     Return the offset of the rightmost point of the location.
975 :    
976 :     =cut
977 :    
978 :     sub Right {
979 :     return $_[0]->{_end};
980 :     }
981 :    
982 :     =head3 Compare
983 :    
984 :     C<< my ($distance, $cmp) = $loc->Compare($point); >>
985 :    
986 :     Determine the relative location of the specified point on the contig. Returns a distance,
987 :     which indicates the location relative to the leftmost point of the contig, and a comparison
988 :     number, which is negative if the point is to the left of the location, zero if the point is
989 :     inside the location, and positive if the point is to the right of the location.
990 :    
991 :     =cut
992 :    
993 :     sub Compare {
994 :     # Get the parameters.
995 :     my ($self, $point) = @_;
996 :     # Compute the distance from the begin (leftmost) point.
997 :     my $distance = $point - $self->{_beg};
998 :     # Set the comparison value. The distance works unless it is positive and less than
999 :     # the length. In that case, it's inside the location so we want to return 0.
1000 :     my $cmp = (defined $self->IfValid($distance) ? 0 : $distance);
1001 :     # Return the results.
1002 :     return ($distance, $cmp);
1003 :     }
1004 :    
1005 :     =head3 Split
1006 :    
1007 :     C<< my $newLocation = $loc->Split($offset); >>
1008 :    
1009 :     Split this location into two smaller ones at the specified offset from the left endpoint. The
1010 :     new location split off of it will be returned. If the offset is at either end of the location,
1011 :     no split will occur and an underfined value will be returned.
1012 :    
1013 :     =over 4
1014 :    
1015 :     =item offset
1016 :    
1017 :     Offset into the location from the left endpoint of the point at which it should be split.
1018 :    
1019 :     =item RETURN
1020 :    
1021 :     The new location split off of this one, or an undefined value if no split was necessary.
1022 :    
1023 :     =back
1024 :    
1025 :     =cut
1026 :    
1027 :     sub Split {
1028 :     # Get the parameters.
1029 :     my ($self, $offset) = @_;
1030 :     # Declare the return variable.
1031 :     my $retVal;
1032 :     # Only proceed if a split is necessary.
1033 :     if ($offset > 0 && $offset < $self->{_len}) {
1034 :     # Save the current starting point.
1035 :     my $oldBegin = $self->{_beg};
1036 :     # Update this location's starting point and length.
1037 :     $self->{_beg} += $offset;
1038 :     $self->{_len} -= $offset;
1039 :     # Create the new location.
1040 :     $retVal = BasicLocation->new($self->{_contigID}, $oldBegin, '+', $offset);
1041 :     }
1042 :     # Return the new location object.
1043 :     return $retVal;
1044 :     }
1045 :    
1046 :    
1047 :     =head3 Peel
1048 :    
1049 :     C<< my $peel = $loc->Peel($length); >>
1050 :    
1051 :     Peel a specified number of positions off the beginning of the location. Peeling splits
1052 :     a location at a specified offset from the beginning, while splitting takes it at a
1053 :     specified offset from the left point. If the specified length is equal to or longer
1054 :     than the location's length, an undefined value will be returned.
1055 :    
1056 :     =over 4
1057 :    
1058 :     =item length
1059 :    
1060 :     Number of positions to split from the location.
1061 :    
1062 :     =item RETURN
1063 :    
1064 :     Returns a new location formed by splitting positions off of the existing location, which is
1065 :     shortened accordingly. If the specified length is longer than the location's length, an
1066 :     undefined value is returned and the location is not modified.
1067 :    
1068 :     =back
1069 :    
1070 :     =cut
1071 :     #: Return Type $%;
1072 :     sub Peel {
1073 :     # Get the parameters.
1074 :     my ($self, $length) = @_;
1075 :     # Declare the return variable.
1076 :     my $retVal;
1077 :     # Only proceed if a split is necessary.
1078 :     if ($length < $self->{_len}) {
1079 :     # Save the current begin point.
1080 :     my $oldBegpoint = $self->{_beg};
1081 :     # Update this location's begin point and length. We're peeling from the beginning,
1082 :     # which for this type of location means the segment is chopped off the left end.
1083 :     $self->{_beg} += $length;
1084 :     $self->{_len} -= $length;
1085 :     # Create the new location.
1086 :     $retVal = BasicLocation->new($self->{_contigID}, $oldBegpoint, '+', $length);
1087 :     }
1088 :     # Return the new location object.
1089 :     return $retVal;
1090 :     }
1091 :    
1092 :    
1093 :     =head3 Reverse
1094 :    
1095 :     C<< $loc->Reverse; >>
1096 :    
1097 :     Change the polarity of the location. The location will have the same nucleotide range, but
1098 :     the direction will be changed.
1099 :    
1100 :     =cut
1101 :    
1102 :     sub Reverse {
1103 :     # Get the parameters.
1104 :     my ($self) = @_;
1105 :     # Swap the beginning and end, then update the direction.
1106 :     ($self->{_beg}, $self->{_end}) = ($self->{_end}, $self->{_beg});
1107 :     $self->{_dir} = '-';
1108 :     # Re-bless us as a forward location.
1109 :     bless $self, "BBasicLocation";
1110 :     }
1111 :    
1112 :     =head3 Index
1113 :    
1114 :     C<< my $index = $loc->Index($point); >>
1115 :    
1116 :     Return the index of the specified point in this location. The value returned is the distance
1117 :     from the beginning. If the specified point is not in the location, an undefined value is returned.
1118 :    
1119 :     =over 4
1120 :    
1121 :     =item point
1122 :    
1123 :     Offset into the contig of the point in question.
1124 :    
1125 :     =item RETURN
1126 :    
1127 :     Returns the distance of the point from the beginning of the location, or an undefined value if the
1128 :     point is outside the location.
1129 :    
1130 :     =back
1131 :    
1132 :     =cut
1133 :    
1134 :     sub Index {
1135 :     # Get the parameters.
1136 :     my ($self, $point) = @_;
1137 :     # Compute the distance from the beginning. Because we are in a forward location, this
1138 :     # means subtracting the beginning's offset from the point's offset.
1139 :     my $retVal = $self->IfValid($point - $self->{_beg});
1140 :     # Return the result.
1141 :     return $retVal;
1142 :     }
1143 :    
1144 :     =head3 PointOffset
1145 :    
1146 :     C<< my $offset = $loc->PointOffset($index); >>
1147 :    
1148 :     Return the offset into the contig of the point at the specified position in the location. A position
1149 :     of 0 will return the beginning point, a position of 1 returns the point next to that, and a position
1150 :     1 less than the length will return the ending point.
1151 :    
1152 :     =over 4
1153 :    
1154 :     =item index
1155 :    
1156 :     Index into the location of the relevant point.
1157 :    
1158 :     =item RETURN
1159 :    
1160 :     Returns an offset into the contig of the specified point in the location.
1161 :    
1162 :     =back
1163 :    
1164 :     =cut
1165 :    
1166 :     sub PointOffset {
1167 :     # Get the parameters.
1168 :     my ($self, $index) = @_;
1169 :     # Return the offset. This is a forward location, so we add it to the begin point.
1170 :     return $self->{_beg} + $index;
1171 :     }
1172 :    
1173 : parrello 1.2
1174 :     =head3 SetBegin
1175 :    
1176 :     C<< $loc->SetBegin($newBegin); >>
1177 :    
1178 :     Change the begin point of this location without changing the endpoint.
1179 :    
1180 :     =over 4
1181 :    
1182 :     =item newBegin
1183 :    
1184 :     Proposed new beginning point.
1185 :    
1186 :     =back
1187 :    
1188 :     =cut
1189 :     #: Return Type ;
1190 :     sub SetBegin {
1191 :     # Get the parameters.
1192 :     my ($self, $newBegin) = @_;
1193 :     # Update the begin point.
1194 :     $self->{_beg} = $newBegin;
1195 :     # Adjust the length.
1196 :     $self->{_len} = $self->{_end} - $self->{_beg} + 1;
1197 :     }
1198 :    
1199 :     =head3 SetEnd
1200 :    
1201 :     C<< $loc->SetEnd($newEnd); >>
1202 :    
1203 :     Change the endpoint of this location without changing the begin point.
1204 :    
1205 :     =over 4
1206 :    
1207 :     =item newEnd
1208 :    
1209 :     Proposed new ending point.
1210 :    
1211 :     =back
1212 :    
1213 :     =cut
1214 :     #: Return Type ;
1215 :     sub SetEnd {
1216 :     # Get the parameters.
1217 :     my ($self, $newEnd) = @_;
1218 :     # Update the end point.
1219 :     $self->{_end} = $newEnd;
1220 :     # Adjust the length.
1221 :     $self->{_len} = $self->{_end} - $self->{_beg} + 1;
1222 :     }
1223 :    
1224 : parrello 1.6 =head3 Widen
1225 :    
1226 :     C<< my = $loc->Widen($distance, $max); >>
1227 :    
1228 :     Add the specified distance to each end of the location, taking care not to
1229 :     extend past either end of the contig. The contig length must be provided
1230 :     to insure we don't fall off the far end; otherwise, only the leftward
1231 :     expansion is limited.
1232 :    
1233 :     =over 4
1234 :    
1235 :     =item distance
1236 :    
1237 :     Number of positions to add to both ends of the location.
1238 :    
1239 :     =item max (optional)
1240 :    
1241 :     Maximum possible value for the right end of the location.
1242 :    
1243 :     =back
1244 :    
1245 :     =cut
1246 :     #: Return Type ;
1247 :     sub Widen {
1248 :     # Get the parameters.
1249 :     my ($self, $distance, $max) = @_;
1250 :     # Subtract the distance from the begin point.
1251 :     my $newBegin = FIG::max(1, $self->Begin - $distance);
1252 :     $self->SetBegin($newBegin);
1253 :     # Add the distance to the end point, keeping track of the maximum.
1254 :     my $newEnd = $self->EndPoint + $distance;
1255 :     if ($max && $newEnd > $max) {
1256 :     $newEnd = $max;
1257 :     }
1258 :     $self->SetEnd($newEnd);
1259 :     }
1260 : parrello 1.2
1261 : parrello 1.9 =head3 Upstream
1262 :    
1263 :     C<< my $newLoc = $loc->Upstream($distance, $max); >>
1264 :    
1265 :     Return a new location upstream of the given location, taking care not to
1266 :     extend past either end of the contig.
1267 :    
1268 :     =over 4
1269 :    
1270 :     =item distance
1271 :    
1272 :     Number of positions to add to the front (upstream) of the location.
1273 :    
1274 :     =item max (optional)
1275 :    
1276 :     Maximum possible value for the right end of the location.
1277 :    
1278 :     =item RETURN
1279 :    
1280 :     Returns a new location object whose last position is next to the first
1281 :     position of this location.
1282 :    
1283 :     =back
1284 :    
1285 :     =cut
1286 :     #: Return Type $%;
1287 :    
1288 :     sub Upstream {
1289 :     # Get the parameters.
1290 :     my ($self, $distance, $max) = @_;
1291 :     # Subtract the distance from the begin point, keeping the position safe.
1292 :     my $newBegin = $self->Begin - $distance;
1293 :     if ($newBegin <= 0) {
1294 :     $newBegin = 1;
1295 :     }
1296 :     # Compute the new length. It may be zero.
1297 :     my $len = $self->Begin - $newBegin;
1298 :     # Return the result.
1299 :     return BasicLocation->new($self->Contig, $newBegin, "+", $len);
1300 :     }
1301 :    
1302 :     =head3 Truncate
1303 :    
1304 :     C<< $loc->Truncate($len); >>
1305 :    
1306 :     Truncate the location to a new length. If the length is larger than the location length, then
1307 :     the location is not changed.
1308 :    
1309 :     =over 4
1310 :    
1311 :     =item len
1312 :    
1313 :     Proposed new length for the location.
1314 :    
1315 :     =back
1316 :    
1317 :     =cut
1318 :     #: Return Type $%;
1319 :     sub Truncate {
1320 :     # Get the parameters.
1321 :     my ($self, $len) = @_;
1322 :     # Only proceed if the new length would be shorter.
1323 :     if ($len < $self->Length) {
1324 :     $self->SetEnd($self->Begin + $len - 1);
1325 :     }
1326 :     }
1327 :    
1328 : parrello 1.1 1;
1329 :    
1330 :     package BBasicLocation;
1331 :    
1332 :     @BBasicLocation::ISA = qw(BasicLocation);
1333 :    
1334 :     =head1 Backward Basic BasicLocation Object
1335 :    
1336 :     =head2 Introduction
1337 :    
1338 :     A I<backward location object> is a location in a contig that is transcribed from right to left.
1339 :     It is a subclass of the B<BasicLocation> object, and contains methods that require different
1340 :     implementation for a forward location than a backward location.
1341 :    
1342 :     =head2 Override Methods
1343 :    
1344 :     =head3 Left
1345 :    
1346 :     C<< my $leftPoint = $loc->Left; >>
1347 :    
1348 :     Return the offset of the leftmost point of the location.
1349 :    
1350 :     =cut
1351 :    
1352 :     sub Left {
1353 :     return $_[0]->{_end};
1354 :     }
1355 :    
1356 :     =head3 Right
1357 :    
1358 :     C<< my $rightPoint = $loc->Right; >>
1359 :    
1360 :     Return the offset of the rightmost point of the location.
1361 :    
1362 :     =cut
1363 :    
1364 :     sub Right {
1365 :     return $_[0]->{_beg};
1366 :     }
1367 :    
1368 :     =head3 Compare
1369 :    
1370 :     C<< my ($distance, $cmp) = $loc->Compare($point); >>
1371 :    
1372 :     Determine the relative location of the specified point on the contig. Returns a distance,
1373 :     which indicates the location relative to the leftmost point of the contig, and a comparison
1374 :     number, which is negative if the point is to the left of the location, zero if the point is
1375 :     inside the location, and positive if the point is to the right of the location.
1376 :    
1377 :     =cut
1378 :    
1379 :     sub Compare {
1380 :     # Get the parameters.
1381 :     my ($self, $point) = @_;
1382 :     # Compute the distance from the end (leftmost) point.
1383 :     my $distance = $point - $self->{_end};
1384 :     # Set the comparison value. The distance works unless it is positive and less than
1385 :     # the length. In that case, it's inside the location so we want to return 0.
1386 :     my $cmp = (defined $self->IfValid($distance) ? 0 : $distance);
1387 :     # Return the results.
1388 :     return ($distance, $cmp);
1389 :     }
1390 :    
1391 :     =head3 Split
1392 :    
1393 :     C<< my $newLocation = $loc->Split($offset); >>
1394 :    
1395 :     Split this location into two smaller ones at the specified offset from the left endpoint. The
1396 :     new location split off of it will be returned. If the offset is at either end of the location,
1397 :     no split will occur and an underfined value will be returned.
1398 :    
1399 :     =over 4
1400 :    
1401 :     =item offset
1402 :    
1403 :     Offset into the location from the left endpoint of the point at which it should be split.
1404 :    
1405 :     =item RETURN
1406 :    
1407 :     The new location split off of this one, or an undefined value if no split was necessary.
1408 :    
1409 :     =back
1410 :    
1411 :     =cut
1412 :    
1413 :     sub Split {
1414 :     # Get the parameters.
1415 :     my ($self, $offset) = @_;
1416 :     # Declare the return variable.
1417 :     my $retVal;
1418 :     # Only proceed if a split is necessary.
1419 :     if ($offset > 0 && $offset < $self->{_len}) {
1420 :     # Save the current ending point.
1421 :     my $oldEndpoint = $self->{_end};
1422 :     # Update this location's ending point and length.
1423 :     $self->{_end} += $offset;
1424 :     $self->{_len} -= $offset;
1425 :     # Create the new location.
1426 :     $retVal = BasicLocation->new($self->{_contigID}, $oldEndpoint + $offset - 1, '-', $offset);
1427 :     }
1428 :     # Return the new location object.
1429 :     return $retVal;
1430 :     }
1431 :    
1432 :     =head3 Peel
1433 :    
1434 :     C<< my $peel = $loc->Peel($length); >>
1435 :    
1436 :     Peel a specified number of positions off the beginning of the location. Peeling splits
1437 :     a location at a specified offset from the beginning, while splitting takes it at a
1438 :     specified offset from the left point. If the specified length is equal to or longer
1439 :     than the location's length, an undefined value will be returned.
1440 :    
1441 :     =over 4
1442 :    
1443 :     =item length
1444 :    
1445 :     Number of positions to split from the location.
1446 :    
1447 :     =item RETURN
1448 :    
1449 :     Returns a new location formed by splitting positions off of the existing location, which is
1450 :     shortened accordingly. If the specified length is longer than the location's length, an
1451 :     undefined value is returned and the location is not modified.
1452 :    
1453 :     =back
1454 :    
1455 :     =cut
1456 :     #: Return Type $%;
1457 :     sub Peel {
1458 :     # Get the parameters.
1459 :     my ($self, $length) = @_;
1460 :     # Declare the return variable.
1461 :     my $retVal;
1462 :     # Only proceed if a split is necessary.
1463 :     if ($length < $self->{_len}) {
1464 :     # Save the current begin point.
1465 :     my $oldBegpoint = $self->{_beg};
1466 :     # Update this location's begin point and length. We're peeling from the beginning,
1467 :     # which for this type of location means the segment is chopped off the right end.
1468 :     $self->{_beg} -= $length;
1469 :     $self->{_len} -= $length;
1470 :     # Create the new location.
1471 : parrello 1.4 $retVal = BasicLocation->new($self->{_contigID}, $oldBegpoint, '-', $length);
1472 : parrello 1.1 }
1473 :     # Return the new location object.
1474 :     return $retVal;
1475 :     }
1476 :    
1477 :     =head3 Reverse
1478 :    
1479 :     C<< $loc->Reverse; >>
1480 :    
1481 :     Change the polarity of the location. The location will have the same nucleotide range, but
1482 :     the direction will be changed.
1483 :    
1484 :     =cut
1485 :    
1486 :     sub Reverse {
1487 :     # Get the parameters.
1488 :     my ($self) = @_;
1489 :     # Swap the beginning and end, then update the direction.
1490 :     ($self->{_beg}, $self->{_end}) = ($self->{_end}, $self->{_beg});
1491 :     $self->{_dir} = '+';
1492 :     # Re-bless us as a forward location.
1493 :     bless $self, "FBasicLocation";
1494 :     }
1495 :    
1496 :     =head3 Index
1497 :    
1498 :     C<< my $index = $loc->Index($point); >>
1499 :    
1500 :     Return the index of the specified point in this location. The value returned is the distance
1501 :     from the beginning. If the specified point is not in the location, an undefined value is returned.
1502 :    
1503 :     =over 4
1504 :    
1505 :     =item point
1506 :    
1507 :     Offset into the contig of the point in question.
1508 :    
1509 :     =item RETURN
1510 :    
1511 :     Returns the distance of the point from the beginning of the location, or an undefined value if the
1512 :     point is outside the location.
1513 :    
1514 :     =back
1515 :    
1516 :     =cut
1517 :    
1518 :     sub Index {
1519 :     # Get the parameters.
1520 :     my ($self, $point) = @_;
1521 :     # Compute the distance from the beginning. Because we are in a backward location, this
1522 :     # means subtracting the point's offset from the beginning's offset.
1523 :     my $retVal = $self->IfValid($self->{_beg} - $point);
1524 :     # Return the result.
1525 :     return $retVal;
1526 :     }
1527 :    
1528 :     =head3 PointOffset
1529 :    
1530 :     C<< my $offset = $loc->PointOffset($index); >>
1531 :    
1532 :     Return the offset into the contig of the point at the specified position in the location. A position
1533 :     of 0 will return the beginning point, a position of 1 returns the point next to that, and a position
1534 :     1 less than the length will return the ending point.
1535 :    
1536 :     =over 4
1537 :    
1538 :     =item index
1539 :    
1540 :     Index into the location of the relevant point.
1541 :    
1542 :     =item RETURN
1543 :    
1544 :     Returns an offset into the contig of the specified point in the location.
1545 :    
1546 :     =back
1547 :    
1548 :     =cut
1549 :    
1550 :     sub PointOffset {
1551 :     # Get the parameters.
1552 :     my ($self, $index) = @_;
1553 :     # Return the offset. This is a backward location, so we subtract it from the begin point.
1554 :     return $self->{_beg} - $index;
1555 :     }
1556 :    
1557 : parrello 1.2 =head3 SetBegin
1558 :    
1559 :     C<< $loc->SetBegin($newBegin); >>
1560 :    
1561 :     Change the begin point of this location without changing the endpoint.
1562 :    
1563 :     =over 4
1564 :    
1565 :     =item newBegin
1566 :    
1567 :     Proposed new beginning point.
1568 :    
1569 :     =back
1570 :    
1571 :     =cut
1572 :     #: Return Type ;
1573 :     sub SetBegin {
1574 :     # Get the parameters.
1575 :     my ($self, $newBegin) = @_;
1576 :     # Update the begin point.
1577 :     $self->{_beg} = $newBegin;
1578 :     # Adjust the length.
1579 :     $self->{_len} = $self->{_beg} - $self->{_end} + 1;
1580 :     }
1581 :    
1582 :     =head3 SetEnd
1583 :    
1584 :     C<< $loc->SetEnd($newEnd); >>
1585 :    
1586 :     Change the endpoint of this location without changing the begin point.
1587 :    
1588 :     =over 4
1589 :    
1590 :     =item newEnd
1591 :    
1592 :     Proposed new ending point.
1593 :    
1594 :     =back
1595 :    
1596 :     =cut
1597 :     #: Return Type ;
1598 :     sub SetEnd {
1599 :     # Get the parameters.
1600 :     my ($self, $newEnd) = @_;
1601 :     # Update the end point.
1602 :     $self->{_end} = $newEnd;
1603 :     # Adjust the length.
1604 :     $self->{_len} = $self->{_beg} - $self->{_end} + 1;
1605 :     }
1606 :    
1607 : parrello 1.6 =head3 Widen
1608 :    
1609 :     C<< my = $loc->Widen($distance, $max); >>
1610 :    
1611 :     Add the specified distance to each end of the location, taking care not to
1612 :     extend past either end of the contig. The contig length must be provided
1613 :     to insure we don't fall off the far end; otherwise, only the leftward
1614 :     expansion is limited.
1615 :    
1616 :     =over 4
1617 : parrello 1.2
1618 : parrello 1.6 =item distance
1619 :    
1620 :     Number of positions to add to both ends of the location.
1621 :    
1622 :     =item max (optional)
1623 :    
1624 :     Maximum possible value for the right end of the location.
1625 :    
1626 :     =back
1627 :    
1628 :     =cut
1629 :     #: Return Type ;
1630 :     sub Widen {
1631 :     # Get the parameters.
1632 :     my ($self, $distance, $max) = @_;
1633 :     # Subtract the distance from the end point.
1634 :     my $newEnd = FIG::max(1, $self->End - $distance);
1635 :     $self->SetEnd($newEnd);
1636 :     # Add the distance to the begin point, keeping track of the maximum.
1637 :     my $newBegin = $self->Begin + $distance;
1638 :     if ($max && $newBegin > $max) {
1639 :     $newBegin = $max;
1640 :     }
1641 :     $self->SetBegin($newEnd);
1642 :     }
1643 : parrello 1.2
1644 : parrello 1.9 =head3 Upstream
1645 :    
1646 :     C<< my $newLoc = $loc->Upstream($distance, $max); >>
1647 :    
1648 :     Return a new location upstream of the given location, taking care not to
1649 :     extend past either end of the contig.
1650 :    
1651 :     =over 4
1652 :    
1653 :     =item distance
1654 :    
1655 :     Number of positions to add to the front (upstream) of the location.
1656 :    
1657 :     =item max (optional)
1658 :    
1659 :     Maximum possible value for the right end of the location.
1660 :    
1661 :     =item RETURN
1662 :    
1663 :     Returns a new location object whose last position is next to the first
1664 :     position of this location.
1665 :    
1666 :     =back
1667 :    
1668 :     =cut
1669 :     #: Return Type $%;
1670 :    
1671 :     sub Upstream {
1672 :     # Get the parameters.
1673 :     my ($self, $distance, $max) = @_;
1674 :     # Add the distance to the begin point, keeping the position safe.
1675 :     my $newBegin = $self->Begin + $distance;
1676 :     if ($max && $newBegin > $max) {
1677 :     $newBegin = $max;
1678 :     }
1679 :     # Compute the new length. It may be zero.
1680 :     my $len = $newBegin - $self->Begin;
1681 :     # Return the result.
1682 :     return BasicLocation->new($self->Contig, $newBegin, "-", $len);
1683 :     }
1684 :    
1685 :     =head3 Truncate
1686 :    
1687 :     C<< $loc->Truncate($len); >>
1688 :    
1689 :     Truncate the location to a new length. If the length is larger than the location length, then
1690 :     the location is not changed.
1691 :    
1692 :     =over 4
1693 :    
1694 :     =item len
1695 :    
1696 :     Proposed new length for the location.
1697 :    
1698 :     =back
1699 :    
1700 :     =cut
1701 :     #: Return Type $%;
1702 :     sub Truncate {
1703 :     # Get the parameters.
1704 :     my ($self, $len) = @_;
1705 :     # Only proceed if the new length would be shorter.
1706 :     if ($len < $self->Length) {
1707 :     $self->SetEnd($self->Begin - $len + 1);
1708 :     }
1709 :     }
1710 :    
1711 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3