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

Annotation of /FigKernelPackages/BasicLocation.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3