Posts Tagged ‘common’

Programming Praxis – Lowest Common Ancestor

March 11, 2011

In today’s Programming Praxis exercise, our goal is to write an algorithm to find the lowest common ancestor of two nodes in a binary tree. Let’s get started, shall we?

First, we define a binary tree data structure.

data BinTree a = Node a (BinTree a) (BinTree a) | Nil

The algorithm is pretty trivial: if the higher value is less than the current node, descend the left branch. If the lower value is higher than the current node, descend the right branch. Otherwise, we’ve found our result.

lca :: Ord a => a -> a -> BinTree a -> a
lca m n ~(Node v l r) | n < v     = lca m n l
                      | m > v     = lca m n r
                      | otherwise = v

Some tests to see if everything is working properly:

main :: IO ()
main = do let tip n = Node n Nil Nil
          let tree = Node 8 (Node 3 (tip 1) (Node 6 (tip 4) (tip 7)))
                            (Node 10 Nil (Node 14 (tip 13) Nil))
          print $ lca 4  7 tree == 6
          print $ lca 4 10 tree == 8
          print $ lca 1  4 tree == 3
          print $ lca 1  3 tree == 3
          print $ lca 3  6 tree == 3

Yup. Simple enough.

Programming Praxis – Longest Common Subsequence

June 9, 2009

Today‚Äôs Programming Praxis problem is about finding the longest common subsequence of two sequences, and our target is 23 lines. Let’s go.

Our import:

import Data.Array

Hackage doesn’t seem to have an easily installable matrix package (hmatrix needs some C libraries), so we’re going to use an Array of Arrays to represent the grid of numbers. We’re going to define a little convenience function to access elements in the 2D array.

at :: Int -> Int -> Array Int (Array Int e) -> e
at x y a = a ! y ! x

And the longest common subsequence function itself.

lcs :: Eq a => [a] -> [a] -> [a]
lcs xs ys = reverse $ walk imax jmax where
    imax = length xs
    jmax = length ys
    ax = listArray (1, imax) xs
    ay = listArray (1, jmax) ys
    ls = listArray (0, jmax) [listArray (0, imax)
               [lcs' i j | i <- [0..imax]] | j <- [0..jmax]]

    lcs' 0 _ = 0
    lcs' _ 0 = 0
    lcs' i j | ax ! i == ay ! j = 1 + at (i-1) (j-1) ls
             | otherwise        = max (at (i-1) j ls) (at i (j-1) ls)

    walk 0 _ = []
    walk _ 0 = []
    walk i j | at (i-1) j ls == at i j ls = walk (i-1) j
             | at i (j-1) ls  < at i j ls = ax ! i : walk i (j-1)
             | otherwise                  = walk i (j-1)

And the usual test:

main :: IO ()
main = print $ lcs "programming" "praxis"

19 lines. Not much of an improvement. More importantly, the speed is far from optimal. The lcs in Data.List.LCS is considerably faster (though considerably longer). If anyone knows a better version, I’m all ears.