現在アソシエイト・セントラルのレポートの更新が遅れており、
1月18日からのデータをご利用いただけない状態となっております。



C[0,j] = 0
C[i,0] = i
C[i,j] = if (P[i] = T[j]) then C[i-1,j-1]
else 1 + min(C[i-1,j],C[i,j-1],C[i-1,j-1])
| s | u | r | g | e | r | y | ||
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | |
| s | 1 | 0 | 1 | 1 | 1 | 1 | 1 | 1 |
| u | 2 | 1 | 0 | 1 | 2 | 2 | 2 | 2 |
| r | 3 | 2 | 1 | 0 | 1 | 2 | 2 | 3 |
| v | 4 | 3 | 2 | 1 | 1 | 2 | 3 | 3 |
| e | 5 | 4 | 3 | 2 | 2 | 1 | 2 | 3 |
| y | 6 | 5 | 4 | 3 | 3 | 2 | 2 | 2 |
| s | u | r | g | e | r | y | ||
| 0 | ||||||||
| s | 0 | |||||||
| u | 0 | |||||||
| r | 0 | |||||||
| v | 1 | |||||||
| e | 1 | 2 | ||||||
| y | 2 |
| f | o | o | s | u | r | g | e | r | y | b | a | r | ||
| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | |
| s | 1 | 1 | 1 | 1 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 |
| u | 2 | 2 | 2 | 2 | 1 | 0 | 1 | 2 | 2 | 2 | 2 | 2 | 2 | 2 |
| r | 3 | 3 | 3 | 3 | 2 | 1 | 0 | 1 | 2 | 2 | 3 | 3 | 3 | 2 |
| v | 4 | 4 | 4 | 4 | 3 | 2 | 1 | 1 | 2 | 3 | 3 | 4 | 4 | 3 |
| e | 5 | 5 | 5 | 5 | 4 | 3 | 2 | 2 | 1 | 2 | 3 | 4 | 5 | 4 |
| y | 6 | 6 | 6 | 6 | 5 | 4 | 3 | 3 | 2 | 2 | 2 | 3 | 4 | 5 |
| f | o | o | s | u | r | g | e | r | y | b | a | r | ||
| 0 | ||||||||||||||
| s | 0 | |||||||||||||
| u | 0 | |||||||||||||
| r | 0 | |||||||||||||
| v | 1 | |||||||||||||
| e | 1 | 2 | ||||||||||||
| y | 2 |
#!/usr/bin/perl
use strict;
use warnings;
my @key = qw/ s u r v e y /;
my @text = qw/ f o o s u r g e r y b a r /;
unshift @key, ""; # BK
unshift @text, ""; # BK
# スコアテーブルの作成
my @C;
for (my $j = 0; $j < @text; $j++) {
$C[0][$j] = 0;
}
for (my $i = 0; $i < @key; $i++) {
$C[$i][0] = $i;
}
for (my $i = 1; $i < @key; $i++) {
for (my $j = 1; $j < @text; $j++) {
my ($u, $l, $d) = ($C[$i-1][$j], $C[$i][$j-1], $C[$i-1][$j-1]);
if ($key[$i] eq $text[$j]) {
$C[$i][$j] = $d;
} else {
my $min = (sort {$a <=> $b} ($u, $l, $d))[0];
$C[$i][$j] = 1 + $min;
}
}
}
# スコアテーブルの表示
print " ".join(" ", @text),"\n";
for (my $i = 0; $i < @key; $i++) {
printf " %1s ", $key[$i];
for (my $j = 0; $j < @text; $j++) {
printf " %-3d", $C[$i][$j];
}
print "\n";
}
# マッチ箇所取り出し処理のスタート位置決定
my $start = $#text;
for (my $j = $#text; $j > 0; $j--) {
if ($C[$#key][$j] < $C[$#key][$start]) {
$start = $j;
}
}
# マッチ箇所取り出し
my @results = traverse($#key, $start);
sub traverse {
my ($i, $j) = @_;
return if ($i == 0 or $j == 0);
my ($u, $l, $d) = ($C[$i-1][$j], $C[$i][$j-1], $C[$i-1][$j-1]);
my $min = (sort {$a <=> $b} ($u, $l, $d))[0];
if ($min == $d) {
my @rv = traverse($i-1, $j-1);
return @rv, {token => $text[$j],
tag => ($d == $C[$i][$j]) ? "match" : "replace"};
} elsif ($min == $l) {
my @rv = traverse($i, $j-1);
return @rv, {token => $text[$j], tag => "insert"};
} else {
my @rv = traverse($i-1, $j);
return @rv, {token => "", tag => "delete"};
}
}
# 結果表示
print join("", map {$_->{token}} @results),"\n";
print join(", ", map {"$_->{token}:$_->{tag}"} @results),"\n";
% ./dp.pl
f o o s u r g e r y b a r
0 0 0 0 0 0 0 0 0 0 0 0 0 0
s 1 1 1 1 0 1 1 1 1 1 1 1 1 1
u 2 2 2 2 1 0 1 2 2 2 2 2 2 2
r 3 3 3 3 2 1 0 1 2 2 3 3 3 2
v 4 4 4 4 3 2 1 1 2 3 3 4 4 3
e 5 5 5 5 4 3 2 2 1 2 3 4 5 4
y 6 6 6 6 5 4 3 3 2 2 2 3 4 5
surgery
s:match, u:match, r:match, g:replace, e:match, r:insert, y:match