#!/usr/bin/perl -w
# 演算法: longest common subsequence
# 作者: 洪朝貴 http://www.cyut.edu.tw/~ckhung
# 授權: public domain (但如果您要將我的程式改寫成有用的大程式,
# 強烈建議將您的版本施以 GPL)
# 這個程式既是 algotutor 的一部分, 也可以在文字模式下,
# 不使用 Tk, 獨立執行。
# 獨立執行方式: ./lcs -e ansi 'AGCTATACGATGACT' 'GTCAGTATAGTCATATG'
# -e 指定 "強調" 的顯示方式, 後面可接 ansi 或 html
use Getopt::Std;
use strict;
my (%opts) = (
e => "ansi",# type of emphasis, either "ansi" or "html"
);
my ($ES) = {
ansi => { pre=>"\x1b[7m", post=>"\x1b[m", nl=>"\n" },
html => { pre=>"", post=>"", nl=>"
\n" },
};
use strict;
# longest common subsequence
sub lcs {
my ($x, $y, $can) = @_;
$x = [split //, " $x"];
$y = [split //, " $y"];
my ($show, $path, $len, $i, $j);
if (ref $can) {
$show = Board->new(-canvas=>$can, -width=>$#$x+1, -height=>$#$y+1);
map { $show->cell(0,$_)->configure(-text=>$x->[$_], -status=>"done"); } 1..$#$x;
map { $show->cell($_,0)->configure(-text=>$y->[$_], -status=>"done"); } 1..$#$y;
$can->set_mark(1);
}
map { $len->[0][$_] = 0; } 0..$#$x;
map { $len->[$_][0] = 0; } 0..$#$y;
print " \\ ", join(" ", @{$x}[1..$#$x]) unless ref $can;
my ($changed);
for ($i=1; $i<=$#$y; ++$i) {
print "\n$y->[$i]" unless ref $can;
for ($j=1; $j<=$#$x; ++$j) {
if ($x->[$j] eq $y->[$i]) {
$path->[$i][$j] = "\\";
$len->[$i][$j] = $len->[$i-1][$j-1] + 1;
if (ref $can) {
$show->cell(0,$j)->configure(-status=>"focus");
$show->cell($i,0)->configure(-status=>"focus");
$changed = $show->cell($i-1,$j-1);
$changed->configure(-status=>"focus");
}
} elsif ($len->[$i-1][$j] >= $len->[$i][$j-1]) {
$path->[$i][$j] = "^";
$len->[$i][$j] = $len->[$i-1][$j];
if (ref $can) {
$show->cell(0,$j)->configure(-status=>"discard");
$show->cell($i,0)->configure(-status=>"discard");
$changed = $show->cell($i-1,$j);
$changed->configure(-status=>"focus");
}
} else {
$path->[$i][$j] = "<";
$len->[$i][$j] = $len->[$i][$j-1];
if (ref $can) {
$show->cell(0,$j)->configure(-status=>"discard");
$show->cell($i,0)->configure(-status=>"discard");
$changed = $show->cell($i,$j-1);
$changed->configure(-status=>"focus");
}
}
my ($s) = sprintf " $path->[$i][$j]%2d", $len->[$i][$j];
if (ref $can) {
$can->set_mark(0);
$show->cell(0,$j)->configure(-status=>"done");
$show->cell($i,0)->configure(-status=>"done");
$changed->configure(-status=>"done");
$show->cell($i,$j)->configure(-text=>$s, -status=>"done");
$can->set_mark(0);
} else {
print $s;
}
}
$can->set_mark(1) if ref $can;
}
print "\n" unless ref $can;
$i = $#$y; $j = $#$x;
my ($x_hit, $y_hit, $prev);
$prev = $show->cell(0,0) if ref $can;
while ($i>0 and $j>0) {
if (ref $can) {
$prev->configure(-status=>"done");
$prev = $show->cell($i,$j);
$prev->configure(-status=>"focus");
}
if ($path->[$i][$j] eq "\\") {
if (ref $can) {
$show->cell($i,0)->configure(-status=>"focus");
$show->cell(0,$j)->configure(-status=>"focus");
}
$x_hit->[$j--] = $y_hit->[$i--] = 1;
} elsif ($path->[$i][$j] eq "^") {
--$i;
} else {
--$j;
}
$can->set_mark(0) if ref $can;
}
if (ref $can) {
$prev->configure(-status=>"done");
$can->set_mark(0);
}
print mark_result($x, $x_hit);
print mark_result($y, $y_hit);
}
sub mark_result {
my ($str, $hit) = @_;
my ($out, $i, $k);
for ($i=1; $i<=$#$str; ++$i) {
$out .= " ";
$out .= $hit->[$i] ?
$ES->{$opts{e}}{pre} . $str->[$i] . $ES->{$opts{e}}{post} :
$str->[$i];
}
return $out . $ES->{$opts{e}}{nl};
}
if ($0 =~ /lcs$/) {
getopts('e:', \%opts);
my ($x, $y);
($x, $y) = $#ARGV >= 1 ? @ARGV[0,1] :
("AGCTATACGATGACT", "GTCAGTATAGTCATATG");
lcs($x, $y);
}
1;