Naive implementation of Burst Balloon

The name of the pictureThe name of the pictureThe name of the pictureClash Royale CLAN TAG#URR8PPP





.everyoneloves__top-leaderboard:empty,.everyoneloves__mid-leaderboard:empty margin-bottom:0;







up vote
4
down vote

favorite
1












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:



  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

import qualified Data.List as List (permutations)

burst :: [Int] -> (Int, [Int])
burst = burstNaive

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

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

type IndexOrder = [Int]
withOrder :: IndexOrder -> [Int] -> Int
withOrder _ = 0
withOrder (i:is) xs = left * (xs !! i) * right + withOrder adjust xss
where
xss = remAt i
adjust = map (index -> if index > 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> :l Balloon.hs
[1 of 1] Compiling Balloon ( Balloon.hs, interpreted )
Ok, one module loaded.
*Balloon> burst [3,1,5,8]
(167,[1,2,0,3])
*Balloon>






share|improve this question



























    up vote
    4
    down vote

    favorite
    1












    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:



    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

    import qualified Data.List as List (permutations)

    burst :: [Int] -> (Int, [Int])
    burst = burstNaive

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

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

    type IndexOrder = [Int]
    withOrder :: IndexOrder -> [Int] -> Int
    withOrder _ = 0
    withOrder (i:is) xs = left * (xs !! i) * right + withOrder adjust xss
    where
    xss = remAt i
    adjust = map (index -> if index > 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> :l Balloon.hs
    [1 of 1] Compiling Balloon ( Balloon.hs, interpreted )
    Ok, one module loaded.
    *Balloon> burst [3,1,5,8]
    (167,[1,2,0,3])
    *Balloon>






    share|improve this question























      up vote
      4
      down vote

      favorite
      1









      up vote
      4
      down vote

      favorite
      1






      1





      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:



      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

      import qualified Data.List as List (permutations)

      burst :: [Int] -> (Int, [Int])
      burst = burstNaive

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

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

      type IndexOrder = [Int]
      withOrder :: IndexOrder -> [Int] -> Int
      withOrder _ = 0
      withOrder (i:is) xs = left * (xs !! i) * right + withOrder adjust xss
      where
      xss = remAt i
      adjust = map (index -> if index > 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> :l Balloon.hs
      [1 of 1] Compiling Balloon ( Balloon.hs, interpreted )
      Ok, one module loaded.
      *Balloon> burst [3,1,5,8]
      (167,[1,2,0,3])
      *Balloon>






      share|improve this question













      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:



      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

      import qualified Data.List as List (permutations)

      burst :: [Int] -> (Int, [Int])
      burst = burstNaive

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

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

      type IndexOrder = [Int]
      withOrder :: IndexOrder -> [Int] -> Int
      withOrder _ = 0
      withOrder (i:is) xs = left * (xs !! i) * right + withOrder adjust xss
      where
      xss = remAt i
      adjust = map (index -> if index > 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> :l Balloon.hs
      [1 of 1] Compiling Balloon ( Balloon.hs, interpreted )
      Ok, one module loaded.
      *Balloon> burst [3,1,5,8]
      (167,[1,2,0,3])
      *Balloon>








      share|improve this question












      share|improve this question




      share|improve this question








      edited May 27 at 9:26









      Vogel612♦

      20.9k345124




      20.9k345124









      asked May 23 at 9:29









      user3169543

      1604




      1604




















          1 Answer
          1






          active

          oldest

          votes

















          up vote
          4
          down vote



          accepted










          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] -> (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 -> Int -> [a] -> ((a,a,a), [a])
          moveAtStencil3 def i xs
          | i < 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 -> [Int] -> 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 -> if index > 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.






          share|improve this answer





















            Your Answer




            StackExchange.ifUsing("editor", function ()
            return StackExchange.using("mathjaxEditing", function ()
            StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix)
            StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
            );
            );
            , "mathjax-editing");

            StackExchange.ifUsing("editor", function ()
            StackExchange.using("externalEditor", function ()
            StackExchange.using("snippets", function ()
            StackExchange.snippets.init();
            );
            );
            , "code-snippets");

            StackExchange.ready(function()
            var channelOptions =
            tags: "".split(" "),
            id: "196"
            ;
            initTagRenderer("".split(" "), "".split(" "), channelOptions);

            StackExchange.using("externalEditor", function()
            // Have to fire editor after snippets, if snippets enabled
            if (StackExchange.settings.snippets.snippetsEnabled)
            StackExchange.using("snippets", function()
            createEditor();
            );

            else
            createEditor();

            );

            function createEditor()
            StackExchange.prepareEditor(
            heartbeatType: 'answer',
            convertImagesToLinks: false,
            noModals: false,
            showLowRepImageUploadWarning: true,
            reputationToPostImages: null,
            bindNavPrevention: true,
            postfix: "",
            onDemand: true,
            discardSelector: ".discard-answer"
            ,immediatelyShowMarkdownHelp:true
            );



            );








             

            draft saved


            draft discarded


















            StackExchange.ready(
            function ()
            StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f195006%2fnaive-implementation-of-burst-balloon%23new-answer', 'question_page');

            );

            Post as a guest






























            1 Answer
            1






            active

            oldest

            votes








            1 Answer
            1






            active

            oldest

            votes









            active

            oldest

            votes






            active

            oldest

            votes








            up vote
            4
            down vote



            accepted










            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] -> (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 -> Int -> [a] -> ((a,a,a), [a])
            moveAtStencil3 def i xs
            | i < 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 -> [Int] -> 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 -> if index > 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.






            share|improve this answer

























              up vote
              4
              down vote



              accepted










              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] -> (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 -> Int -> [a] -> ((a,a,a), [a])
              moveAtStencil3 def i xs
              | i < 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 -> [Int] -> 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 -> if index > 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.






              share|improve this answer























                up vote
                4
                down vote



                accepted







                up vote
                4
                down vote



                accepted






                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] -> (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 -> Int -> [a] -> ((a,a,a), [a])
                moveAtStencil3 def i xs
                | i < 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 -> [Int] -> 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 -> if index > 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.






                share|improve this answer













                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] -> (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 -> Int -> [a] -> ((a,a,a), [a])
                moveAtStencil3 def i xs
                | i < 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 -> [Int] -> 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 -> if index > 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.







                share|improve this answer













                share|improve this answer



                share|improve this answer











                answered May 24 at 17:37









                Zeta

                14.3k23267




                14.3k23267






















                     

                    draft saved


                    draft discarded


























                     


                    draft saved


                    draft discarded














                    StackExchange.ready(
                    function ()
                    StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f195006%2fnaive-implementation-of-burst-balloon%23new-answer', 'question_page');

                    );

                    Post as a guest













































































                    Popular posts from this blog

                    Greedy Best First Search implementation in Rust

                    Function to Return a JSON Like Objects Using VBA Collections and Arrays

                    C++11 CLH Lock Implementation