view release on metacpan or  search on metacpan

Bio/Map/PositionI.pm  view on Meta::CPAN

=head2 less_than

 Title   : less_than
 Usage   : if ($position->less_than($other_position)) {...}
 Function: Ask if this Position ends before another starts.
 Returns : boolean
 Args    : arg #1 = a Bio::RangeI (eg. a Bio::Map::Position) to compare this
                    one to (mandatory)
           arg #2 = optional Bio::Map::RelativeI to ask if the Position is less
                    in terms of their relative position to the thing described
                    by that Relative

=cut

sub less_than {
    my ($self, $other, $rel) = @_;
    
    my ($own_start, $own_end) = $self->_pre_rangei($self, $rel);
    my ($other_start, $other_end) = $self->_pre_rangei($other, $rel);
    
    return $own_end < $other_start;
}

=head2 greater_than

 Title   : greater_than
 Usage   : if ($position->greater_than($other_position)) {...}
 Function: Ask if this Position starts after another ends.
 Returns : boolean
 Args    : arg #1 = a Bio::RangeI (eg. a Bio::Map::Position) to compare this
                    one to (mandatory)
           arg #2 = optional Bio::Map::RelativeI to ask if the Position is
                    greater in terms of their relative position to the thing
                    described by that Relative

=cut

sub greater_than {
    my ($self, $other, $rel) = @_;
    
    my ($own_start, $own_end) = $self->_pre_rangei($self, $rel);
    my ($other_start, $other_end) = $self->_pre_rangei($other, $rel);
    
    return $own_start > $other_end;
}

=head2 overlaps

  Title   : overlaps
  Usage   : if ($p1->overlaps($p2)) {...}
  Function: Tests if $p1 overlaps $p2.
  Returns : True if the positions overlap (regardless of map), false otherwise
  Args    : arg #1 = a Bio::RangeI (eg. a Bio::Map::Position) to compare this
                     one to (mandatory)
            arg #2 = optional strand-testing arg ('strong', 'weak', 'ignore')
            arg #3 = optional Bio::Map::RelativeI to ask if the Positions
                     overlap in terms of their relative position to the thing
                     described by that Relative
            arg #4 = optional minimum percentage length of the overlap before
                     reporting an overlap exists (default 0)

=cut

sub overlaps {
    # overriding the RangeI implementation so we can handle Relative
    my ($self, $other, $so, $rel, $min_percent) = @_;
    $min_percent ||= 0;
    
    my ($own_min, $other_min) = (0, 0);
    if ($min_percent > 0) {
        $own_min = (($self->length / 100) * $min_percent) - 1;
        $other_min = (($other->length / 100) * $min_percent) - 1;
    }
    
    my ($own_start, $own_end) = $self->_pre_rangei($self, $rel);
    my ($other_start, $other_end) = $self->_pre_rangei($other, $rel);
    
    return ($self->_testStrand($other, $so) and not
            (($own_start + $own_min > $other_end or $own_end - $own_min < $other_start) ||
             ($own_start > $other_end - $other_min or $own_end < $other_start + $other_min)));
}

=head2 contains

  Title   : contains
  Usage   : if ($p1->contains($p2)) {...}
  Function: Tests whether $p1 totally contains $p2.
  Returns : true if the argument is totally contained within this position
            (regardless of map), false otherwise
  Args    : arg #1 = a Bio::RangeI (eg. a Bio::Map::Position) to compare this
                     one to, or scalar number (mandatory)
            arg #2 = optional strand-testing arg ('strong', 'weak', 'ignore')
            arg #3 = optional Bio::Map::RelativeI to ask if the Position
                     is contained in terms of their relative position to the
                     thing described by that Relative

=cut

sub contains {
    # overriding the RangeI implementation so we can handle Relative
    my ($self, $other, $so, $rel) = @_;
    
    my ($own_start, $own_end) = $self->_pre_rangei($self, $rel);
    my ($other_start, $other_end) = $self->_pre_rangei($other, $rel);
    
    return ($self->_testStrand($other, $so) and
			$other_start >= $own_start and $other_end <= $own_end);
}

=head2 intersection

 Title   : intersection
 Usage   : ($start, $stop, $strand) = $p1->intersection($p2)
           ($start, $stop, $strand) = Bio::Map::Position->intersection(\@positions);
           $mappable = $p1->intersection($p2, undef, $relative);
           $mappable = Bio::Map::Position->intersection(\@positions);
 Function: gives the range that is contained by all ranges
 Returns : undef if they do not overlap, OR
           Bio::Map::Mappable object who's positions are the
           cross-map-calculated intersection of the input positions on all the
           maps that the input positions belong to, OR, in list context, a three
           element array (start, end, strand)
 Args    : arg #1 = [REQUIRED] a Bio::RangeI (eg. a Bio::Map::Position) to
                    compare this one to, or an array ref of Bio::RangeI
           arg #2 = optional strand-testing arg ('strong', 'weak', 'ignore')
           arg #3 = optional Bio::Map::RelativeI to ask how the Positions
                    intersect in terms of their relative position to the thing
                    described by that Relative

=cut

sub intersection {

Bio/Map/PositionI.pm  view on Meta::CPAN

        
        push(@starts, $start);
        push(@ends, $end);
    }
    
	@starts = sort { $a <=> $b } @starts;
	@ends   = sort { $a <=> $b } @ends;
	my $start = shift @starts;
	my $end = pop @ends;
    
    my @unions;
    foreach my $known_map (values %known_maps) {
        my $new_union = $self->new(-start => $start,
                                   -end => $end,
                                   -strand => $union_strand,
                                   -map => $known_map);
        $new_union->relative($rel) if $rel;
        push(@unions, $new_union);
    }
    unless (@unions) {
        @unions = ($self->new(-start => $start,
                         -end => $end,
                         -strand => $union_strand));
        $unions[0]->relative($rel) if $rel;
    }
    
    my $result = Bio::Map::Mappable->new();
    $result->add_position(@unions); # sneaky, add_position can take a list of positions
    return $result;
}

=head2 overlap_extent

 Title   : overlap_extent
 Usage   : ($a_unique,$common,$b_unique) = $a->overlap_extent($b)
 Function: Provides actual amount of overlap between two different
           positions
 Example :
 Returns : array of values containing the length unique to the calling 
           position, the length common to both, and the length unique to 
           the argument position
 Args    : a position

=cut

#*** should this be overridden from RangeI?

=head2 disconnected_ranges

 Title   : disconnected_ranges
 Usage   : my @disc_ranges = Bio::Map::Position->disconnected_ranges(@ranges);
 Function: Creates the minimal set of positions such that each input position is
           fully contained by at least one output position, and none of the
           output positions overlap.
 Returns : Bio::Map::Mappable with the calculated disconnected ranges
 Args    : a Bio::Map::PositionI to compare this one to, or a list of such,
           OR
           a single Bio::Map::PositionI or array ref of such AND a
           Bio::Map::RelativeI to consider all Position's co-ordinates in terms
           of their relative position to the thing described by that Relative,
           AND, optionally, an int for the minimum percentage of overlap that
           must be present before considering two ranges to be overlapping
           (default 0)

=cut

sub disconnected_ranges {
    # overriding the RangeI implementation so we can transfer map and handle
    # Relative
    my ($self, @args) = @_;
    $self->throw("Not enough arguments") unless @args >= 1;
    
    my @positions;
    my $rel;
    my $overlap = 0;
    if ($self eq "Bio::Map::PositionI") {
		$self = "Bio::Map::Position";
		$self->warn("calling static methods of an interface is deprecated; use $self instead");
	}
	if (ref $self) {
		push(@positions, $self);
	}
    if (ref $args[0] eq 'ARRAY') {
        push(@positions, @{shift(@args)});
    }
    else {
        push(@positions, shift(@args));
    }
    if ($args[0] && $args[0]->isa('Bio::Map::RelativeI')) {
        $rel = shift(@args);
        $overlap = shift(@args);
    }
    foreach my $arg (@args) {
        push(@positions, $arg) if $arg;
    }
    $self->throw("Need at least 2 Positions") unless @positions >= 2;
    
    my %known_maps;
    foreach my $pos (@positions) {
        $pos->isa('Bio::Map::PositionI') || $self->throw("Must supply only Bio::Map::PositionI objects, not [$pos]");
        my $map = $pos->map || next;
        $known_maps{$map->unique_id} = $map;
    }
    my %prior_positions;
    foreach my $map (values %known_maps) {
        foreach my $pos ($map->get_positions) {
            $prior_positions{$pos} = 1;
        }
    }
    
    my @outranges = ();
    foreach my $inrange (@positions) {
        my @outranges_new = ();
        my %overlapping_ranges = ();
        
        for (my $i=0; $i<@outranges; $i++) {
            my $outrange = $outranges[$i];
            if ($inrange->overlaps($outrange, undef, $rel, $overlap)) {
                my $union_able = $inrange->union($outrange, $rel); # using $inrange->union($outrange, $rel); gives >6x speedup,
                                                                   # but different answer, not necessarily incorrect...
                foreach my $pos ($union_able->get_positions) {