CODEWITHSUNDEEP
haskellgenericsrecursion
Liao Pengyu
Liao Pengyu

Reputation: 601

Haskell make the memoization of algebraic recursion generic

My idea is to do something like:

class Memo1D m where -- for one-Dimensional function
    memo1D :: m a -> [a]

instance Memo1D ((->) Int) where
    memo1D f = map f [0 ..]

So, to add memoization to a Integer-recursive-problem would be very generic:

fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = (memo_fib !! (n - 1)) + (memo_fib !! (n - 2))
memo_fib = memo1D fib

And furthermore, if I also want to do the memoization in 2-D function, recieve 2 Integer as parameters, I have to add more code (the (Int->Int->) is error, how to declare it?):

class Memo2D m where
    memo2D :: m a -> [[a]]
instance Memo2D (Int -> Int ->) where -- (Int -> Int ->) is error, how to declare the kind that recieve `a` type and then become (Int->Int->a) ?
    memo2D f = map (\v -> map v [0 ..]) (map f [0 ..])

And the "2-D fibnacci number" with memoization would be coded like:

fib2 0 0 = 1
fib2 0 1 = 1
fib2 1 0 = 1
fib2 i j = if j > 0 then memo_fib2 !! i !! (j - 1) else 0 +
           if j > 1 then memo_fib2 !! i !! (j - 2) else 0 +
           if i > 0 then memo_fib2 !! (i - 1) !! j else 0 +
           if i > 1 then memo_fib2 !! (i - 2) !! j else 0
memo_fib2 = memo2D fib2

And for 3-D, 4-D, etc. I also have to type corresponding class and instance. Is there a way to make these elegant and effective on multiple-dimension function, in here the multiple-dimension specific for the (Int->Int-> ... -> a) kind function?

Upvotes: 0

Views: 78

Answers (1)

Cactus
Cactus

Reputation: 27646

How about something like below. However, in practice you could just pick one of the existing memoization libraries from Hackage.

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

class Memo m a where
    memo :: m -> a

instance Memo a a where
    memo = id

instance (Memo m a) => Memo (Int -> m) [a] where
    memo f = map (memo . f) [0..]

fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = memo_fib (n - 1) + memo_fib (n - 2)
memo_fib = (memo fib !!)

fib2 0 0 = 1
fib2 0 1 = 1
fib2 1 0 = 1
fib2 i j = sum . concat $ [ [ memo_fib2 i (j-1) | j > 0 ]
                          , [ memo_fib2 i (j-2) | j > 1 ]
                          , [ memo_fib2 (i-1) j | i > 0 ]
                          , [ memo_fib2 (i-2) j | i > 1 ]
                          ]
memo_fib2 = let tab = memo fib2 in \x y -> tab !! x !! y

Upvotes: 1

Related Questions