# Longest Common Subsequence and Longest Subsequence Palindrome

The following code computes:

1. The longest common subsequence between two strings, where a subsequence of a sequence does not have to consist of contiguous elements of the sequence.
2. The longest subsequence in a string that is a palindrome.

All suggestions are welcome (more idiomatic f#, optimizations, styling, etc..).

let stringReverse (s: string) =
System.String(Array.rev (s.ToCharArray()))

//assumes you don't go above the high bound of the indices
let SafeIndex (arr: int [,]) (i: int) (j: int) : int =
if i < 0 || j < 0 then
0
else
arr.[i, j]

//reconstruct *a* longest common subsequence by starting from c.[m-1,n-1], where
//m is the length of x, and n is the length of y, and backtracking to the
//nearest longest common subsequence (NW, N, or W). If going NW, the current
//character (x.[i] and y.[j]) is part of the longest common subsequence
let ConstructLCS (c: int [,]) (x: string) (y: string) =
let mutable mylcs = ""
let mutable i = x.Length - 1
let mutable j = y.Length - 1

while i >= 0 && j >= 0 do
let NW = SafeIndex c (i - 1) (j - 1)
let N = SafeIndex c (i - 1) j
let W = SafeIndex c i (j - 1)

if N > NW && i > 0 then
i <- i - 1
else if W > NW && j > 0 then
j <- j - 1
else if NW < c.[i, j] then
mylcs <- x.[i].ToString() + mylcs
i <- i - 1
j <- j - 1
else
i <- i - 1
j <- j - 1
mylcs

//Longest Common Subsequence, dynamic programming
//x and y are sequences over a given alphabet
//c is a 2d array, where c.[i, j] is the length of the longest
//  common subsequence between x.[0] .. x.[i] and y.[0] .. y.[j]
let LCS (x: string) (y: string) =
let c = Array2D.init x.Length y.Length (fun i j -> 0)

for i in 0 .. x.Length - 1 do
for j in 0 .. y.Length - 1 do
if x.[i] = y.[j] then
c.[i, j] <- 1 + SafeIndex c (i - 1) (j - 1)
else
c.[i, j] <- max (SafeIndex c (i - 1) j) (SafeIndex c i (j - 1))
c

//Longest Subsequence that is a Palindrome, dynamic programming
//start at the beginning and end of the sequence. if they are the same,
//  move each pointer to the next item and add that to the palindrome half.
//  otherwise, recurse twice (once for each pointer to move). the left pointer
//  moves to the right, and the right pointer moves to the left.
//only half the matrix will be filled (a little more than half due to diagonal)
//prepopulate 0..0, 1..1, 2..2, 3..3, etc... with ones
//  then fill 0..1, 1..2, 2..3, 3..4
//  then fill 0..2, 1..3, 2..4, 3..5
//
//  i.e...
//  do base condition
//  loop over k from 1 to str_size - 1 //there are k columns..
//    loop over i from 0 to str_size - 1 - k
//      j = i + k;
//add 2 if i and j chars are equal. will never add 1.. handled in base case.
let LSPalindrome (x: string) =
let c = Array2D.init x.Length x.Length (fun i j -> 0)

for i in 0 .. x.Length - 1 do
c.[i, i] <- 1

for k in 1 .. x.Length - 1 do
for i in 0 .. (x.Length - 1 - k) do
let j = i + k
if x.[i] = x.[j] then
c.[i, j] <- c.[i + 1, j - 1] + 2
else
c.[i, j] <- max c.[i + 1, j] c.[i, j - 1]
c

//reconstruct *a* longest subsequence palindrome by starting
//  from c.[0, m - 1], where m is the length of the string.
//if x.[i] = x.[j], then x.[i] can be added to the palindrome. otherwise,
//  recurse to the best option by moving the left or right pointer.
let ConstructLSPalindrome (c: int [,]) (x: string) =
let mutable i = 0
let mutable j = x.Length - 1
let mutable palindrome = ""

while i < j do
if x.[i] = x.[j] then
palindrome <- palindrome + x.[i].ToString()
i <- i + 1
j <- j - 1
else if c.[i + 1, j] > c.[i, j - 1] then
i <- i + 1
else
j <- j - 1

if i = j then //odd sized palindrome
palindrome <- palindrome + x.[i].ToString() + (stringReverse palindrome)
else
palindrome <- palindrome + (stringReverse palindrome)

palindrome

[<EntryPoint>]
let main argv =
let x = "agbfcecebfag"
let y = "gafbececfbga"
let char = "character"

let c = LCS x y
printfn "%A" c
printfn "%s" (ConstructLCS c x y)

let d = LSPalindrome x
printfn "%A" d
printfn "%s" (ConstructLSPalindrome d x)

let e = LSPalindrome char
printfn "%A" e
printfn "%s" (ConstructLSPalindrome e char)

0


The output follows:

[[0; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1]
[1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 2; 2]
[1; 1; 1; 2; 2; 2; 2; 2; 2; 2; 2; 2]
[1; 1; 2; 2; 2; 2; 2; 2; 3; 3; 3; 3]
[1; 1; 2; 2; 2; 3; 3; 3; 3; 3; 3; 3]
[1; 1; 2; 2; 3; 3; 4; 4; 4; 4; 4; 4]
[1; 1; 2; 2; 3; 4; 4; 5; 5; 5; 5; 5]
[1; 1; 2; 2; 3; 4; 5; 5; 5; 5; 5; 5]
[1; 1; 2; 3; 3; 4; 5; 5; 5; 6; 6; 6]
[1; 1; 2; 3; 3; 4; 5; 5; 6; 6; 6; 6]
[1; 2; 2; 3; 3; 4; 5; 5; 6; 6; 6; 7]
[1; 2; 2; 3; 3; 4; 5; 5; 6; 6; 7; 7]]
abcecba
[[1; 1; 1; 1; 1; 1; 3; 3; 5; 5; 7; 7]
[0; 1; 1; 1; 1; 1; 3; 3; 5; 5; 5; 7]
[0; 0; 1; 1; 1; 1; 3; 3; 5; 5; 5; 5]
[0; 0; 0; 1; 1; 1; 3; 3; 3; 5; 5; 5]
[0; 0; 0; 0; 1; 1; 3; 3; 3; 3; 3; 3]
[0; 0; 0; 0; 0; 1; 1; 3; 3; 3; 3; 3]
[0; 0; 0; 0; 0; 0; 1; 1; 1; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 1; 1; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 0; 1; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 0; 0; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1]]
abcecba
[[1; 1; 1; 1; 3; 5; 5; 5; 5]
[0; 1; 1; 1; 3; 3; 3; 3; 3]
[0; 0; 1; 1; 3; 3; 3; 3; 3]
[0; 0; 0; 1; 1; 1; 1; 1; 3]
[0; 0; 0; 0; 1; 1; 1; 1; 1]
[0; 0; 0; 0; 0; 1; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 1; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 1; 1]
[0; 0; 0; 0; 0; 0; 0; 0; 1]]
carac

• Look at my C# solution here. codereview.stackexchange.com/questions/43571/… It should be straight forward to eliminate the mutation of the index variables using recursion. I may give it a try when I get some time. Commented Oct 17, 2014 at 5:18
• Thanks for the link, interesting solution. We're solving different problems though. The letters in my palindrome don't have to be contiguous. The longest palindrome of "character" is "carac". With your algorithm (and that question in general), I think the answer would be "ara". Commented Oct 17, 2014 at 15:07
• Yes, I did miss the problem. I have added a response below which may be helpful. Commented Oct 18, 2014 at 5:16

Overall the code is written in a more procedural style rather than a functional style. By which I mean it would be relatively straightforward to port it to an imperative language such as C, Pascal, Python or Basic. There's nothing wrong with that in many cases, and that's why F# provides tools for writing code in a procedural manner.

• What is in a Name: What do N, W and NW mean? What exactly do i and j index?

• Names 2: What does LCS stand for? Sure with the title of the question, I can make an educated guess. But in the middle of 400 lines of code a call to ConstructLCS() could mean just about anything.

• Names 3: Finding is the level of abstraction I need when I call this as a library function. Construct tells me how the process is finding the LongestCommonSubstring.

• Functional Style 1: Pattern matching rather than nested ifs, see "Variable Matching" here. This pure syntactic sugar is what makes functional programs read like functional programs.

• Functional Style 2: Recursive tail-calls versus loops. Again it's syntactic sugar and tail-call optimization is literally the compiler unrolling recursion into loops. But it eliminates the declaration of mutable indices from the source code. To paraphrase Rich Hickey, we don't really want to change variables, we just want the next values for the parameter we are passing to our function.

• 130 lines of code with comments ;). Point taken, I just didn't care about variable names because it's well-defined math. I don't understand your third bullet point though. I'm going to convert it to using pattern matching and recursive tail-calls and then post a new question. I didn't realize tail-recursing was possible in this situation. Thanks for your answer! Commented Oct 16, 2014 at 21:04
• The third bullet point is that "construct"ing is how the function "finds" the longest string. Finding is what I care about, pulling the answer from a hash table is just fine. The comment about 400 lines is in regard to the function being called in another program, perhaps by another programmer. Commented Oct 16, 2014 at 21:43

I translated the LCS function to more idiomatic F# - with pattern matching and no mutations but a lot less efficient since the values are computed multiple times via recursion and that too not tail-recursive. For what it's worth ... it may yield some ideas.

let LCS (x: string) (y: string) =

let rec getValue i j =
match i, j  with
|   _   when i < 0 || j < 0     ->  0
|   _   when x.[i] = y.[j]      ->  1 + getValue (i - 1) (j - 1)
|   _                           ->  max (getValue (i - 1) j) (getValue i (j - 1))

Array2D.init
x.Length
y.Length
getValue