Longest Common Subsequence and Longest Subsequence Palindrome

Question

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

Answer 1

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.

A few comments:

• 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.

Answer 2

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