diff in Haskell: clarification

[Andrew J Bromage]

G'day all.

On Fri, Nov 22, 2002 at 05:13:07AM +1100, Fergus Henderson wrote:

> Would a Mercury version help?  The Mercury distribution includes a
> Mercury version of Myer's algorithm: it's in the directory `samples/diff'.

Disclaimer: I wrote the Mercury version.

That particular algorithm heavily relies on destructively updated
arrays, which don't map neatly onto Haskell lists.  In addition,
it's pretty complicated (all the caching between passes, mostly).  It's
also optimised for very long sequences, which may not help you here.

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.

@article{360861,
 author = {D. S. Hirschberg},
 title = {A linear space algorithm for computing maximal common subsequences},
 journal = {Communications of the ACM},
 volume = {18},
 number = {6},
 year = {1975},
 issn = {0001-0782},
 pages = {341--343},
 doi = {http://doi.acm.org/10.1145/360825.360861},
 publisher = {ACM Press},
 }

Cheers,
Andrew Bromage


module Lcss ( lcss ) where

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 []