#!/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;