4
\$\begingroup\$

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
\$\endgroup\$
2
  • \$\begingroup\$ This code isn't complete. What's Array? \$\endgroup\$ Commented May 24, 2018 at 17:36
  • \$\begingroup\$ @Zeta Data.Array imported from the array package \$\endgroup\$ Commented May 25, 2018 at 16:55

1 Answer 1

Reset to default
1
\$\begingroup\$

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)
  ]
\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.