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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.