view release on metacpan or  search on metacpan

lib/Bio/RNA/Barriers/Results.pm  view on Meta::CPAN

sub min_count {
    my $self = shift;
    my $min_count = $self->mins;
    return $min_count;
}

# List of all minima connected to the mfe minimum (min 1).
sub connected_mins {
    my $self = shift;
    my @connected_mins = grep {$_->is_connected} $self->mins;
    return @connected_mins;
}

# List of indices of all connected minima (cf. connected_mins()).
sub connected_indices {
    my $self = shift;
    my @connected_indices = map {$_->index} $self->connected_mins;
    return @connected_indices;
}

# Re-index minima after deleting some of them.
sub _reindex {
    my $self = shift;

    my $i = 1;
    my @mins = $self->mins;

    # Update min indices.
    $_->index($i++) foreach @mins;

    # Update father indices.
    shift @mins;                        # min 1 is orphan
    $_->father_index($_->father->index) foreach @mins;

    return;
}

# Keep only connected minima and remove all others. The indices are
# remapped to 1..k for k kept minima.
# Returns (old) indices of all kept minima.
sub keep_connected {
    my $self = shift;

    my @connected_indices = $self->connected_indices;
    my @connected_mins    = $self->connected_mins;

    # Update minima list
    @{ $self->_mins } = @connected_mins;
    $self->_reindex;

    return @connected_indices;
}

# Given an ordered list of indices of all connected minima (as returned by
# RateMatrix::keep_connected()), delete all other minima and update their
# ancesters' basin size information accordingly.
# Arguments:
#   ordered_connected_indices: ordered list of indices of (all???)
#       connected minima.
sub update_connected {
    my ($self, @ordered_connected_indices) = @_;

    # Go through all mins and check whether they're next in the connected
    # (==kept) index list. If not, add to removal list.
    my @connected_mins = $self->get_mins(@ordered_connected_indices);
    my @removed_indices;
    for my $min_index (1..$self->min_count) {
        unless (@ordered_connected_indices) {
            # No exclusions left, add rest and stop
            push @removed_indices, $min_index..$self->min_count;
            last;
        }
        if ($min_index == $ordered_connected_indices[0]) {
            shift @ordered_connected_indices;
            next;
        }
        push @removed_indices, $min_index;      # min is deleted
    }

    my @removed_mins  = $self->get_mins(@removed_indices);
    $self->_update_ancestors(@removed_mins);
    @{ $self->_mins } = @connected_mins;
    $self->_reindex;

    return;
}

# Pass a list of ORDERED deleted minima and update their ancestors' bsize
# attributes.
sub _update_ancestors {
    my ($self, @removed_mins) = @_;

    # If the bsize attributes are present, update the basin energy of all
    # (grand)* father basins (substract energy of this one).
    # The minima need to be processed in reversed order because, if an
    # ancester of a removed min is also removed, its merged basin energy
    # includes the basin energy of its child, and thus this contribution
    # would be substracted multiple times from older ancesters. In
    # reversed order, the child contribution is first substracted from the
    # ancestors, and then the contribution of the removed ancestors does
    # not include the child anymore.

    return unless $self->has_bsize;

    foreach my $removed_min (reverse @removed_mins) {
        foreach my $ancestor_min ($removed_min->ancestors) {
            $ancestor_min->_merged_basin_energy(        # private writer
                $ancestor_min->merged_basin_energy
                - $removed_min->grad_basin_energy
            );
        }
    }

    return;
}

# Keep only the first k mins. If there are only k or less mins, do
# nothing.
# WARNING: THIS CAN DISCONNECT THE LANDSCAPE! The bar file will still look
# connected, however, modifying the rate matrix accordingly can lead to