Algorithm-NeedlemanWunsch
view release on metacpan or search on metacpan
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
my $arg = { $spec_name => $_[0] };
my $rv = &$univ_cb($arg);
croak "select_align callback returned invalid selection $rv."
unless $rv eq $spec_name;
};
}
return $cb;
}
sub _canonicalize_callbacks {
my $cb;
if (@_) {
$cb = $_[0];
} else {
$cb = { };
}
if (exists($cb->{select_align})) {
my @cn = qw(align shift_a shift_b);
foreach (@cn) {
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
return $self->{gap_extend_penalty};
}
sub align {
my $self = shift;
my $a = shift;
my $b = shift;
$self->{callbacks} = _canonicalize_callbacks(@_);
if (!exists($self->{gap_open_penalty})) {
if (exists($self->{gap_extend_penalty})) {
croak "gap_open_penalty must be defined together with gap_extend_penalty";
}
if (!exists($self->{gap_penalty})) {
$self->{gap_penalty} = &{$self->{score_sub}}();
}
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
}
if (!@alt) {
die "internal error";
}
my $cur = [ $i, $j ];
my $move;
if (@alt == 1) {
$move = $self->_simple_trace_back($cur, $alt[0],
$self->{callbacks});
} else {
$move = $self->_trace_back($cur, \@alt);
}
if ($move eq 'align') {
--$i;
--$j;
} elsif ($move eq 'shift_a') {
--$j;
} elsif ($move eq 'shift_b') {
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
die "internal error";
}
# my $x = join ', ', map { "[ " . $_->[0] . ", " . $_->[1] . " ]"; } @alt;
# warn "$i, $j: $x\n";
my $cur = [ $i, $j ];
my $move;
if (@alt == 1) {
$move = $self->_simple_trace_back($cur, $alt[0],
$self->{callbacks});
} else {
$move = $self->_trace_back($cur, \@alt);
}
if ($move eq 'align') {
--$i;
--$j;
@score = map { $_->[$i]->[$j]; } @D;
if ($i == 0) {
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
} elsif ($m eq 'shift_a') {
$arg->{shift_a} = $cur->[1] - 1;
} elsif ($m eq 'shift_b') {
$arg->{shift_b} = $cur->[0] - 1;
} else {
die "internal error";
}
}
my $move;
my $cb = $self->{callbacks};
if (exists($cb->{select_align})) {
$move = &{$cb->{select_align}}($arg);
if (!exists($arg->{$move})) {
die "select_align callback returned invalid selection $move.";
}
} else {
my @cn = qw(align shift_a shift_b);
foreach my $m (@cn) {
if (exists($arg->{$m})) {
$move = $m;
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
The constructor. Takes one mandatory argument, which is a coderef to a
sub implementing the similarity matrix, plus an optional gap penalty
argument. If the gap penalty isn't specified as a constructor
argument, the C<Algorithm::NeedlemanWunsch> object gets it by calling
the scoring sub without arguments; apart from that case, the sub is
called with 2 arguments, which are items from the first and second
sequence, respectively, passed to
C<Algorithm::NeedlemanWunsch::align>. Note that the sub must be pure,
i.e. always return the same value when called with the same arguments.
=head3 align(\@a, \@b [, \%callbacks ])
The core of the algorithm. Creates a bottom-up dynamic programming
matrix, fills it with alignment scores and then traces back to find an
optimal alignment, informing the application about its items by
invoking the callbacks passed to the method.
The first 2 arguments of C<align> are array references to the aligned
sequences, the third a hash reference with user-supplied
callbacks. The callbacks are identified by the hash keys, which are as
follows:
=over
=item align
Aligns two sequence items. The callback is called with 2 arguments,
which are the positions of the paired items in C<\@a> and C<\@b>,
respectively.
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
the position of the item in C<\@b>.
=back
All keys are optional, but the hash will always have at least one. The
callback must select one of the possibilities by returning one of the
keys.
=back
All callbacks are optional. When there is just one way to make the
optimal alignment, the C<Algorithm::NeedlemanWunsch> object prefers
calling the specific callbacks, but will call C<select_align> if it's
defined and the specific callback isn't.
Note that C<select_align> is called I<instead> of the specific
callbacks, not in addition to them - users defining both
C<select_align> and other callbacks should probably call the specific
callback explicitly from their C<select_align>, once it decides which
one to prefer.
Also note that the passed positions move backwards, from the sequence
ends to zero - if you're building the alignment in your callbacks, add
items to the front.
=head2 Extensions
In addition to the standard Needleman-Wunsch algorithm, this module
also implements two popular extensions: local alignment and affine
block gap penalties. Use of both extensions is controlled by setting
the properties of C<Algorithm::NeedlemanWunsch> object described
below.
( run in 0.791 second using v1.01-cache-2.11-cpan-10033ea8487 )