lcs.hs

{-# Language OverloadedStrings #-}

import Prelude hiding (length)
import Data.Text

-- Calculates LCS of two strings without using a backtrack matrix. The helper
-- function lcs' does the actual work.
lcs :: Text -> Text -> Text
lcs s1 s2 = lcs' "" (length s1,length s2) s1 s2
  where lcs' acc (x,y) s1  s2
          -- three cases: if done, return match; if last chars match, prepend
          -- to match; otherwise return the longest match of (x-1,y) and (x,y-1)
          | x <= 0 || y <= 0 = acc
          | a == b           = lcs' (a `cons` acc) (x-1,y-1) s1 s2
          | otherwise        = let a' = lcs' acc (x-1,y) s1 s2
                                   b' = lcs' acc (x,y-1) s1 s2
                                in if length a' > length b'
                                      then a'
                                      else b'
            where -- the last character in the two strings (zero-indexed)
                  a = s1 `index` (x-1)
                  b = s2 `index` (y-1)

main :: IO ()
main = do
      -- some simple tests
      print $ lcs "" "" == ""
      print $ lcs "ATT" "ACC" == "A"
      print $ lcs "AGGGGCTTG" "ACTCCCCC" == "ACT"