現在アソシエイト・セントラルのレポートの更新が遅れており、
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