Tree graph showing all simple paths with dead ends between two vertices in undirected graph

How i can generate and visualize tree graph, showing me all simple paths (and deadlocks) from vertice A to vertice B?

This answer has a brute force solution and I have not tested it extensively. At least the visualization of the result tree graph should be useful.

Creating the graph

graphRules = {1 <-> 2, 1 <-> 4, 1 <-> 5, 2 <-> 3, 3 <-> 4, 3 <-> 5, 
   4 <-> 5};
gr = Graph[graphRules, VertexLabels -> "Name"]

Paths

First we find all the paths from v1to v2:

{v1, v2} = {1, 2};

paths = FindPath[gr, v1, v2, Length[VertexList[gr]], All]

(* {{1, 2}, {1, 5, 3, 2}, {1, 4, 3, 2}, {1, 5, 4, 3, 2}, {1, 4, 5, 3, 2}} *)

Deadlock paths

The deadlock paths -- as defined here as locking of resources -- are found with brute force.

1. Find all inner veritces in the v1-to-v2 paths:

innerVertices = Complement[Flatten[paths], {v1, v2}]

(* {3, 4, 5} *)

2. Find all paths from the inner vertices to v2:

innerVerticesPaths = 
 Map[# -> FindPath[gr, #, v2, Length[VertexList[gr]], All] &, innerVertices];

3. For each path $p$ of the v1-to-v2 paths we select inner vertices paths $iv(p)$ that would produce deadlock paths if concatenated with $p$. This is done with the help of the following functions:

Clear[PickDeadlockPaths]
PickDeadlockPaths[headPath_, tailPaths_] :=  
  Block[{v = headPath[[-1]], ivs},
    ivs = headPath[[1 ;; -2]];
    If[Length[ivs] == 0, {},
     Union@
      Cases[tailPaths, {v, x___, d : (Alternatives @@ ivs), y___} :> {v, x, d}]
     ]
    ] /; Apply[And, Map[headPath[[-1]] == First[#] &, tailPaths]];
PickDeadlockPaths[___] := {};

Clear[MakeDeadlockPaths]
MakeDeadlockPaths[headPath_] :=
  Block[{dps},
   dps = PickDeadlockPaths[headPath, headPath[[-1]] /. innerVerticesPaths];
   If[Length[dps] == 0, {},
    Map[Join[headPath, Rest[#]] &, dps]
   ]
  ];

4. Here is the deadlock paths finding:

allDeadlockPaths = 
  Flatten[Map[
    Join @@ Table[MakeDeadlockPaths@Take[#, {1, i}], {i, 2, Length[#] - 1}] &,
     Select[paths, Length[#] > 2 &]], 1];

allDeadlockPaths = Union[Most /@ allDeadlockPaths]

(* {{1, 4}, {1, 5}, {1, 4, 3}, {1, 4, 5}, {1, 5, 3}, {1, 5, 4}, {1, 4, 3, 5}, {1, 4, 5, 3}, {1, 5, 3, 4}, {1, 5, 4, 3}} *)

Tree with all paths

Using the package TriesWithFrequencies.m we plot the requested tree:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/TriesWithFrequencies.m"]

ptrie = TrieCreate[Join[paths, allDeadlockPaths]][[2]];
TrieForm[ptrie]

The first element in each tree node corresponds to a graph vertiex, the second element is a traversal frequency.

(The package TriesWithFrequencies.m is described in this blog post "Tries with frequencies for data mining".)

@AntonAntonov's answer with the TriesWithFrequencies.m package is more elegant and useful, but here is a brute force approach without any extra packages.

(Note: This approach finds all simple paths including dead ends, see comments for more details. Edited to process more general graphs with more than 10 vertices.)

The main challenge is that the final tree should have the same graph vertices and edges depicted in different positions based on path order. One way to get around this problem is to relabel the vertices as we construct paths, and then use the VertexLabels function to relabel the vertices at the end.

Step 1 - Define the undirected graph

Edit: introduced maxVertexValue here to make subsequent code applicable to larger graphs

exampleGraph =  Graph[{1 <-> 2, 1 <-> 4, 1 <-> 5, 2 <-> 3, 3 <-> 4, 3 <-> 5, 4 <-> 5}, VertexLabels -> "Name"]
maxVertexValue = Max[VertexList[exampleGraph]];

Step 2 - UseFindPath to construct a list of all relevant paths. This include the paths that successfully get from "1" to "2" as well as the lists that start from "1" but do not contain "2".

successfulPaths = FindPath[exampleGraph, 1, 2, 5, All];
unsuccessfulPaths =  Flatten[Table[Select[FindPath[exampleGraph, 1, x, maxVertexValue, All],!MemberQ[#, 2] &], {x, 3, maxVertexValue}], 1]
allPaths = Join[successfulPaths, unsuccessfulPaths];

Or more concisely:

allPaths = Flatten[Table[Select[FindPath[exampleGraph, 1, x, maxVertexValue, All], Last[#] == 2 || ! MemberQ[#, 2] &], {x, 2, maxVertexValue}],1];

Either case returns the following allPaths list:

{{1, 2}, {1, 5, 3, 2}, {1, 4, 3, 2}, {1, 5, 4, 3, 2}, {1, 4, 5, 3, 2}, {1, 5, 3}, {1, 4, 3}, {1, 5, 4, 3}, {1, 4, 5, 3}, {1, 4}, {1, 5, 4}, {1, 5, 3, 4}, {1, 5}, {1, 4, 5}, {1, 4, 3, 5}}

Step 3 - Give every vertix a path dependent name (EDITED to label each vertex with a path list). For example, the path list {1,5,3,2} can be relabeled as {{1},{1,5},{1,5,3},{1,5,3,2}}. These labels will help us group all 1->5 paths in the first step together.

relabeldPaths = Table[x[[1 ;; y]]], {x, allPaths}, {y, Length[x]}];

Step 4 - Convert the relabeled paths list to a unique set of directed edges and vertices. There is probably a much better way to do this, but I combined EdgeList with PathGraph as follows:

pathEdges = Flatten[Map[EdgeList[PathGraph[#, DirectedEdges -> True]] &, relabeldPaths] /. DirectedEdge -> Rule];
treeEdges = DeleteDuplicates[pathEdges];
treeVertices = VertexList[Graph[treeEdges]];

Step 5 - Plot final graph using VertexLabels to select the Last part of each vertex name. (EDITED to make labels clearer)

Graph[treeEdges, VertexSize -> Large, VertexLabels -> Table[x -> Placed[Last[x], Center], {x, treeVertices}], ImageSize -> Medium]

EDIT: Here is a generalized module for this approach for quick copy/paste

pathTreeGraph[graph_, startingVertex_, endingVertex_] := 
 Module[{maxVertexValue, allPaths, relabeldPaths, pathEdges, 
   treeEdges, treeVertices}, maxVertexValue = Max[VertexList[graph]];
  allPaths = Flatten[Table[
     Select[FindPath[graph, startingVertex, x, maxVertexValue, All],           
     Last[#] == endingVertex || !MemberQ[#, endingVertex] &], 
     {x, DeleteCases[VertexList[graph], startingVertex]}], 1];
  relabeldPaths = Table[Flatten[x[[1 ;; y]]], {x, allPaths}, {y, Length[x]}];
  pathEdges = Flatten[Map[EdgeList[PathGraph[#, DirectedEdges -> True]] &, relabeldPaths] /. DirectedEdge -> Rule];
  treeEdges = DeleteDuplicates[pathEdges];
  treeVertices = VertexList[Graph[treeEdges]];
  Graph[treeEdges, VertexSize -> Large, 
   VertexLabels -> Table[x -> Placed[Last[x], Center], {x, treeVertices}], 
   ImageSize -> Medium]]

exampleGraph = Graph[{1 <-> 2, 1 <-> 4, 1 <-> 5, 2 <-> 3, 3 <-> 4, 3 <-> 5, 4 <-> 5}, VertexLabels -> "Name"]
pathTreeGraph[exampleGraph, 1, 2]

UPDATE: Example with more than 10 vertices

ButterflyGraph[2, VertexLabels -> "Name", ImageSize -> Medium]
pathTreeGraph[ButterflyGraph[2], 1, 2]

Okay, I knew I was on to something but I didn't quite pull it together the first time. Here is a second attempt, still probably not as clean as it should be, and not entirely general, but I think at least delivering on the promise of a recursive solution.

rls = {1 -> 2, 1 -> 4, 1 -> 5, 2 -> 3, 3 -> 4, 3 -> 5, 4 -> 5};
asc = GroupBy[Join @@ Permutations /@ rls, First -> Last];

f[r_, t_] := f[1][r, t]

f[i_][n___, r_, t_] := 
  Complement[r /. asc, {n, r}] //
   {n, r}[[i]] @@ 
     If[# === {}, r, f[i + 1][n, r, #, t] & /@ #] &

f[i_][n___, t_, t_] := t

f[1, 2] // TreeForm

Useful related questions:

• Transform an expression into a graph that can be plotted with TreeGraph (not TreeForm)
• Converting expressions to "edges" for use in TreePlot, Graph
• How to find all vertices reachable from a start vertex following directed edges?

Old answer

An idea:

rls = {1 -> 2, 1 -> 4, 1 -> 5, 2 -> 3, 3 -> 4, 3 -> 5, 4 -> 5};
asc = GroupBy[Join @@ Permutations /@ rls, First -> Last];

ClearAll[f]

f[n___, r_, t_] :=
  Complement[r /. asc, {n, r}] //
    If[# === {}, 〈n, r〉, f[n, r, #, t] & /@ #] &

f[n___, t_, t_] := 〈n, t〉

out = f[1, 2]

{〈1, 2〉, {{〈1, 4, 3, 2〉, 〈1, 4, 3, 5〉},
 {{〈1, 4, 5, 3, 2〉}}}, {{〈1, 5, 3, 2〉, 〈1, 5, 3, 4〉},
 {{〈1, 5, 4, 3, 2〉}}}}

I am trying to think of a nice way to visualize this. For the time being I'll borrow ideas from Rashid's answer:

out = Flatten[out] /. AngleBracket -> List;

BooleanGraph[Or,
  Sequence @@ (PathGraph @ Rest @ FoldList[Append, {}, #] & /@ out),
  VertexShapeFunction -> ({Disk[#, 0.2], White, Text[Last @ #2 ~Style~ 20, #]} &)
]