# 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. – JungHwan Min Aug 21 '16 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 '16 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? – JungHwan Min Aug 21 '16 at 15:57
• @JHM I added the codes above. The maxpath function I defined outputs the position list. – Αλέξανδρος Ζεγγ Aug 21 '16 at 16:23
• Solve #67 first, then 18 will be easy. :^) – Mr.Wizard Aug 22 '16 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 :) – ubpdqn Aug 22 '16 at 21:42
• Thanks! This makes me know what went wrong. – Αλέξανδρος Ζεγγ Aug 25 '16 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])];
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]]],
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}];

• 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". – Daniel Lichtblau Aug 22 '16 at 21:36