BioPerl

 view release on metacpan or  search on metacpan

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

		                            on the given map
		   -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
                                    of each Position's relative position to the
                                    thing described by that Relative

=cut

sub overlaps {
    my $self = shift;
    return $self->_compare('overlaps', @_);
}

=head2 contains

 Title   : contains
 Usage   : if ($mappable->contains($other_mappable)) {...}
           my @container_positions = $mappable->contains($other_mappable);
 Function: Finds the positions in this mappable that contain any comparison
           positions.
 Returns : array of L<Bio::Map::PositionI> objects
 Args    : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to compare
                    this one to (mandatory)
           arg #2 = optionally, one or more of the key => value pairs below
		   -map => MapI           : a Bio::Map::MapI to only consider positions
		                            on the given map
		   -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
                                    of each Position's relative position to the
                                    thing described by that Relative

=cut

sub contains {
    my $self = shift;
    return $self->_compare('contains', @_);
}

=head2 overlapping_groups

 Title   : overlapping_groups
 Usage   : my @groups = $mappable->overlapping_groups($other_mappable);
           my @groups = Bio::Map::Mappable->overlapping_groups(\@mappables);
 Function: Look at all the positions of all the supplied mappables and group
           them according to overlap.
 Returns : array of array refs, each ref containing the Bio::Map::PositionI
           objects that overlap with each other
 Args    : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to  compare
                    this one to, or an array ref of such objects (mandatory)
           arg #2 = optionally, one or more of the key => value pairs below
		   -map => MapI           : a Bio::Map::MapI to only consider positions
		                            on the given map
		   -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
                                    of each Position's relative position to the
                                    thing described by that Relative
           -min_pos_num => int    : the minimum number of positions that must
                                    be in a group before it will be returned
                                    [default is 1]
           -min_mappables_num => int        : the minimum number of different
                                              mappables represented by the
                                              positions in a group before it
                                              will be returned [default is 1]
           -min_mappables_percent => number : as above, but the minimum
                                              percentage of input mappables
                                              [default is 0]
           -min_map_num => int              : the minimum number of different
                                              maps represented by the positions
                                              in a group before it will be
                                              returned [default is 1]
           -min_map_percent => number       : as above, but the minimum
                                              percentage of maps known by the
                                              input mappables [default is 0]
           -require_self => 1|0             : require that at least one of the
                                              calling object's positions be in
                                              each group [default is 1, has no
                                              effect when the second usage form
                                              is used]
           -required => \@mappables         : require that at least one position
                                              for each mappable supplied in this
                                              array ref be in each group

=cut

sub overlapping_groups {
    my $self = shift;
    return $self->_compare('overlapping_groups', @_);
}

=head2 disconnected_intersections

 Title   : disconnected_intersections
 Usage   : @positions = $mappable->disconnected_intersections($other_mappable);
           @positions = Bio::Map::Mappable->disconnected_intersections(\@mappables);
 Function: Make the positions that are at the intersection of each group of
           overlapping positions, considering all the positions of the supplied
           mappables.
 Returns : new Bio::Map::Mappable who's positions on maps are the calculated
           disconnected unions
 Args    : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to  compare
                    this one to, or an array ref of such objects (mandatory)
           arg #2 = optionally, one or more of the key => value pairs below
		   -map => MapI           : a Bio::Map::MapI to only consider positions
		                            on the given map
		   -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
                                    of each Position's relative position to the
                                    thing described by that Relative
           -min_pos_num => int    : the minimum number of positions that must
                                    be in a group before the intersection will
                                    be calculated and returned [default is 1]
           -min_mappables_num => int        : the minimum number of different
                                              mappables represented by the
                                              positions in a group before the
                                              intersection will be calculated
                                              and returned [default is 1]
           -min_mappables_percent => number : as above, but the minimum
                                              percentage of input mappables
                                              [default is 0]
           -min_map_num => int              : the minimum number of different
                                              maps represented by the positions
                                              in a group before the intersection
                                              will be calculated and returned
                                              [default is 1]
           -min_map_percent => number       : as above, but the minimum
                                              percentage of maps known by the
                                              input mappables [default is 0]
           -require_self => 1|0             : require that at least one of the
                                              calling object's positions be in
                                              each group [default is 1, has no
                                              effect when the second usage form
                                              is used]
           -required => \@mappables         : require that at least one position
                                              for each mappable supplied in this
                                              array ref be in each group

=cut

sub disconnected_intersections {
    my $self = shift;
    return $self->_compare('intersection', @_);
}

=head2 disconnected_unions

 Title   : disconnected_unions
 Usage   : my @positions = $mappable->disconnected_unions($other_mappable);
           my @positions = Bio::Map::Mappable->disconnected_unions(\@mappables);
 Function: Make the positions that are the union of each group of overlapping
           positions, considering all the positions of the supplied mappables.
 Returns : new Bio::Map::Mappable who's positions on maps are the calculated
           disconnected unions
 Args    : arg #1 = L<Bio::Map::MappableI> OR L<Bio::Map::PositionI> to  compare
                    this one to, or an array ref of such objects (mandatory)
           arg #2 = optionally, one or more of the key => value pairs below
		   -map => MapI           : a Bio::Map::MapI to only consider positions
		                            on the given map
		   -relative => RelativeI : a Bio::Map::RelativeI to calculate in terms
                                    of each Position's relative position to the
                                    thing described by that Relative
           -min_pos_num => int    : the minimum number of positions that must
                                    be in a group before the union will be
                                    calculated and returned [default is 1]
           -min_mappables_num => int        : the minimum number of different
                                              mappables represented by the
                                              positions in a group before the
                                              union will be calculated and
                                              returned [default is 1]
           -min_mappables_percent => number : as above, but the minimum
                                              percentage of input mappables
                                              [default is 0]
           -min_map_num => int              : the minimum number of different
                                              maps represented by the positions
                                              in a group before the union will
                                              be calculated and returned
                                              [default is 1]
           -min_map_percent => number       : as above, but the minimum
                                              percentage of maps known by the
                                              input mappables [default is 0]
           -require_self => 1|0             : require that at least one of the
                                              calling object's positions be in
                                              each group [default is 1, has no
                                              effect when the second usage form
                                              is used]
           -required => \@mappables         : require that at least one position
                                              for each mappable supplied in this
                                              array ref be in each group

=cut

sub disconnected_unions {
    my $self = shift;
    return $self->_compare('union', @_);
}

# do a RangeI-related comparison by calling the corresponding PositionI method
# on all the requested Positions of our Mappables
sub _compare {
    my ($self, $method, $input, @extra_args) = @_;
    $self->throw("Must supply an object or array ref of them") unless ref($input);
    $self->throw("Wrong number of extra args (should be key => value pairs)") unless @extra_args % 2 == 0;
    my @compares = ref($input) eq 'ARRAY' ? @{$input} : ($input);
    
    my %args = (-map => undef, -relative => undef, -min_pos_num => 1,
                -min_mappables_num => 1, -min_mappables_percent => 0,
                -min_map_num => 1, -min_map_percent => 0,
                -require_self => 0, -required => undef, -min_overlap_percent => 0, @extra_args);
    my $map = $args{-map};
    my $rel = $args{-relative};
    my $overlap = $args{-min_overlap_percent};
    my $min_pos_num = $args{-min_pos_num};
    my $min_pables_num = $args{-min_mappables_num};
    if ($args{-min_mappables_percent}) {
        my $mn = (@compares + (ref($self) ? 1 : 0)) / 100 * $args{-min_mappables_percent};
        if ($mn > $min_pables_num) {
            $min_pables_num = $mn;
        }
    }
    my $min_map_num = $args{-min_map_num};
    if ($args{-min_map_percent}) {
        my %known_maps;
        foreach my $pable (@compares, ref($self) ? ($self) : ()) {
            foreach my $known ($pable->known_maps) {
                $known_maps{$known->unique_id} = 1;
            }
        }
        my $mn = scalar(keys %known_maps) / 100 * $args{-min_map_percent};
        if ($mn > $min_map_num) {
            $min_map_num = $mn;
        }
    }
    my %required = map { $_ => 1 } $args{-required} ? @{$args{-required}} : ();
    my (@mine, @yours);
    
    if (ref($self)) {
        @mine = $self->get_positions($map);
        if ($args{-require_self}) {
            @mine > 0 or return;
            $required{$self} = 1;
        }
    }
    my @required = sort keys %required;
    
    foreach my $compare (@compares) {
        if ($compare->isa('Bio::Map::PositionI')) {
            push(@yours, $compare);
        }
        elsif ($compare->isa('Bio::Map::MappableI')) {
            push(@yours, $compare->get_positions($map));
        }
        else {
            $self->throw("This is [$compare], not a Bio::Map::MappableI or Bio::Map::PositionI");
        }
    }
    @yours > 0 or return;
    
    my @ok;
    SWITCH: for ($method) {
        /equals|overlaps|contains/ && do {
            @mine > 0 or return;
            foreach my $my_pos (@mine) {
                foreach my $your_pos (@yours) {
                    if ($my_pos->$method($your_pos, undef, $rel)) {
                        push(@ok, $my_pos);
                        last;
                    }
                }
            }
            last SWITCH;
        };
        /less_than|greater_than/ && do {
            @mine > 0 or return;
            if ($method eq 'greater_than') {
                @mine =  map { $_->[1] }
                         sort { $b->[0] <=> $a->[0] }
                         map { [$_->end($_->absolute_relative), $_] }
                         @mine;
                @yours = map { $_->[1] }
                         sort { $b->[0] <=> $a->[0] }
                         map { [$_->end($_->absolute_relative), $_] }
                         @yours;
            }
            my $test_pos = shift(@yours);
            
            foreach my $my_pos (@mine) {
                if ($my_pos->$method($test_pos, $rel)) {
                    push(@ok, $my_pos);



( run in 1.383 second using v1.01-cache-2.11-cpan-39bf76dae61 )