Levenshtein distance/Alignment: Difference between revisions

→‎{{header|Perl 6}}: putting everything in a single array for shorter code
m (→‎{{header|Perl 6}}: minor tweak)
(→‎{{header|Perl 6}}: putting everything in a single array for shorter code)
Line 68:
my @s = *, $σ.comb;
my @t = *, $t.comb;
 
my @dA;
@dA[$_][ 0]<d s t> = $_, @s[1..$_].join, '-' x $_ for ^@s;
@dA[ 0][$_]<d s t> = $_, '-' x $_, @t[1..$_].join for ^@t;
 
 
for 1 ..^ @s X 1..^ @t -> $i, $j {
my %A;
%A<s>[$_][ 0] = @s[1..$_].join for ^@s;
%A<s>[ 0][$_] = '-' x $_ for ^@t;
%A<t>[ 0][$_] = @t[1..$_].join for ^@t;
%A<t>[$_][ 0] = '-' x $_ for ^@s;
 
for 1..^@s X 1..^@t -> $i, $j {
if @s[$i] eq @t[$j] {
# No operation required when eq
%@A<s>[$i][$j]<d s t> = %@A<s>[$i-1][$j-1]<d s t> Z~ '', @s[$i], @t[$j];
%A<t>[$i][$j] = %A<t>[$i-1][$j-1] ~ @t[$j];
@d[$i][$j] = @d[$i-1][$j-1];
next;
}
@dA[$i][$j]<d> = 1 + my $min =
min @dA[$i-1][$j]<d>, @dA[$i][$j-1]<d>, @dA[$i-1][$j-1]<d>;
if @dA[$i-1][$j]<d> == $min {
# Deletion
%@A<s>[$i][$j]<s t> = %@A<s>[$i-1][$j]<s t> Z~ @s[$i], '-';
%A<t>[$i][$j] = %A<t>[$i-1][$j] ~ '-';
}
elsif @dA[$i][$j-1]<d> == $min {
# Insertion
%@A<s>[$i][$j]<s t> = %@A<s>[$i][$j-1]<s t> Z~ '-', @t[$j];
%A<t>[$i][$j] = %A<t>[$i][$j-1] ~ @t[$j];
}
else {
# Substitution
%@A<s>[$i][$j]<s t> = %@A<s>[$i-1][$j-1]<s t> Z~ @s[$i], @t[$j];
%A<t>[$i][$j] = %A<t>[$i-1][$j-1] ~ @t[$j];
}
}
 
return map *@A[*-1][*-1], %A<s t>;
}
 
.say for align |<rosettacode raisethysword>;</lang>
</lang>
{{out}}
<pre>ro-settac-o-de
1,934

edits