view release on metacpan or  search on metacpan

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

=cut

*each_position = \&get_positions;

=head2 purge_positions

 Title   : purge_positions
 Usage   : $map->purge_position();
 Function: Remove all positions from this map. Notifies the positions they are
           no longer on this map.
 Returns : n/a
 Args    : none to remove all positions, OR
           L<Bio::Map::PositionI> object to remove just that Position, OR
		   L<Bio::Map::MappableI> object to remove only those positions of the
           given mappable

=cut

sub purge_positions {
    my ($self, $thing) = @_;
    $self->get_position_handler->purge_positions($thing);
}

=head2 get_elements

 Title   : get_elements
 Usage   : my @elements = $map->get_elements;
 Function: Retrieves all the elements on a map (unordered)
 Returns : Array of Map elements (L<Bio::Map::MappableI>)
 Args    : none

=cut

sub get_elements {
    my $self = shift;
    return $self->get_position_handler->get_other_entities;
}

=head2 each_element

 Title   : each_element
 Function: Synonym of the get_elements() method.
 Status  : deprecated, will be removed in the next version

=cut

=head2 common_elements

 Title   : common_elements
 Usage   : my @common_elements = $map->common_elements(\@other_maps);
           my @common_elements = Bio::Map::SimpleMap->common_elements(\@maps);
 Function: Find the elements that are common to multiple maps.
 Returns : array of Bio::Map::MappableI
 Args    : arg #1 = L<Bio::Map::MapI> 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
           -min_num => int        : the minimum number of input maps an element
                                    must be found on before before returned
                                    [default is 1]
           -min_percent => number : as above, but the minimum percentage of
                                    input maps [default is 100 - note that this
                                    will effectively override all other options]
           -require_self => 1|0   : require that all output elements at least
                                    be on the calling map [default is 1, has no
                                    effect when the second usage form is used]
           -required => \@maps    : require that all output elements be on at
                                    least all the maps supplied here

=cut

sub common_elements {
    my ($self, $maps_ref, @extra_args) = @_;
    $self->throw("Must supply a reference first argument") unless ref($maps_ref);
    my @maps;
    if (ref($maps_ref) eq 'ARRAY') {
        @maps = @{$maps_ref};
    }
    elsif ($maps_ref->isa('Bio::Map::MapI')) {
        @maps = ($maps_ref);
    }
    if (ref($self)) {
        unshift(@maps, $self);
    }
    $self->throw("Need at least 2 maps") unless @maps >= 2;
    
    my %args = (-min_num => 1, -min_percent => 100, -require_self => 1, -required => undef, @extra_args);
    my $min_num = $args{-min_num};
    if ($args{-min_percent}) {
        my $mn = @maps / 100 * $args{-min_percent};
        if ($mn > $min_num) {
            $min_num = $mn;
        }
    }
    my %required = map { $_ => 1 } $args{-required} ? @{$args{-required}} : ();
    $required{$self} = 1 if ref($self) && $args{-require_self};
    my @required = keys %required;
    
    my %map_elements;
    my %elements;
    my %count;
    foreach my $map (@maps) {
        $map_elements{$map} = {};
        foreach my $element ($map->get_elements) {
            $map_elements{$map}->{$element} = 1;
            $elements{$element} = $element;
            $count{$element}++;
        }
    }
    
    my @elements;
    ELEMENT: while (my ($key, $value) = each %elements) {
        $count{$key} >= $min_num or next;
        foreach my $required (@required) {
            exists $map_elements{$required}->{$key} or next ELEMENT;
        }
        
        push(@elements, $value);
    }
    return @elements;
}

=head2 MapI-specific methods

=cut

=head2 species

 Title   : species
 Usage   : my $species = $map->species;
 Function: Get/Set Species for a map
 Returns : L<Bio::Species> object
 Args    : (optional) Bio::Species

=cut

sub species{
    my $self = shift;
    $self->throw_not_implemented();
}

=head2 units

 Title   : units
 Usage   : $map->units('cM');
 Function: Get/Set units for a map
 Returns : units for a map
 Args    : units for a map (string)

=cut