Euler Project Problem 18
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 ->
Thread[Range[
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.
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.