Longest common subsequence: Difference between revisions
Added JavaScript |
|||
Line 173: | Line 173: | ||
#define MAX(A,B) (((A)>(B))? (A) : (B)) |
#define MAX(A,B) (((A)>(B))? (A) : (B)) |
||
char * lcs(char *a,char * b) { |
char * lcs(const char *a,const char * b) { |
||
int lena = strlen(a)+1; |
int lena = strlen(a)+1; |
||
int lenb = strlen(b)+1; |
int lenb = strlen(b)+1; |
||
Line 181: | Line 181: | ||
int i,j; |
int i,j; |
||
char *x, *y; |
const char *x, *y; |
||
int *la = (int *)calloc(lena*lenb, sizeof( int)); |
int *la = (int *)calloc(lena*lenb, sizeof( int)); |
||
int **lengths = (int **)malloc( lena*sizeof( int*)); |
int **lengths = (int **)malloc( lena*sizeof( int*)); |
||
Line 199: | Line 199: | ||
result = bufr+bufrlen; |
result = bufr+bufrlen; |
||
*--result = 0; |
*--result = '\0'; |
||
i = lena-1; j = lenb-1; |
i = lena-1; j = lenb-1; |
||
while ( (i>0) && (j>0) ) { |
while ( (i>0) && (j>0) ) { |
||
Line 214: | Line 214: | ||
}</lang> |
}</lang> |
||
Testing |
Testing |
||
<lang c>int main( |
<lang c>int main() |
||
{ |
{ |
||
printf("%s\n", lcs("thisisatest", "testing123testing")); // tsitest |
printf("%s\n", lcs("thisisatest", "testing123testing")); // tsitest |
Revision as of 09:28, 31 January 2010
The longest common subsequence (or LCS) of groups A and B is the longest group of elements from A and B that are common between the two groups and in the same order in each group. For example, the sequences "1234" and "1224533324" have an LCS of "1234":
1234 1224533324
For a string example, consider the sequences "thisisatest" and "testing123testing". An LCS would be "tsitest":
thisisatest testing123testing
In this puzzle, your code only needs to deal with strings. Write a function which returns an LCS of two strings (case-sensitive). You don't need to show multiple LCS's.
Ada
Using recursion: <lang ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Test_LCS is
function LCS (A, B : String) return String is begin if A'Length = 0 or else B'Length = 0 then return ""; elsif A (A'Last) = B (B'Last) then return LCS (A (A'First..A'Last - 1), B (B'First..B'Last - 1)) & A (A'Last); else declare X : String renames LCS (A, B (B'First..B'Last - 1)); Y : String renames LCS (A (A'First..A'Last - 1), B); begin if X'Length > Y'Length then return X; else return Y; end if; end; end if; end LCS;
begin
Put_Line (LCS ("thisisatest", "testing123testing"));
end Test_LCS;</lang> Sample output:
tsitest
Non-recursive solution: <lang ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Test_LCS is
function LCS (A, B : String) return String is L : array (A'First..A'Last + 1, B'First..B'Last + 1) of Natural; begin for I in L'Range (1) loop L (I, B'First) := 0; end loop; for J in L'Range (2) loop L (A'First, J) := 0; end loop; for I in A'Range loop for J in B'Range loop if A (I) = B (J) then L (I + 1, J + 1) := L (I, J) + 1; else L (I + 1, J + 1) := Natural'Max (L (I + 1, J), L (I, J + 1)); end if; end loop; end loop; declare I : Integer := L'Last (1); J : Integer := L'Last (2); R : String (1..Integer'Max (A'Length, B'Length)); K : Integer := R'Last; begin while I > L'First (1) and then J > L'First (2) loop if L (I, J) = L (I - 1, J) then I := I - 1; elsif L (I, J) = L (I, J - 1) then J := J - 1; else I := I - 1; J := J - 1; R (K) := A (I); K := K - 1; end if; end loop; return R (K + 1..R'Last); end; end LCS;
begin
Put_Line (LCS ("thisisatest", "testing123testing"));
end Test_LCS;</lang> Sample output:
tsitest
ALGOL 68
<lang algol68>main:(
PROC lcs = (STRING a, b)STRING: BEGIN IF UPB a = 0 OR UPB b = 0 THEN "" ELIF a [UPB a] = b [UPB b] THEN lcs (a [:UPB a - 1], b [:UPB b - 1]) + a [UPB a] ELSE STRING x = lcs (a, b [:UPB b - 1]); STRING y = lcs (a [:UPB a - 1], b); IF UPB x > UPB y THEN x ELSE y FI FI END # lcs #; print((lcs ("thisisatest", "testing123testing"), new line))
)</lang> Output:
tsitest
AutoHotkey
using dynamic programming
ahk forum: discussion <lang AutoHotkey>lcs(a,b) { ; Longest Common Subsequence of strings, using Dynamic Programming
Loop % StrLen(a)+2 { ; Initialize i := A_Index-1 Loop % StrLen(b)+2 j := A_Index-1, len%i%_%j% := 0 } Loop Parse, a ; scan a { i := A_Index, i1 := i+1, x := A_LoopField Loop Parse, b ; scan b { j := A_Index, j1 := j+1, y := A_LoopField len%i1%_%j1% := x=y ? len%i%_%j% + 1 : (u:=len%i1%_%j%) > (v:=len%i%_%j1%) ? u : v } } x := StrLen(a)+1, y := StrLen(b)+1 While x*y { ; construct solution from lengths x1 := x-1, y1 := y-1 If (len%x%_%y% = len%x1%_%y%) x := x1 Else If (len%x%_%y% = len%x%_%y1%) y := y1 Else x := x1, y := y1, t := SubStr(a,x,1) t } Return t
}</lang>
BASIC
<lang qbasic>FUNCTION lcs$ (a$, b$)
IF LEN(a$) = 0 OR LEN(b$) = 0 THEN
lcs$ = ""
ELSEIF RIGHT$(a$, 1) = RIGHT$(b$, 1) THEN
lcs$ = lcs$(LEFT$(a$, LEN(a$) - 1), LEFT$(b$, LEN(b$) - 1)) + RIGHT$(a$, 1)
ELSE
x$ = lcs$(a$, LEFT$(b$, LEN(b$) - 1)) y$ = lcs$(LEFT$(a$, LEN(a$) - 1), b$) IF LEN(x$) > LEN(y$) THEN lcs$ = x$ ELSE lcs$ = y$ END IF
END IF
END FUNCTION</lang>
C
<lang c>#include <string.h>
- include <stdlib.h>
- include <stdio.h>
- define MAX(A,B) (((A)>(B))? (A) : (B))
char * lcs(const char *a,const char * b) {
int lena = strlen(a)+1; int lenb = strlen(b)+1;
int bufrlen = 40; char bufr[40], *result;
int i,j; const char *x, *y; int *la = (int *)calloc(lena*lenb, sizeof( int)); int **lengths = (int **)malloc( lena*sizeof( int*)); for (i=0; i<lena; i++) lengths[i] = la + i*lenb;
for (i=0,x=a; *x; i++, x++) { for (j=0,y=b; *y; j++,y++ ) { if (*x == *y) { lengths[i+1][j+1] = lengths[i][j] +1; } else { int ml = MAX(lengths[i+1][j], lengths[i][j+1]); lengths[i+1][j+1] = ml; } } }
result = bufr+bufrlen; *--result = '\0'; i = lena-1; j = lenb-1; while ( (i>0) && (j>0) ) { if (lengths[i][j] == lengths[i-1][j]) i -= 1; else if (lengths[i][j] == lengths[i][j-1]) j-= 1; else {
// assert( a[i-1] == b[j-1]);
*--result = a[i-1]; i-=1; j-=1; } } free(la); free(lengths); return strdup(result);
}</lang> Testing <lang c>int main() {
printf("%s\n", lcs("thisisatest", "testing123testing")); // tsitest return 0;
}</lang>
Common Lisp
Here's a memoizing/dynamic-programming solution that uses an n × m array where n and m are the lengths of the input arrays. The first return value is a sequence (of the same type as array1) which is the longest common subsequence. The second return value is the length of the longest common subsequence.
<lang lisp>(defun longest-common-subsequence (array1 array2)
(let* ((l1 (length array1)) (l2 (length array2)) (results (make-array (list l1 l2) :initial-element nil))) (declare (dynamic-extent results)) (labels ((lcs (start1 start2) ;; if either sequence is empty, return (() 0) (if (or (eql start1 l1) (eql start2 l2)) (list '() 0) ;; otherwise, return any memoized value (let ((result (aref results start1 start2))) (if (not (null result)) result ;; otherwise, compute and store a value (setf (aref results start1 start2) (if (eql (aref array1 start1) (aref array2 start2)) ;; if they start with the same element, ;; move forward in both sequences (destructuring-bind (seq len) (lcs (1+ start1) (1+ start2)) (list (cons (aref array1 start1) seq) (1+ len))) ;; otherwise, move ahead in each separately, ;; and return the better result. (let ((a (lcs (1+ start1) start2)) (b (lcs start1 (1+ start2)))) (if (> (second a) (second b)) a b))))))))) (destructuring-bind (seq len) (lcs 0 0) (values (coerce seq (type-of array1)) len)))))</lang>
For example,
<lang lisp>(longest-common-subsequence "123456" "1a2b3c")</lang>
produces the two values
<lang lisp>"123" 3</lang>
D
<lang d>module lcs ; import std.stdio ;
T[] lcsr(T)(T[] a, T[] b) { // recursive
if(a.length == 0 || b.length == 0) return null ; T[] x = a[1..$] , y = b[1..$] ; if(a[0] == b[0]) return a[0] ~ lcsr(x, y) ; x = lcsr(x, b) ; y = lcsr(a, y) ; return x.length > y.length ? x : y ;
}
T imax(T)(T a, T b) { return a > b ? a : b ; }
T[] lcsi(T)(T[] a, T[] b) { // dynamic programming
int i,j, m = a.length , n = b.length ; int[][] L = new int[][](m + 1,n + 1); T[] res ; for(i = 0 ; i < m ; i++) for(j = 0 ; j < n ; j++) L[i+1][j+1] = (a[i] == b[j]) ? 1 + L[i][j] : imax(L[i+1][j], L[i][j+1]) ; while(i >0 && j >0) if(a[i-1] == b[j-1]) { res ~= a[i-1] ; i-- ; j-- ; } else if (L[i][j-1] < L[i-1][j]) i-- ; else j-- ; return res.reverse ;
}
void main(string[] args) {
writefln(lcsr("thisisatest","testing123testing")) ; writefln(lcsi("thisisatest","testing123testing")) ;
}</lang>
Fortran
Using the iso_varying_string module which can be found here (or equivalent module conforming to the ISO/IEC 1539-2:2000 API or to a subset according to the need of this code: char
, len
, //
, extract
, ==
, =
)
<lang fortran>program lcstest
use iso_varying_string implicit none
type(varying_string) :: s1, s2
s1 = "thisisatest" s2 = "testing123testing" print *, char(lcs(s1, s2))
s1 = "1234" s2 = "1224533324" print *, char(lcs(s1, s2))
contains
recursive function lcs(a, b) result(l) type(varying_string) :: l type(varying_string), intent(in) :: a, b
type(varying_string) :: x, y
l = "" if ( (len(a) == 0) .or. (len(b) == 0) ) return if ( extract(a, len(a), len(a)) == extract(b, len(b), len(b)) ) then l = lcs(extract(a, 1, len(a)-1), extract(b, 1, len(b)-1)) // extract(a, len(a), len(a)) else x = lcs(a, extract(b, 1, len(b)-1)) y = lcs(extract(a, 1, len(a)-1), b) if ( len(x) > len(y) ) then l = x else l = y end if end if end function lcs
end program lcstest</lang>
Haskell
The Wikipedia solution translates directly into Haskell, with the only difference that equal characters are added in front:
<lang haskell>longest xs ys = if length xs > length ys then xs else ys
lcs [] _ = [] lcs _ [] = [] lcs (x:xs) (y:ys)
| x == y = x : lcs xs ys | otherwise = longest (lcs (x:xs) ys) (lcs xs (y:ys))</lang>
Memoization (aka dynamic programming) of that uses zip to make both the index and the character available: <lang haskell>import Data.Array
lcs xs ys = a!(0,0) where
n = length xs m = length ys a = array ((0,0),(n,m)) $ l1 ++ l2 ++ l3 l1 = [((i,m),[]) | i <- [0..n]] l2 = [((n,j),[]) | j <- [0..m]] l3 = [((i,j), f x y i j) | (x,i) <- zip xs [0..], (y,j) <- zip ys [0..]] f x y i j | x == y = x : a!(i+1,j+1) | otherwise = longest (a!(i,j+1)) (a!(i+1,j))</lang>
Both solutions work of course not only with strings, but also with any other list. Example: <lang haskell>*Main> lcs "thisisatest" "testing123testing" "tsitest"</lang>
J
<lang j>lcs=: dyad define
|.x{~ 0{"1 cullOne^:_ (\:~~ +/@|:) 4$.$. x =/ y
) cullOne=: verb define
if. (#y) = First0=.0(= i. 1:) 1,*./|: 2 >/\ y do. y else. y #~ 0 First0}(#y)#1 end.
)</lang>
Java
Recursion
This is not a particularly fast algorithm, but it gets the job done eventually. The speed is a result of many recursive function calls. <lang java>public static String lcs(String a, String b){
int aLen = a.length(); int bLen = b.length(); if(aLen == 0 || bLen == 0){ return ""; }else if(a.charAt(aLen-1) == b.charAt(bLen-1)){ return lcs(a.substring(0,aLen-1),b.substring(0,bLen-1)) + a.charAt(aLen-1); }else{ String x = lcs(a, b.substring(0,bLen-1)); String y = lcs(a.substring(0,aLen-1), b); return (x.length() > y.length()) ? x : y; }
}</lang>
Dynamic Programming
<lang java>public static String lcs(String a, String b) {
int[][] lengths = new int[a.length()+1][b.length()+1];
// row 0 and column 0 are initialized to 0 already
for (int i = 0; i < a.length(); i++) for (int j = 0; j < b.length(); j++) if (a.charAt(i) == b.charAt(j)) lengths[i+1][j+1] = lengths[i][j] + 1; else lengths[i+1][j+1] = Math.max(lengths[i+1][j], lengths[i][j+1]);
// read the substring out from the matrix StringBuffer sb = new StringBuffer(); for (int x = a.length(), y = b.length(); x != 0 && y != 0; ) { if (lengths[x][y] == lengths[x-1][y]) x--; else if (lengths[x][y] == lengths[x][y-1]) y--; else { assert a.charAt(x-1) == b.charAt(y-1); sb.append(a.charAt(x-1)); x--; y--; } }
return sb.reverse().toString();
}</lang>
JavaScript
This is more or less a translation of the recursive Java version above. <lang javascript>function lcs(a, b) {
var aSub = a.substr(0, a.length-1); var bSub = b.substr(0, b.length-1); if (a.length == 0 || b.length == 0) { return ""; } else if (a.charAt(a.length-1) == b.charAt(b.length-1)) { return lcs(aSub, bSub) + a.charAt(a.length-1); } else { var x = lcs(a, bSub); var y = lcs(aSub, b); return (x.length > y.length) ? x : y; }
}</lang>
Logo
This implementation works on both words and lists. <lang logo>to longest :s :t
output ifelse greater? count :s count :t [:s] [:t]
end to lcs :s :t
if empty? :s [output :s] if empty? :t [output :t] if equal? first :s first :t [output combine first :s lcs bf :s bf :t] output longest lcs :s bf :t lcs bf :s :t
end</lang>
M4
<lang M4>define(`set2d',`define(`$1[$2][$3]',`$4')') define(`get2d',`defn($1[$2][$3])') define(`tryboth',
`pushdef(`x',lcs(`$1',substr(`$2',1),`$1 $2'))`'pushdef(`y', lcs(substr(`$1',1),`$2',`$1 $2'))`'ifelse(eval(len(x)>len(y)),1, `x',`y')`'popdef(`x')`'popdef(`y')')
define(`checkfirst',
`ifelse(substr(`$1',0,1),substr(`$2',0,1), `substr(`$1',0,1)`'lcs(substr(`$1',1),substr(`$2',1))', `tryboth(`$1',`$2')')')
define(`lcs',
`ifelse(get2d(`c',`$1',`$2'),`', `pushdef(`a',ifelse( `$1',`',`', `$2',`',`', `checkfirst(`$1',`$2')'))`'a`'set2d(`c',`$1',`$2',a)`'popdef(`a')', `get2d(`c',`$1',`$2')')')
lcs(`1234',`1224533324')
lcs(`thisisatest',`testing123testing')</lang> Note: the caching (set2d/get2d) obscures the code even more than usual, but is necessary in order to get the second test to run in a reasonable amount of time.
Mathematica
A built-in function can do this for us: <lang Mathematica>a = "thisisatest"; b = "testing123testing"; LongestCommonSequence[a, b]</lang> gives: <lang Mathematica>tsitest</lang> Note that Mathematica also has a built-in function called LongestCommonSubsequence[a,b]:
finds the longest contiguous subsequence of elements common to the strings or lists a and b.
which would give "test" as the result for LongestCommonSubsequence[a, b].
The description for LongestCommonSequence[a,b] is:
finds the longest sequence of contiguous or disjoint elements common to the strings or lists a and b.
I added this note because the name of this article suggests LongestCommonSubsequence does the job, however LongestCommonSubsequence performs the puzzle-description.
OCaml
Recursion
from Haskell <lang ocaml>let longest xs ys = if List.length xs > List.length ys then xs else ys
let rec lcs a b = match a, b with
[], _ | _, [] -> [] | x::xs, y::ys -> if x = y then x :: lcs xs ys else longest (lcs a ys) (lcs xs b)</lang>
Dynamic programming
<lang ocaml>let lcs xs' ys' =
let xs = Array.of_list xs' and ys = Array.of_list ys' in let n = Array.length xs and m = Array.length ys in let a = Array.make_matrix (n+1) (m+1) [] in for i = n-1 downto 0 do for j = m-1 downto 0 do a.(i).(j) <- if xs.(i) = ys.(j) then xs.(i) :: a.(i+1).(j+1) else longest a.(i).(j+1) a.(i+1).(j) done done; a.(0).(0)</lang>
Because both solutions only work with lists, here are some functions to convert to and from strings: <lang ocaml>let list_of_string str =
let result = ref [] in String.iter (fun x -> result := x :: !result) str; List.rev !result
let string_of_list lst =
let result = String.create (List.length lst) in ignore (List.fold_left (fun i x -> result.[i] <- x; i+1) 0 lst); result</lang>
Both solutions work. Example:
# string_of_list (lcs (list_of_string "thisisatest") (list_of_string "testing123testing"));; - : string = "tsitest"
Oz
Recursive solution: <lang oz>declare
fun {LCS Xs Ys} case [Xs Ys] of [nil _] then nil [] [_ nil] then nil [] [X|Xr Y|Yr] andthen X==Y then X|{LCS Xr Yr} [] [_|Xr _|Yr] then {Longest {LCS Xs Yr} {LCS Xr Ys}} end end
fun {Longest Xs Ys} if {Length Xs} > {Length Ys} then Xs else Ys end end
in
{System.showInfo {LCS "thisisatest" "testing123testing"}}</lang>
Python
Recursion
This solution is similar to the Haskell one. It is slow. <lang python>def lcs(xstr, ystr):
""" >>> lcs('thisisatest', 'testing123testing') 'tsitest' """ if not xstr or not ystr: return "" x, xs, y, ys = xstr[0], xstr[1:], ystr[0], ystr[1:] if x == y: return x + lcs(xs, ys) else: return max(lcs(xstr, ys), lcs(xs, ystr), key=len)</lang>
Test it: <lang python>if __name__=="__main__":
import doctest; doctest.testmod()</lang>
Dynamic Programming
<lang python>def lcs(a, b):
lengths = [[0 for j in range(len(b)+1)] for i in range(len(a)+1)] # row 0 and column 0 are initialized to 0 already for i, x in enumerate(a): for j, y in enumerate(b): if x == y: lengths[i+1][j+1] = lengths[i][j] + 1 else: lengths[i+1][j+1] = \ max(lengths[i+1][j], lengths[i][j+1]) # read the substring out from the matrix result = "" x, y = len(a), len(b) while x != 0 and y != 0: if lengths[x][y] == lengths[x-1][y]: x -= 1 elif lengths[x][y] == lengths[x][y-1]: y -= 1 else: assert a[x-1] == b[y-1] result = a[x-1] + result x -= 1 y -= 1 return result</lang>
Ruby
Recursion
This solution is similar to the Haskell one. It is slow.
<lang ruby>=begin irb(main):001:0> lcs('thisisatest', 'testing123testing') => "tsitest" =end def lcs(xstr, ystr)
return "" if xstr.empty? || ystr.empty? x, xs, y, ys = xstr[0..0], xstr[1..-1], ystr[0..0], ystr[1..-1] if x == y x + lcs(xs, ys) else [lcs(xstr, ys), lcs(xs, ystr)].max_by {|x| x.size} end
end</lang>
Dynamic Programming
<lang ruby>def lcs(a, b)
lengths = Array.new(a.size+1) { Array.new(b.size+1) { 0 } } # row 0 and column 0 are initialized to 0 already a.split().each_with_index { |x, i| b.split().each_with_index { |y, j| if x == y lengths[i+1][j+1] = lengths[i][j] + 1 else lengths[i+1][j+1] = \ [lengths[i+1][j], lengths[i][j+1]].max end } } # read the substring out from the matrix result = "" x, y = a.size, b.size while x != 0 and y != 0 if lengths[x][y] == lengths[x-1][y] x -= 1 elsif lengths[x][y] == lengths[x][y-1] y -= 1 else # assert a[x-1] == b[y-1] result << a[x-1] x -= 1 y -= 1 end end result.reverse
end</lang>
Slate
We define this on the Sequence type since there is nothing string-specific about the concept.
Recursion
<lang slate>s1@(Sequence traits) longestCommonSubsequenceWith: s2@(Sequence traits) [
s1 isEmpty \/ s2 isEmpty ifTrue: [^ {}]. s1 last = s2 last ifTrue: [(s1 allButLast longestCommonSubsequenceWith: s2 allButLast) copyWith: s1 last] ifFalse: [| x y | x: (s1 longestCommonSubsequenceWith: s2 allButLast). y: (s1 allButLast longestCommonSubsequenceWith: s2). x length > y length ifTrue: [x] ifFalse: [y]]
].</lang>
Dynamic Programming
<lang slate>s1@(Sequence traits) longestCommonSubsequenceWith: s2@(Sequence traits) [| lengths |
lengths: (ArrayMD newWithDimensions: {s1 length `cache. s2 length `cache} defaultElement: 0). s1 doWithIndex: [| :elem1 :index1 | s2 doWithIndex: [| :elem2 :index2 | elem1 = elem2 ifTrue: [lengths at: {index1 + 1. index2 + 1} put: (lengths at: {index1. index2}) + 1] ifFalse: [lengths at: {index1 + 1. index2 + 1} put: ((lengths at: {index1 + 1. index2}) max: (lengths at: {index1. index2 + 1}))]]]. ([| :result index1 index2 | index1: s1 length. index2: s2 length. [index1 isPositive /\ index2 isPositive] whileTrue: [(lengths at: {index1. index2}) = (lengths at: {index1 - 1. index2}) ifTrue: [index1: index1 - 1] ifFalse: [(lengths at: {index1. index2}) = (lengths at: {index1. index2 - 1})] ifTrue: [index2: index2 - 1] ifFalse: ["assert: (s1 at: index1 - 1) = (s2 at: index2 - 1)." result nextPut: (s1 at: index1 - 1). index1: index1 - 1. index2: index2 - 1]] ] writingAs: s1) reverse
].</lang>
Tcl
Both solutions translated from the Java.
Recursive
<lang tcl>proc r_lcs {a b} {
if {$a eq "" || $b eq ""} {return ""} set a_ [string range $a 1 end] set b_ [string range $b 1 end] if {[set c [string index $a 0]] eq [string index $b 0]} { return "$c[r_lcs $a_ $b_]" } else { set x [r_lcs $a $b_] set y [r_lcs $a_ $b] return [expr {[string length $x] > [string length $y] ? $x :$y}] }
}</lang>
Dynamic
<lang tcl>package require Tcl 8.5 namespace import ::tcl::mathop::+ namespace import ::tcl::mathop::- namespace import ::tcl::mathfunc::max
proc d_lcs {a b} {
set la [string length $a] set lb [string length $b] set lengths [lrepeat [+ $la 1] [lrepeat [+ $lb 1] 0]]
for {set i 0} {$i < $la} {incr i} { for {set j 0} {$j < $lb} {incr j} { if {[string index $a $i] eq [string index $b $j]} { lset lengths [+ $i 1] [+ $j 1] [+ [lindex $lengths $i $j] 1] } else { lset lengths [+ $i 1] [+ $j 1] [max [lindex $lengths [+ $i 1] $j] [lindex $lengths $i [+ $j 1]]] } } }
set result "" set x $la set y $lb while {$x >0 && $x > 0} { if {[lindex $lengths $x $y] == [lindex $lengths [- $x 1] $y]} { incr x -1 } elseif {[lindex $lengths $x $y] == [lindex $lengths $x [- $y 1]]} { incr y -1 } else { if {[set c [string index $a [- $x 1]]] ne [string index $b [- $y 1]]} { error "assertion failed: a.charAt(x-1) == b.charAt(y-1)" } append result $c incr x -1 incr y -1 } } return [string reverse $result]
}</lang>
Performance Comparison
<lang tcl>% time {d_lcs thisisatest testing123testing} 10 637.5 microseconds per iteration % time {r_lcs thisisatest testing123testing} 10 1275566.8 microseconds per iteration</lang>
Ursala
This uses the same recursive algorithm as in the Haskell example, and works on lists of any type. <lang Ursala>#import std
lcs = ~&alrB^& ~&E?abh/~&alh2fabt2RC @faltPrXlrtPXXPW leql?/~&r ~&l</lang> test program: <lang Ursala>#cast %s
example = lcs('thisisatest','testing123testing')</lang> output:
'tsitest'