patternMinor

Finding heaviest path through triangle

Submitted by: @import:stackexchange-codereview·Mar 10, 2026·

Viewed 0 times

pathheaviestfindingtrianglethrough

Problem

I am doing Project Euler problem 67 which involves finding the heaviest path through a triangle of integers like this one (this is a smaller version from an earlier problem)

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

This is my code:

import Control.Monad (liftM)

addRows :: Integral a => [a] -> [a] -> [a]
addRows xs@(x:_) (y:ys) = x + y : addMid xs ys ++ [last xs + last ys]
    where addMid (a:b:bs) (c:cs) = c + max a b : addMid (b:bs) cs
          addMid _         _     = []

parse :: (Integral a, Read a) => String -> [[a]]
parse = map ((read ) . words) . lines

main = do 
    tri <- liftM parse $ readFile "Triangles.txt" 
    return $ maximum . foldl1 addRows $ tri

The above code works, however it seems inefficient in some respects. It seems like I'm not being as lazy as I should be with regards to my concatenation and use of last.

Solution

The last element...

It seems like I'm not being as lazy as I should be with regards to my concatenation and use of last.

Yes. Let's have a look at an example and check addRow's behaviour:

6
     1   4
   3   5   2
 9   1   2   6

addRows [6] [1, 4] = (6 + 1) : addMid [6] [4] ++ [6 + 4]            (1)
                   = 7       : []             ++ [10]
                   = [7, 10]

addRows [7, 10] [3, 5, 2] = (7 + 3) : [5 + max 7 10] ++ [10 + 2]    (2)
                          = [10, 15, 12]

Let's check how often you actually use each number. In (1), you use 6 twice, and both 1 and 4 once. In (2), you use 7 twice, 10 twice, and all of the other numbers once. Hm. Does this hold for a fourth line?

addRows [10, 15, 12] [9, 1, 2, 6] 
     = (10 + 9) : addMid [10, 15, 12] [1, 2, 6] ++ [12 + 6]
     = (10 + 9) : 1 + (max 10 15) : 2 + (max 15 12) : [] ++ [12 + 6]

Using a function that "does things right"

This pattern seems to hold. You always use the elements in the first list twice, and the once in the second list only, well, once. This sound like it should be possible to zipWith the first elements with themselves somehow. If we were able to pattern match on the last element, this would be

(x:xs:[y]) -> x : zipWith max (x:xs:[y]) (xs:[y]) ++ [y]

However, the dreaded last element makes this hard. We could write our own zip function:

transformLine :: (Ord a) => [a] -> [a]
transformLine xs@(x:_) = x : go xs
  where
    go [y]           = y
    go (a: ys@(b:_)) = max a b : go ys

It's important that we only use cons to gain a maximum of laziness. This function will transform a line into another that's exactly one number longer:

transformLine [6]   == [6, 6]
transformLine [1,4] == [1, 4, 4]

It is therefore a list that can simply get summed onto the next line:

[6,  6]   |->   [ 7, 10, 10]    | ->  [10, 15, 15, 12]
 +  [1,  4]   |   + [ 3,  5,  2]    |   + [ 9,  1,  2,  6]
 =  [7, 10] ->|   = [10, 15, 12] -> |   = [19, 16, 17, 18]

That way, addRows is simply

addRows xs ys = zipWith (+) (transformLine xs) ys

Turn your world upside down

However, we can also turn the triangle upside down and start with the longer lines:

9   1   2   6
   3   5   2
     1   4
       6

Which makes this a lot easier, because we're now reducing the information instead of gaining additional:

/ 9 1 2   (init first line)  \
 max                               \
     \ 1 2 6   (tail first line)    (+)
                                   /
       3 5 2   (second line       /

Or, in actual code:

addRows :: (Num a, Ord a) => [a] -> [a] -> [a]
addRows xs ys = zipWith (+) ys $ zipWith max xs (tail xs)

However, now it's necessary to reverse the triangle beforehand or flip the arguments of addRows:

head . foldr1 addRows . reverse $ tri

head . foldr1 (flip addRows) $ tri

Note that head is fine here, since addRows always decreases the number of elements in the accumulating list, therefore you end up with a singleton. Also note that foldr is usually lazier on lists.

... and the oddities

While the previous section was concerned with laziness and last, this one contains general remarks:

import Control.Monad (liftM)

This isn't necessary, since IO is also an instance of Functor. And since the Applicative-Monad-Proposal every Monad is also an Applicative and therefore a Functor.

parse = map ((read ) . words) . lines

The ` here is quite hard to read, especially since there are two operators next to each other ( and (.)). A simple fmap

 is easier to the eye:

parse = map (fmap read . words) . lines


Alternatively use

map

, since you're working with lists.

main = 
    ...
    return $ maximum ...

main should have the type IO (). If you want to print the number, use print instead of return

.

Summary

Other than the few oddities, well done. The

last

 issue isn't that easy to solve unless you write another function or change your point of view. However, if you manage to actually reduce the amount of available information in your

fold*`, your usually on the right track.

Code Snippets

6
     1   4
   3   5   2
 9   1   2   6

addRows [6] [1, 4] = (6 + 1) : addMid [6] [4] ++ [6 + 4]            (1)
                   = 7       : []             ++ [10]
                   = [7, 10]

addRows [7, 10] [3, 5, 2] = (7 + 3) : [5 + max 7 10] ++ [10 + 2]    (2)
                          = [10, 15, 12]

addRows [10, 15, 12] [9, 1, 2, 6] 
     = (10 + 9) : addMid [10, 15, 12] [1, 2, 6] ++ [12 + 6]
     = (10 + 9) : 1 + (max 10 15) : 2 + (max 15 12) : [] ++ [12 + 6]

(x:xs:[y]) -> x : zipWith max (x:xs:[y]) (xs:[y]) ++ [y]

transformLine :: (Ord a) => [a] -> [a]
transformLine xs@(x:_) = x : go xs
  where
    go [y]           = y
    go (a: ys@(b:_)) = max a b : go ys

Context

StackExchange Code Review Q#118263, answer score: 2

Revisions (0)

No revisions yet.