content: {-
  From: Andrew J Bromage <ajb@spamcop.net>
  Date: Fri, 22 Nov 2002 13:49:13 +1100
  To: haskell@haskell.org
  Subject: Re: diff in Haskell: clarification
  
  Just for jollies, here's a Haskell version of Hirschberg's LCSS
  algorithm.  It's O(N^2) time but O(N) space at any given point in
  time, assuming eager evaluation.  You should be able to make diff out
  of this.  You should also be able to find many opportunities for
  optimisation here.
  -}
  
  module Main (main) where
  
  import System.Environment
  
  algb :: (Eq a) => [a] -> [a] -> [Int]
  algb xs ys
    = 0 : algb1 xs [ (y,0) | y <- ys ]
    where
      algb1 [] ys' = map snd ys'
      algb1 (x:xs) ys'
        = algb1 xs (algb2 0 0 ys')
        where
  	algb2 _ _ [] = []
  	algb2 k0j1 k1j1 ((y,k0j):ys)
  	  = let kjcurr = if x == y then k0j1+1 else max k1j1 k0j
  	    in (y,kjcurr) : algb2 k0j kjcurr ys
  
  algc :: (Eq a) => Int -> Int -> [a] -> [a] -> [a] -> [a]
  algc m n xs []  = id
  algc m n [x] ys = if x `elem` ys then (x:) else id
  algc m n xs ys
    = algc m2 k xs1 (take k ys) . algc (m-m2) (n-k) xs2 (drop k ys)
    where
      m2 = m `div` 2
  
      xs1 = take m2 xs
      xs2 = drop m2 xs
  
      l1 = algb xs1 ys
      l2 = reverse (algb (reverse xs2) (reverse ys))
  
      k = findk 0 0 (-1) (zip l1 l2)
  
      findk k km m [] = km
      findk k km m ((x,y):xys)
        | x+y >= m  = findk (k+1) k  (x+y) xys
        | otherwise = findk (k+1) km m     xys
  
  lcss :: (Eq a) => [a] -> [a] -> [a]
  lcss xs ys = algc (length xs) (length ys) xs ys []
  
  main = do 
   [a,b,c,d,e,f] <- getArgs
   let a', b', c', d', e', f' :: Int
       a' = read a; b' = read b; c' = read c; 
       d' = read d; e' = read e; f' = read f
   print (lcss [a',b'..c'] [d',e'..f'])
  