Project Euler Problem 18 (Haskell) - Maximum path sum I

Question

I've implemented the solution to Project Euler Problem 18 in Haskell and I'd like to get some thoughts on my implementation. Its the dynamic programming solution, working from the bottom up.

Basically, given a set of numbers in a triangular shape, the path whose numbers add up to the greatest possible sum from the top to the bottom must be found.

I believe its correct, but with Project Euler being partially down, I couldn't plug-in the answer so I had to rely on Google. I get the following result: 1074.

My code reads in a text file that contains the problem data and looks like this:

75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

Here is my full implementation:

-- Project Euler
-- Problem 18 (http://projecteuler.net/problem=18)
-- Nathan Jackson

import System.Environment
import System.IO

-- Read in a text file containing the problem data, run the algorithm and
-- print the result to the console.
main :: IO ()
main = do
    cmdargs <- getArgs
    withFile (head cmdargs) ReadMode (\handle -> do
        contents <- hGetContents handle
        let inputData = parse contents
        putStrLn $ show $ maxPathSum inputData)

-- Given a string whose format looks something like this:
--   1
--   2 3
--   4 5 6
--   7 8 9 0
-- Convert it to a list of lists that contains integers where each nested list
-- represents a line from the original string.
parse :: String -> [[Int]]
parse s  = map (map (read :: String -> Int)) (map words $ lines s)

-- Reduces a list of lists containing integers to its maximum path sum.
maxPathSum :: [[Int]] -> Int
maxPathSum [[x]] = x
maxPathSum xs =
    let maxPairs ys = zipWith max ys $ tail ys
        sx = reverse xs
    in maxPathSum $ ((init . init) xs) ++ [zipWith (+) (maxPairs (head sx)) $ sx !! 1]

Answer 1

I'll focus on maxPathSum as this is the core part of the algorithm.

The approach of zipWith max ys (tail ys) is correct and very nice, this is the essence of the recursive step.

But first, you're doing a lot of unnecessary computations at every step. In particular, you're reversing the argument list every time (reverse xs) and at the same time, you're computing its initial part (init . init $ xs), they're all O(n). If you instead start with an already reversed list, you can save all this effort, replacing O(n) init with O(1) tail, and O(n) ++ [...] with O(1) : ...:

maxPathSum2 :: [[Int]] -> Int
maxPathSum2 = mps . reverse
  where
    maxPairs ys = zipWith max ys $ tail ys
    mps [[x]] = x
    mps sx = mps $ (zipWith (+) (maxPairs (head sx)) (sx !! 1)) : (tail . tail) sx

Note that placing maxPairs out of mps also helps the readability as it's now clear nothing there depends on sx.

Next thing is that you're combining the intermediate results with the data structure you're processing. While conceptually it isn't incorrect, in this case it makes the algorithm harder to understand and more complex. So let's add a parameter to mps that will hold the intermediate path lengths (and initialize it with an infinite list of 0s):

maxPathSum3 :: [[Int]] -> Int
maxPathSum3 = mps (repeat 0) . reverse
  where
    maxPairs ys = zipWith max ys $ tail ys
    mps [r] [] = r
    mps rs (s:ss) = mps (zipWith (+) (maxPairs rs) s) ss

Not only this is much simpler; notice that now we've just reinvented a fold over the list! We're consuming the list, passing the rest for further processing, and accumulating a result. Since we're consuming the elements from the start, this is a left fold. So let's rewrite it as

maxPathSum4 :: [[Int]] -> Int
maxPathSum4 = head . foldl f (repeat 0) . reverse
  where
    maxPairs ys = zipWith max ys $ tail ys
    f rs s = zipWith (+) (maxPairs rs) s

But left fold over a reversed list is just a right fold. So we get

maxPathSum5 :: [[Int]] -> Int
maxPathSum5 = head . foldr f (repeat 0)
  where
    maxPairs ys = zipWith max ys $ tail ys
    f s rs = zipWith (+) (maxPairs rs) s

And this is actually a very natural way how to express the solution: If we already know the longest paths in the part below a particular level (represented by rs and in recursive right-fold), we can compute the paths for this level as well.