5
$\begingroup$

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}}
$\endgroup$
  • $\begingroup$ We can't tell you what went wrong if you don't tell us what you did. $\endgroup$ – JungHwan Min Aug 21 '16 at 15:37
  • $\begingroup$ @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? $\endgroup$ – Αλέξανδρος Ζεγγ Aug 21 '16 at 15:44
  • 1
    $\begingroup$ 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? $\endgroup$ – JungHwan Min Aug 21 '16 at 15:57
  • $\begingroup$ @JHM I added the codes above. The maxpath function I defined outputs the position list. $\endgroup$ – Αλέξανδρος Ζεγγ Aug 21 '16 at 16:23
  • 2
    $\begingroup$ Solve #67 first, then 18 will be easy. :^) $\endgroup$ – Mr.Wizard Aug 22 '16 at 10:06
4
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ thanks for answering the question: +1 :) $\endgroup$ – ubpdqn Aug 22 '16 at 21:42
  • $\begingroup$ Thanks! This makes me know what went wrong. $\endgroup$ – Αλέξανδρος Ζεγγ Aug 25 '16 at 6:42
11
$\begingroup$

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]

enter image description here

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

enter image description here

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.

$\endgroup$
  • $\begingroup$ This is a nice answer. $\endgroup$ – Bob Brooks Aug 22 '16 at 16:30
  • 2
    $\begingroup$ 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". $\endgroup$ – Daniel Lichtblau Aug 22 '16 at 21:36
  • $\begingroup$ @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.:) $\endgroup$ – ubpdqn Aug 22 '16 at 21:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.