Robust/src/Benchmarks/Scheduling/GC/lcss/Main.hs

   1 {-
   2 From: Andrew J Bromage <ajb@spamcop.net>
   3 Date: Fri, 22 Nov 2002 13:49:13 +1100
   4 To: haskell@haskell.org
   5 Subject: Re: diff in Haskell: clarification
   6
   7 Just for jollies, here's a Haskell version of Hirschberg's LCSS
   8 algorithm.  It's O(N^2) time but O(N) space at any given point in
   9 time, assuming eager evaluation.  You should be able to make diff out
  10 of this.  You should also be able to find many opportunities for
  11 optimisation here.
  12 -}
  13
  14 module Main (main) where
  15
  16 import System
  17
  18 algb :: (Eq a) => [a] -> [a] -> [Int]
  19 algb xs ys
  20   = 0 : algb1 xs [ (y,0) | y <- ys ]
  21   where
  22     algb1 [] ys' = map snd ys'
  23     algb1 (x:xs) ys'
  24       = algb1 xs (algb2 0 0 ys')
  25       where
  26         algb2 _ _ [] = []
  27         algb2 k0j1 k1j1 ((y,k0j):ys)
  28           = let kjcurr = if x == y then k0j1+1 else max k1j1 k0j
  29             in (y,kjcurr) : algb2 k0j kjcurr ys
  30
  31 algc :: (Eq a) => Int -> Int -> [a] -> [a] -> [a] -> [a]
  32 algc m n xs []  = id
  33 algc m n [x] ys = if x `elem` ys then (x:) else id
  34 algc m n xs ys
  35   = algc m2 k xs1 (take k ys) . algc (m-m2) (n-k) xs2 (drop k ys)
  36   where
  37     m2 = m `div` 2
  38
  39     xs1 = take m2 xs
  40     xs2 = drop m2 xs
  41
  42     l1 = algb xs1 ys
  43     l2 = reverse (algb (reverse xs2) (reverse ys))
  44
  45     k = findk 0 0 (-1) (zip l1 l2)
  46
  47     findk k km m [] = km
  48     findk k km m ((x,y):xys)
  49       | x+y >= m  = findk (k+1) k  (x+y) xys
  50       | otherwise = findk (k+1) km m     xys
  51
  52 lcss :: (Eq a) => [a] -> [a] -> [a]
  53 lcss xs ys = algc (length xs) (length ys) xs ys []
  54
  55 main = do
  56  [a,b,c,d,e,f] <- getArgs
  57  let a', b', c', d', e', f' :: Int
  58      a' = read a; b' = read b; c' = read c;
  59      d' = read d; e' = read e; f' = read f
  60  print (lcss [a',b'..c'] [d',e'..f'])