Naive implementation of Burst Balloon As part of learning Haskell, I'm solving few problems, usually solved imperatively. 

I've come up with a naive solution for the problem described here, which 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.

I would like to get few comments on the naive implementation below before solving it using dynamic programming.

What I'm looking for is:


Correctness
Program structure
Idiomatic Haskell
Any other higher order functions that can be used
Other optimizations that can be done




import qualified Data.List as List (permutations)

burst :: [Int] -&gt; (Int, [Int])
burst = burstNaive

burstNaive :: [Int] -&gt; (Int, [Int])
burstNaive = foldl (\a@(aVal,_) e@(eVal,_) -&gt; if eVal &gt; aVal then e else a) (0, []) . allOrders

allOrders :: [Int] -&gt; [(Int, [Int])]
allOrders []       = []
allOrders l@(x:xs) = map (\p -&gt; (flip withOrder l p, p))$ List.permutations [0..length l - 1]

type IndexOrder = [Int]
withOrder :: IndexOrder -&gt; [Int] -&gt; Int
withOrder []     _  = 0
withOrder (i:is) xs = left * (xs !! i) * right + withOrder adjust xss
  where
    xss = remAt i
    adjust = map (\index -&gt; if index &gt; i then index - 1 else index) is
    left  = if i == 0 then 1 else xs !! (i-1)
    right = if i == (length xs - 1) then 1 else xs !! (i+1)
    remAt index = let (f,s) = splitAt index xs in f ++ drop 1 s


Sample Output:

Prelude&gt; :l Balloon.hs
[1 of 1] Compiling Balloon          ( Balloon.hs, interpreted )
Ok, one module loaded.
*Balloon&gt; burst [3,1,5,8]
(167,[1,2,0,3])
*Balloon&gt;
First of all, it's great that you've used type signatures for all your functions. Also, all used functionality is hidden away in helpers, which is also a plus.



We can rewrite burstNative with  maximumBy and comparing:

import Data.List (maximumBy)
import Data.Ord (comparing)

burstNaive :: [Int] -&gt; (Int, IndexOrder)
burstNaive [] = (0, [])
burstNaive xs = maximumBy (comparing fst) . allOrders $ xs


While it's possible to use ((0, []) . allOrders instead of the pattern matching, matching makes the base case more visible.

Also, this is a perfect spot to use IndexOrder instead of [Int].



In withOrder we traverse the list too often. Since lists are just forward linked lists in Haskell, we have to walk through the list four times, once for left, once for right, once for xs !! i and once for splitAt. That's a handful. So instead let's do that only once:

-- def: default value if list is too short/at end
moveAtStencil3 :: a -&gt; Int -&gt; [a] -&gt; ((a,a,a), [a])
moveAtStencil3 def i xs 
   | i &lt; 1     = let (m:r:_) = xs in ((def, m, r), drop 1 xs)
   | otherwise = let (as,bs) = splitAt (i - 1) xs
                     (l:m:r) = take 3 (bs ++ repeat def) 
                 in ((l,m,r), as ++ (l : r : drop 3 bs)

withOrder :: IndexOrder -&gt; [Int] -&gt; Int
withOrder []     _  = 0
withOrder (i:is) xs = left * middle * right + withOrder adjusted xss
  where
    ((left, middle, right), xss) = moveAtStencil3 1 i xs
    adjusted = map (\index -&gt; if index &gt; i then index - 1 else index) is


While we're at it, I renamed adjust to adjusted. Verbs (adjust) are usually functions, whereas adjusted is a list.



We could replace permutations in allOrders with recursion, but that wouldn't change much.