I realized that there is a simplification which makes the transformation more obvious. I should have put the base case inside the recursive step, rather than special-casing it:
module Main where
import Data.Map.Strict as Map
import Data.Vector as Vec
-- The recursive step
rec :: (Int -> [[Int]]) -> Int -> [[Int]]
rec rec 0 = [[]]
rec rec n = do
this <- [1..n]
other <- rec (n - this)
return $ (this : other)
-- Non-dynamic
sumsTo1 :: Int -> [[Int]]
sumsTo1 = rec sumsTo1
-- Dynamic (corecursive)
sumsTo2 :: Int -> [[Int]]
sumsTo2 n = lookup Map.! n
where
lookup = go 0 Map.empty
go m acc | m > n = acc
| otherwise = go (m + 1) (Map.insert m (rec (acc Map.!) m) acc)
-- Dynamic (lazy)
sumsTo3 :: Int -> [[Int]]
sumsTo3 n = lookup Vec.! n
where
lookup = generate (n + 1) $ rec (lookup Vec.!)
main = do
let a = sumsTo1 10
b = sumsTo2 10
c = sumsTo3 10
print (a == b && b == c)
print a
Also, to expand on this:
* Corecursive DP is good in cases where you can figure out which order to generate things in, especially if you can drop no-longer-relevant data as you go
* Lazy DP (using Vector) is good and fast in the case where the data is dense in the (n-dimensional) integers. Also very elegant!
* If your DP dependency graph doesn't have any nice properties (not trivially dense in the integers, not easily predictable dependencies), you can implement your algorithm using e.g. a State monad over a map of cached values. However, I think this requires the recursive step to be written in terms of a monad rather than a non-monadic function (so that you can interrupt the control flow of the recursive step).