Message Boards Message Boards

1
|
5505 Views
|
3 Replies
|
6 Total Likes
View groups...
Share
Share this post:

[?] Solve this problem using graph theory?

Posted 7 years ago

A "path" from I to J is a series of "movements" through the squares forming the grid. The movements can only be to the right and down. The VALUE of a path is the SUM of the numbers in the squares.

How many paths from I to J have a VALUE equal to 51?

enter image description here

POSTED BY: Juan Preciado
3 Replies

You have to move 4 to the right, and 4 down. I will denote going right as a 0 and going down with 1. Then there are 70 possible ways:

Permutations[{0, 0, 0, 0, 1, 1, 1, 1}]

I would follow each of the paths and try it out...

POSTED BY: Sander Huisman

@Isidro Meneses: The simplest way for you (not the fastest for the computer) is probably this:

Construct graph and notice the ordering of vertices:

g = GridGraph[{5, 5}, DirectedEdges -> True, VertexLabels -> "Name"]

enter image description here

Enter matrix:

matrix = {{0, 5, 12, 5, 10},
   {5, 11, 5, 11, 5},
   {10, 5, 0, 5, 15},
   {5, 11, 5, 14, 5},
   {10, 5, 13, 5, 0}};

Notice that we can get the value of a graph node by using the node name (which is an integer here) to index this vector:

values = Flatten[matrix]

Find all paths from source to sink:

paths = FindPath[g, 1, 25, Infinity, All]

See their sums:

Total@values[[#]] & /@ paths

(*
{53, 54, 54, 55, 55, 54, 54, 55, 55, 43, 44, 44, 44, 44, 45, 55, 55, \
56, 56, 44, 45, 45, 45, 45, 46, 44, 45, 45, 45, 45, 46, 56, 56, 57, \
57, 55, 55, 56, 56, 44, 45, 45, 45, 45, 46, 44, 45, 45, 45, 45, 46, \
56, 56, 57, 57, 45, 46, 46, 46, 46, 47, 57, 57, 58, 58, 57, 57, 58, \
58, 57} *)

None seem to be 51:

Position[%, 51]
(* {} *)

A better way would be to assign the values to the out-edge of each vertex (start with GroupBy[EdgeList[g], First]), then use FindPath[weightedGraph, 1, 25, {51}, All]. This would probably be faster. But it takes longer to program, and since the simple brute-force solution from above runs instantaneously for such a small matrix, there is no point to programming anything more complicated.

POSTED BY: Szabolcs Horvát

You should delete double post if possible.

I think this problem is easy to solve without using graphs. If you want to do some graph drawing anyways, you might try the following:

GetEdges[n_] :=  Function[{a}, DirectedEdge[a, #] & /@ 
Select[Tuples[{0, 1}, n], SameQ[#[[1 ;; -2]] , a] &]] /@ Tuples[{0, 1}, n - 1]
TreePlot[TreeGraph[Flatten[Tuples[{0, 1}, #] & /@ Range[0, 8], 1], 
Flatten[GetEdges[#] & /@ Range[1, 8]]], ImageSize -> 800]

Tree Plot

Another one is

Graph[Flatten[Switch[#,
     {8, 8}, {},
     {_, 8}, DirectedEdge[#, # + {1, 0}],
     {8, _}, DirectedEdge[#, # + {0, 1}],
     {_, _}, {DirectedEdge[#, # + {1, 0}], DirectedEdge[#, # + {0, 1}]}
     ] & /@ Flatten[ Table[{i, j}, {i, 1, 8}, {j, 1, 8}], 1]]
 ]

Adj Graph

POSTED BY: Brad Klee
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract