3 added 531 characters in body
source | link

Here's a relatively simple recursive solution, with explanation:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

This solution assumes that all vertex names are atomic (e.g. integers or strings). If not, the Level trick below must be replaced by a more complicated solution.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ list @@ unvisited
   ]
 ]

Explanation:

  • soFar is the vertices in the path so far
  • current is the current node we are visiting. We will try to move on to all neighbours of current if they were not yet visited (see AdjacencyList)
  • If we reach the target t, we stop with the recursion. If there are no unvisited neighbours, we stop with the recursion.
  • k is an extra label used to distinguish between events of encountering the same node through different paths.
  • list is just a distinct head which we will flatten out later, without touching other parts of the expression.

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]

Compute all paths and merge them into a tree.

k = 0; 
GraphUnion @@ pathGraph /@ Level[f[Flatten[f[{{s, k++}}], {-3}]Infinity, list]

Labels vertices with their original name (i.e. do not display the value of k).

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

To better understand how f works, try this:

k = 0;
f[{{s, k++}}]

% /. e : Except[_list] :> ToString[e] // TreeForm

Mathematica graphics

This expression tree reflects the structure of the tree we are building. The displayed leaf names are the paths used to get to that leaf.

Here's a recursive solution:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

This solution assumes that all vertex names are atomic (e.g. integers or strings). If not, the Level trick below must be replaced by a more complicated solution.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ unvisited
   ]
 ]

Explanation:

  • soFar is the vertices in the path so far
  • current is the current node we are visiting. We will try to move on to all neighbours of current if they were not yet visited (see AdjacencyList)
  • If we reach the target t, we stop with the recursion. If there are no unvisited neighbours, we stop with the recursion.
  • k is an extra label used to distinguish between events of encountering the same node through different paths.

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]

Compute all paths and merge them into a tree.

k = 0; 
GraphUnion @@ pathGraph /@ Level[f[{{s, k++}}], {-3}]

Labels vertices with their original name (i.e. do not display the value of k).

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

Here's a relatively simple recursive solution, with explanation:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ list @@ unvisited
   ]
 ]

Explanation:

  • soFar is the vertices in the path so far
  • current is the current node we are visiting. We will try to move on to all neighbours of current if they were not yet visited (see AdjacencyList)
  • If we reach the target t, we stop with the recursion. If there are no unvisited neighbours, we stop with the recursion.
  • k is an extra label used to distinguish between events of encountering the same node through different paths.
  • list is just a distinct head which we will flatten out later, without touching other parts of the expression.

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]

Compute all paths and merge them into a tree.

k = 0; 
GraphUnion @@ pathGraph /@ Flatten[f[{{s, k++}}], Infinity, list]

Labels vertices with their original name (i.e. do not display the value of k).

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

To better understand how f works, try this:

k = 0;
f[{{s, k++}}]

% /. e : Except[_list] :> ToString[e] // TreeForm

Mathematica graphics

This expression tree reflects the structure of the tree we are building. The displayed leaf names are the paths used to get to that leaf.

2 added 531 characters in body
source | link

Here's a recursive solution:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

The input graph's verticesThis solution assumes that all vertex names are expected to coincide with their indicesatomic (e.g. integers or strings). If they don'tnot, usethe IndexGraph firstLevel trick below must be replaced by a more complicated solution.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ unvisited
   ]
 ]

Explanation:

  • soFar is the vertices in the path so far
  • current is the current node we are visiting. We will try to move on to all neighbours of current if they were not yet visited (see AdjacencyList)
  • If we reach the target t, we stop with the recursion. If there are no unvisited neighbours, we stop with the recursion.
  • k is an extra label used to distinguish between events of encountering the same node through different paths.

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]
 

Compute all paths and merge them into a tree.

k = 0; (* k is used as an extra node label to distinguish between events where the same node is visited through different paths *)
GraphUnion @@ pathGraph /@ Level[f[{{1s, k++}}], {-3}]
 

Labels vertices with their original name (i.e. do not display the value of k).

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

Here's a recursive solution:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

The input graph's vertices are expected to coincide with their indices. If they don't, use IndexGraph first.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ unvisited
   ]
 ]

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]
 
k = 0; (* k is used as an extra node label to distinguish between events where the same node is visited through different paths *)
GraphUnion @@ pathGraph /@ Level[f[{{1, k++}}], {-3}]
 
Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

Here's a recursive solution:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

This solution assumes that all vertex names are atomic (e.g. integers or strings). If not, the Level trick below must be replaced by a more complicated solution.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ unvisited
   ]
 ]

Explanation:

  • soFar is the vertices in the path so far
  • current is the current node we are visiting. We will try to move on to all neighbours of current if they were not yet visited (see AdjacencyList)
  • If we reach the target t, we stop with the recursion. If there are no unvisited neighbours, we stop with the recursion.
  • k is an extra label used to distinguish between events of encountering the same node through different paths.

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]

Compute all paths and merge them into a tree.

k = 0; 
GraphUnion @@ pathGraph /@ Level[f[{{s, k++}}], {-3}]

Labels vertices with their original name (i.e. do not display the value of k).

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics

1
source | link

Here's a recursive solution:

g = Graph[{1, 2, 3, 4, 5}, {1 \[UndirectedEdge] 2, 
   2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 5, 
   1 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 4, 
   3 \[UndirectedEdge] 4, 4 \[UndirectedEdge] 5}]

The input graph's vertices are expected to coincide with their indices. If they don't, use IndexGraph first.

Start and end points:

s = 1;
t = 2;

Recursive descent:

f[soFar_] :=
 With[
    {current = soFar[[-1, 1]]},
    {unvisited = Complement[AdjacencyList[g, current], soFar[[All, 1]]]},
    If[current === t || unvisited === {},
     soFar,
     f@Append[soFar, {#, k++}] & /@ unvisited
   ]
 ]

PathGraph chokes on vertex names that are lists, so we make our own ...

pathGraph[vertices_] := 
 Graph[DirectedEdge @@@ Partition[vertices, 2, 1]]

k = 0; (* k is used as an extra node label to distinguish between events where the same node is visited through different paths *)
GraphUnion @@ pathGraph /@ Level[f[{{1, k++}}], {-3}]

Graph[%, VertexLabels -> {{a_, b_} :> a}]

Mathematica graphics