Levenshtein distance/Alignment: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl 6}}: minor tweak)
(→‎{{header|Perl 6}}: putting everything in a single array for shorter code)
Line 68: Line 68:
my @s = *, $σ.comb;
my @s = *, $σ.comb;
my @t = *, $t.comb;
my @t = *, $t.comb;
 
my @d;
my @A;
@d[$_][ 0] = $_ for ^@s;
@A[$_][ 0]<d s t> = $_, @s[1..$_].join, '-' x $_ for ^@s;
@d[ 0][$_] = $_ for ^@t;
@A[ 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] {
if @s[$i] eq @t[$j] {
# No operation required when eq
# No operation required when eq
%A<s>[$i][$j] = %A<s>[$i-1][$j-1] ~ @s[$i];
@A[$i][$j]<d s t> = @A[$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;
next;
}
}
@d[$i][$j] = 1 + my $min =
@A[$i][$j]<d> = 1 + my $min =
min @d[$i-1][$j], @d[$i][$j-1], @d[$i-1][$j-1];
min @A[$i-1][$j]<d>, @A[$i][$j-1]<d>, @A[$i-1][$j-1]<d>;
if @d[$i-1][$j] == $min {
if @A[$i-1][$j]<d> == $min {
# Deletion
# Deletion
%A<s>[$i][$j] = %A<s>[$i-1][$j] ~ @s[$i];
@A[$i][$j]<s t> = @A[$i-1][$j]<s t> Z~ @s[$i], '-';
%A<t>[$i][$j] = %A<t>[$i-1][$j] ~ '-';
}
}
elsif @d[$i][$j-1] == $min {
elsif @A[$i][$j-1]<d> == $min {
# Insertion
# Insertion
%A<s>[$i][$j] = %A<s>[$i][$j-1] ~ '-';
@A[$i][$j]<s t> = @A[$i][$j-1]<s t> Z~ '-', @t[$j];
%A<t>[$i][$j] = %A<t>[$i][$j-1] ~ @t[$j];
}
}
else {
else {
# Substitution
# Substitution
%A<s>[$i][$j] = %A<s>[$i-1][$j-1] ~ @s[$i];
@A[$i][$j]<s t> = @A[$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 *[*-1][*-1], %A<s t>;
return @A[*-1][*-1]<s t>;
}
}

.say for align |<rosettacode raisethysword>;
.say for align |<rosettacode raisethysword>;</lang>
</lang>
{{out}}
{{out}}
<pre>ro-settac-o-de
<pre>ro-settac-o-de