# Project Euler Problem 18 (Haskell) – Maximum path sum I

Posted on

Problem

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]
``````

Solution

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.