[Haskell-cafe] A bit of a shock - Memoizing functions
Jeremy Shaw
jeremy at n-heptane.com
Fri Mar 27 18:36:33 EDT 2009
Hello,
I've seen it done explicitly as is shown in the code below. 'f' in
'longest' is the function which is being memoized by the 'dp'. It's
pretty slick, IMO.
(not sure where this code came from. Also I may have broken it, but
you get the idea):
module Diff where
import Data.Array
-- * Dynamic Programming
dp :: (Ix a) => (a,a) -> ((a->b) -> a -> b) -> a -> b
dp bounds f = (memo!)
where memo = tabulate bounds (f (memo!))
tabulate :: (Ix a) => (a,a) -> (a -> b) -> Array a b
tabulate bounds f = array bounds [(i,f i) | i <- range bounds]
-- * Two-way diff
-- NOTE: I copied lcs/longest off the web somewhere, not sure what the license is
lcs :: Ord a => [a] -> [a] -> [(Int, Int)]
lcs xs ys = snd $ longest lenx leny xarr yarr (0,0)
where
lenx = length xs
leny = length ys
xarr = listArray (0,lenx-1) xs
yarr = listArray (0,leny-1) ys
longest :: Ord a
=> Int -> Int
-> Array Int a
-> Array Int a -> (Int, Int)
-> (Int, [(Int, Int)])
longest a b c d| a `seq` b `seq` c `seq` d `seq` False = undefined
longest lenx leny xarr yarr = dp ((0,0),(lenx,leny)) f
where
f rec (x,y)
| x'ge'lenx && y'ge'leny = (0, [])
| x'ge'lenx = y'
| y'ge'leny = x'
| xarr ! x == yarr ! y = max (match $ rec (x+1,y+1)) m
| otherwise = m
where
m = max y' x'
x'ge'lenx = x >= lenx
y'ge'leny = y >= leny
y' = miss (rec (x,y+1))
x' = miss (rec (x+1,y))
match (n,xs) = (n+1, (x,y):xs)
miss = id
-- miss z (n,xs) = (n,z:xs)
More information about the Haskell-Cafe
mailing list