trjhtr

Continuing where I left off previously to solve the problem described here, I've now solved the same using dynamic programming (following Tikhon Jelvis blog on DP).

To refresh, the challenge is to find a sequence in which to burst a row of balloons that will earn the maximum number of coins. Each time balloon $i$ is burst, we earn $C_i-1 cdot C_i cdot C_i+1$ coins, then balloons $i-1$ and $i+1$ become adjacent to each other.

import qualified Data.Array as Array


burstDP :: [Int] -> Int
burstDP l = go 1 len
 where
 go left right | left <= right = maximum [ds Array.! (left, k-1)
 + ds Array.! (k+1, right)
 + b (left-1)*b k*b (right+1) | k <- [left..right]]
 | otherwise = 0
 len = length l
 ds = Array.listArray bounds
 [go m n | (m, n) <- Array.range bounds]
 bounds = ((0,0), (len+1, len+1))
 l' = Array.listArray (0, len-1) l
 b i = if i == 0 || i == len+1 then 1 else l' Array.! (i-1)

I'm looking for:

1. Correctness


2. Program structure


3. Idiomatic Haskell


4. Any other higher order functions that can be used


5. Other optimizations that can be done

Your use of Array for memoization can be extracted into array-memoize.

If one can stop instead of having negative balloons decrease score, go can be condensed into one case.

import Data.Function.ArrayMemoize (arrayMemoFix)
import Data.Array ((!), listArray)

burstDP :: [Int] -> Int
burstDP l = arrayMemoFix ((0,0), (len+1, len+1)) go (1, len) where
 go ds (left, right) = maximum $ 0 :
 [ds (left, k-1) + ds (k+1, right) + b (left-1)*b k*b (right+1) | k <- [left..right]]
 b = (!) $ listArray (0, len+1) (1 : l ++ [1])
 len = length l

If you don't care too much about performance, we can also memoize directly on the balloon list:

burstDP :: [Int] -> Int
burstDP = memoFix3 go 1 1 where go ds l r b = maximum
 [ ds left l x + ds right x r + l*x*r
 | (left, x:right) <- zip (inits b) (tails b)
 ]