# Euler Project Problem 18

I use Mathematica to implement a function, which output the position path in the triangle required. And the elements are found to be {75, 95, 47, 87, 82, 75, 73, 28, 83, 47, 43, 73, 91, 67, 98}, which totals up to 1064.

I even checked the elements manually and they should be the above list. But the sum of them are told not correct and I cannot understand it why.

Anyone gets any ideas what went wrong?

The problem is here.

My function used to find the path is defined in WL as below:

maxpath[datf_] := Block[{i = 1, j = 1, list = {1}, dat = datf},
While[i < Length[dat],
If[#[[2, j]] > #[[2, j + 1]], AppendTo[list, j],
j++ && AppendTo[list, j]] &@dat; dat = RotateLeft[dat]; i++
];
{Range[Length[dat]], list}//Transpose
]

The structure of "datf" is a triangular list:

{{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}}
• We can't tell you what went wrong if you don't tell us what you did. Aug 21, 2016 at 15:37
• @JHM I just want to make sure if there is anything wrong with the above list as the maximum path elements in the given triangle, which gets only 15 rows, and therefore it is not difficult to pick out the elements even by naked eyes, right? Aug 21, 2016 at 15:44
• As a Eulerian myself, I can only tell you that you were close. Could you describe your algorithm if you can't post the code here? Aug 21, 2016 at 15:57
• @JHM I added the codes above. The maxpath function I defined outputs the position list. Aug 21, 2016 at 16:23
• Solve #67 first, then 18 will be easy. :^) Aug 22, 2016 at 10:06

Anyone gets any ideas what went wrong?

The issue with this algorithm is that the tree is visited from the root to the leaves, and several paths are dismissed at once based on the values at a given level, without knowing the values at deeper levels.

Specifically, there is no way to ensure that a deleted path does not contain numbers with higher values that will yield in the end a greater total.

ubpdqn has provided a nice Grid in his answer that shows this point. If you look at the graph {3, 2} therein, the path sums up to 1068, so a greater value than yours, but it has selected the value 64 at the second step, while yours selected 95.

As a simple example, consider the values:

datf2 = {{1}, {1, 0}, {1, 1, 10}}

The path of maximum sum is {1, 0, 10}. Using your algorithm, one gets:

maxpath[datf2];
Extract[datf2, %]
(* {1, 1, 1} *)

All paths starting with {1, 0, ...} were dismissed at the second step.

• thanks for answering the question: +1 :) Aug 22, 2016 at 21:42
• Thanks! This makes me know what went wrong. Aug 25, 2016 at 6:42

This does not answer the reason for the failure of the code. I think this requires more information. However, this is a brute force approach:

Importing

is = ImportString["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", "List"];
ist = ToExpression /@ ({{is[[1]]}}~Join~(StringSplit /@ is[[2 ;;]]));

Creating graph and evaluating paths:

grp = Flatten[
Table[{{i, j} -> {i + 1, j}, {i, j} -> {i + 1, j + 1}}, {i,
14}, {j, i}]];
gv = Graph[grp, VertexWeight -> (Flatten[ist])];
rules = Thread[VertexList[gv] -> Range[120]]
gvm = Graph[grp /. rules,
VertexLabels ->
120] -> (Placed[Style[#, 10], Center] & /@ Flatten[ist])],
VertexWeight -> Flatten[ist], VertexSize -> 0, ImageSize -> 500,
EdgeStyle -> White]
fun[v_] := PropertyValue[{gvm, v}, VertexWeight];
func[v_] := Module[{paths = FindPath[gvm, 1, v, {14}, All], tot, pck},
tot = Total /@ Map[fun, paths, {2}];
pck = {Max[tot], Extract[paths, Position[tot, Max[tot]]]}
]
vis[v_] :=
With[{path = func[v], ru = Thread[Range[120] -> Flatten[ist]]},
Column[{HighlightGraph[gvm, PathGraph[path[[2, 1]]],
Epilog -> {Red, Thickness[.005], Arrowheads[.02],
Arrow /@ Partition[GraphEmbedding[gvm][[path[[2, 1]]]], 2, 1]}],
Row[{StringJoin[Riffle[ToString /@ (path[[2, 1]] /. ru), "+"]],
"=", path[[1]]}]
}, Alignment -> Center]]

So:

Grid[Partition[vis /@ Range[106, 120], 3], Frame -> All]

As a 'reality check' and given OP putative answer:

check[v_] := Module[{paths = FindPath[gvm, 1, v, {14}, All], tot, pck},
tot = Map[fun, paths, {2}];
SortBy[Thread[{tot, Total /@ tot}], Last]
]
Length@check[113]
Grid[check[113][[-2 ;; -1]]]

So 3432 paths were tested and the OP putative solution is not largest for given source and target.

I apologize for any errors. Perhaps it can be a comparator for OP answers.

• This is a nice answer. Aug 22, 2016 at 16:30
• But...the max is actually 1074, from the path {75, 64, 82, 87, 82, 75, 73, 28, 83, 32, 91, 78, 58, 73, 93}. I believe this is a form of "trickle-down optonomics". Aug 22, 2016 at 21:36
• @DanielLichtblau yes...I just didn't do the last step...just wanted show 'candidate path' and in particular path mentioned in OP not largest (either for that bottom row end point or overall). I could have easily made a mistake here but maybe motivates others.:) Aug 22, 2016 at 21:41