Wolfram Research

Function Repository Resource:

WeakPathGraphs (1.1.0) current version: 1.1.1 »

Source Notebook

Create path graphs between two vertices in a graph where the paths are constructed without consideration of the direction of the edges

Contributed by: Seth J. Chandler  |  Seth J. Chandler

ResourceFunction["WeakPathGraphs"][g,start,end]

takes a graph g and finds all subgraphs for paths of any length between start and end in the undirected version of g.

ResourceFunction["WeakPathGraphs"][g,start,end,kspec]

returns only paths satisfying the length specified by kspec as in FindPath.

ResourceFunction["WeakPathGraphs"][g,start,end,kspec,n]

finds at most n paths.

Details

The documentation for FindPath provides detailed information on how to use the kspec parameter.

Examples

Basic Examples (2) 

Find a weak path graph for a simple directed graph:

In[1]:=
ResourceFunction["WeakPathGraphs"][
 Graph[{1 -> 2, 2 -> 3, 4 -> 3}], 2, 4, VertexLabels -> Automatic]
Out[1]=

Take a graph and find all paths between "sodium" and "sbp" assuming the graph was undirected, but preserve the direction of the original edges in the resulting "weak path graph":

In[2]:=
gr = Graph[{"sodium" -> "sbp", "age" -> "sodium", "age" -> "sbp", "sodium" -> "pro", "sbp" -> "pro"}, VertexLabels -> Placed["Name", Center], VertexSize -> 0.5, ImageSize -> 100]
Out[2]=
In[3]:=
ResourceFunction["WeakPathGraphs"][gr, "sodium", "sbp", GraphLayout -> "LinearEmbedding", ImageSize -> 200]
Out[3]=

Scope (4) 

WeakPathGraphs works with undirected graphs:

In[4]:=
ResourceFunction["WeakPathGraphs"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, {Null, 
SparseArray[
         Automatic, {12, 12}, 0, {1, {{0, 2, 5, 7, 10, 14, 17, 20, 24, 27, 29, 32, 34}, {{
            2}, {4}, {1}, {3}, {5}, {2}, {6}, {1}, {5}, {7}, {2}, {
            4}, {6}, {8}, {3}, {5}, {9}, {4}, {8}, {10}, {5}, {7}, {
            9}, {11}, {6}, {8}, {12}, {7}, {11}, {8}, {10}, {12}, {
            9}, {11}}}, Pattern}]}, {GraphLayout -> {"GridEmbedding", "Dimension" -> {3, 4}}, VertexShapeFunction -> {2 -> "Name", 7 -> "Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], 
LineBox[{{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}, {
DynamicLocation[
            "VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation[
            "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}, {
DynamicLocation[
            "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}, {
DynamicLocation[
            "VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
            "VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}, {
DynamicLocation[
            "VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}, {
DynamicLocation[
            "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
            "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
            "VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}, {
DynamicLocation[
            "VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
            "VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$10", Automatic, Center]}, {
DynamicLocation[
            "VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}, {
DynamicLocation[
            "VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}, {
DynamicLocation[
            "VertexID$9", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}, {
DynamicLocation[
            "VertexID$10", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}, {
DynamicLocation[
            "VertexID$11", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
DiskBox[{1., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1., 2.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{1., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{2., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{2., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{2., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["7", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {3., 1.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{3., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$8"], 
TagBox[
DiskBox[{3., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$9"], 
TagBox[
DiskBox[{4., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$10"], 
TagBox[
DiskBox[{4., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$11"], 
TagBox[
DiskBox[{4., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$12"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{-1., 89.24835191419872}, {-35.275820010886434`, 32.}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None]\), 2, 7, ImageSize -> 100]
Out[4]=

Directed graphs:

In[5]:=
ResourceFunction["WeakPathGraphs"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, {
SparseArray[
         Automatic, {12, 12}, 0, {1, {{0, 2, 4, 5, 7, 9, 10, 12, 14, 15, 16, 17, 17}, {{
            2}, {4}, {3}, {5}, {6}, {5}, {7}, {6}, {8}, {9}, {8}, {
            10}, {9}, {11}, {12}, {11}, {12}}}, Pattern}], Null}, {EdgeStyle -> {
Arrowheads[0.08]}, GraphLayout -> {"GridEmbedding", "Dimension" -> {3, 4}}, VertexShapeFunction -> {2 -> "Name", 12 -> "Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Arrowheads[0.028937842778793414`], 
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$10", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$9", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$10", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False], 
StyleBox[
ArrowBox[
LineBox[{
DynamicLocation["VertexID$11", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}]], 
Arrowheads[0.08], StripOnInput -> False]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
DiskBox[{1., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1., 2.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{1., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{2., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{2., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{2., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
DiskBox[{3., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{3., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$8"], 
TagBox[
DiskBox[{3., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$9"], 
TagBox[
DiskBox[{4., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$10"], 
TagBox[
DiskBox[{4., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$11"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["12", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {4., 3.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$12"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{-1.015368312707917, 91.01536831270788}, {-35.1958952588157, 28.44432240452428}}],
       
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None]\), 2, 12, {1, 6}, 5]
Out[5]=

Multigraphs:

In[6]:=
ResourceFunction["WeakPathGraphs"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, {Null, {{1, 2}, {1, 4}, {2, 3}, {2, 5}, {3, 6}, {4, 5}, {
         4, 7}, {5, 6}, {5, 8}, {6, 9}, {7, 8}, {7, 10}, {8, 9}, {8, 11}, {9, 12}, {10, 11}, {11, 12}, {5, 8}}}, {PerformanceGoal -> "Q", VertexCoordinates -> {{1., 1.}, {1., 2.}, {1., 3.}, {2., 1.}, {2., 2.}, {2., 3.}, {3., 1.}, {3., 2.}, {3., 3.}, {4., 1.}, {4., 2.}, {4., 3.}}, VertexShapeFunction -> {2 -> "Name", 7 -> "Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], FontFamily -> "Arial", 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
BezierCurveBox[{
DynamicLocation["VertexID$5", Automatic, Center], {
           2.5000000000000004`, 2.1378065801163424`}, 
DynamicLocation["VertexID$8", Automatic, Center]}], 
BezierCurveBox[{
DynamicLocation["VertexID$5", Automatic, Center], {
           2.5000000000000004`, 1.862193419883658}, 
DynamicLocation["VertexID$8", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$10", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$9", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$10", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$11", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], FontFamily -> "Arial", 
TagBox[
DiskBox[{1., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1., 2.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{1., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{2., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{2., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{2., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["7", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {3., 1.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{3., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$8"], 
TagBox[
DiskBox[{3., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$9"], 
TagBox[
DiskBox[{4., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$10"], 
TagBox[
DiskBox[{4., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$11"], 
TagBox[
DiskBox[{4., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$12"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{-1., 89.24835191419872}, {-35.275820010886434`, 32.}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
BaseStyle->(FontFamily -> "Arial"),
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]],
LabelStyle->{FontFamily -> "Arial"}]\), 2, 7, {3, 4}, 2]
Out[6]=

Mixed graphs:

In[7]:=
ResourceFunction["WeakPathGraphs"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, {{{5, 8}}, {{1, 2}, {1, 4}, {2, 3}, {2, 5}, {3, 6}, {4, 5}, {4, 7}, {5, 6}, {6, 9}, {7, 8}, {7, 10}, {8, 9}, {8, 11}, {9, 12}, {10, 11}, {11, 12}}}, {EdgeStyle -> {
Arrowheads[0.08]}, PerformanceGoal -> "Q", VertexCoordinates -> {{1., 1.}, {1., 2.}, {1., 3.}, {2., 1.}, {2., 2.}, {2., 3.}, {3., 1.}, {3., 2.}, {3., 3.}, {4., 1.}, {4., 2.}, {4., 3.}}, VertexShapeFunction -> {2 -> "Name", 7 -> "Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Arrowheads[0.028937842778793414`], 
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], FontFamily -> "Arial", 
Arrowheads[0.08], 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$10", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$9", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$8", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$9", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$10", Automatic, Center], 
DynamicLocation["VertexID$11", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$11", Automatic, Center], 
DynamicLocation["VertexID$12", Automatic, Center]}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], FontFamily -> "Arial", 
TagBox[
DiskBox[{1., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1., 2.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{1., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{2., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{2., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{2., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["7", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {3., 1.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{3., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$8"], 
TagBox[
DiskBox[{3., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$9"], 
TagBox[
DiskBox[{4., 1.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$10"], 
TagBox[
DiskBox[{4., 2.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$11"], 
TagBox[
DiskBox[{4., 3.}, 0.030239520958083826`], "DynamicName", BoxID -> "VertexID$12"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{-1., 89.24835191419872}, {-35.275820010886434`, 32.}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
BaseStyle->(FontFamily -> "Arial"),
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]],
LabelStyle->{FontFamily -> "Arial"}]\), 2, 7, {1, \[Infinity]}, 1]
Out[7]=
In[8]:=
ResourceFunction["WeakPathGraphs"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4}, {Null, 
SparseArray[
         Automatic, {4, 4}, 0, {1, {{0, 3, 5, 8, 10}, {{2}, {3}, {4}, {1}, {3}, {1}, {
            2}, {4}, {1}, {3}}}, Pattern}]}, {EdgeLabels -> {"EdgeWeight"}, VertexShapeFunction -> {"Name"}, EdgeWeight -> {0.5, 1.2, 0.2, 0.9, 0.62}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], {
TagBox[
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], "DynamicName", BoxID -> "EdgeLabelID$1"], 
InsetBox[
FormBox["\"0.5\"", TraditionalForm], 
Offset[{0, 2}, 
DynamicLocation["EdgeLabelID$1", Automatic, 
Scaled[0.5]]], {0, -1}, BaseStyle -> "Graphics"]}, {
TagBox[
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], "DynamicName", BoxID -> "EdgeLabelID$2"], 
InsetBox[
FormBox["\"1.2\"", TraditionalForm], 
Offset[{0, 2}, 
DynamicLocation["EdgeLabelID$2", Automatic, 
Scaled[0.5]]], {0, -1}, BaseStyle -> "Graphics"]}, {
TagBox[
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], "DynamicName", BoxID -> "EdgeLabelID$3"], 
InsetBox[
FormBox["\"0.2\"", TraditionalForm], 
Offset[{0, 2}, 
DynamicLocation["EdgeLabelID$3", Automatic, 
Scaled[0.5]]], {0, -1}, BaseStyle -> "Graphics"]}, {
TagBox[
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], "DynamicName", BoxID -> "EdgeLabelID$4"], 
InsetBox[
FormBox["\"0.9\"", TraditionalForm], 
Offset[{0, 2}, 
DynamicLocation["EdgeLabelID$4", Automatic, 
Scaled[0.5]]], {0, -1}, BaseStyle -> "Graphics"]}, {
TagBox[
LineBox[{
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], "DynamicName", BoxID -> "EdgeLabelID$5"], 
InsetBox[
FormBox["\"0.62\"", TraditionalForm], 
Offset[{0, 2}, 
DynamicLocation["EdgeLabelID$5", Automatic, 
Scaled[0.5]]], {0, -1}, BaseStyle -> "Graphics"]}}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.9329038775049628, 0.868997056961016}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0., 0.4347904415891483}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.9339517502051011, 0.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8680693714551628`, 0.43527754789663736`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{12.122578125, 124.00632812500001`}, {-35.932423961161355`, 30.462325}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
ImagePadding->15,
ImageSize->{136.12890625, Automatic}]\), 2, 4]
Out[8]=

Options (1) 

One can use any option available to Graph to override inheritance of options from the underlying graph or to add other options:

In[9]:=
gr = Graph[{"sodium" -> "sbp", "age" -> "sodium", "age" -> "sbp", "sodium" -> "pro", "sbp" -> "pro"}, VertexLabels -> Placed["Name", Center], VertexSize -> 0.5, ImageSize -> 100]
Out[9]=
In[10]:=
ResourceFunction["WeakPathGraphs"][gr, "sodium", "sbp", VertexLabels -> Placed["Name", Above], VertexStyle -> Purple]
Out[10]=
In[11]:=
ResourceFunction["WeakPathGraphs"][gr, "sodium", "sbp", VertexLabels -> Placed["Name", Above], ImageSize -> 200, Background -> Orange, VertexSize -> 0.25]
Out[11]=

Applications (3) 

One can show the weak paths in the context of the original graph:

In[12]:=
With[{g = Graph[{"sodium" -> "sbp", "age" -> "sodium", "age" -> "sbp", "sodium" -> "pro", "sbp" -> "pro"}, VertexLabels -> Placed["Name", Center], VertexSize -> 0.5, ImageSize -> 100]}, Map[HighlightGraph[g, #] &, ResourceFunction["WeakPathGraphs"][g, "sodium", "sbp", {1, \[Infinity]}, All]]]
Out[12]=

Find links between blogs that exist only when the orientation of the graph is disregarded, but show the orientation of the edges on the path:

In[13]:=
blogs = ResourceData["Political Blogs Network"]
Out[13]=

There are no conventional paths:

In[14]:=
FindPath[blogs, "talkingpointsmemo.com", "realclearpolitics.com", {1, \[Infinity]}]
Out[14]=

There are paths if orientation is disregarded:

In[15]:=
ResourceFunction["WeakPathGraphs", ResourceVersion->"1.1.0"][blogs, "talkingpointsmemo.com", "realclearpolitics.com", {1, 3}, 1, VertexLabels -> Placed["Name", Center], VertexLabelStyle -> Directive[Red, Italic, 8], GraphLayout -> "LinearEmbedding", ImageSize -> 600]
Out[15]=

Find "backdoor" paths as well as directed paths in a causal network:

In[16]:=
cancerGraph=Graph[{"anxiety", "smoking", "peer pressure", "yellow fingers", "lung cancer", "genetics", "attention disorder", "fatigue", "coughing", "allergy", "car accident", "born on an even day"}, {DirectedEdge["anxiety", "smoking"], DirectedEdge["peer pressure", "smoking"], DirectedEdge["smoking", "yellow fingers"], DirectedEdge["smoking", "lung cancer"], DirectedEdge["genetics", "lung cancer"], DirectedEdge["genetics", "attention disorder"], DirectedEdge["lung cancer", "fatigue"], DirectedEdge["lung cancer", "coughing"], DirectedEdge["allergy", "coughing"], DirectedEdge["fatigue", "car accident"], DirectedEdge["attention disorder", "car accident"], DirectedEdge["coughing", "fatigue"]}, {GraphLayout -> "LayeredDigraphEmbedding", VertexLabels -> {"Name"}}]
Out[16]=
In[17]:=
ResourceFunction["WeakPathGraphs"][cancerGraph, "lung cancer", "car accident", VertexLabels -> Placed["Name", Center], GraphLayout -> "LinearEmbedding", ImageSize -> 300, VertexSize -> 0.5] // Column
Out[17]=

Show that deleting all incoming edges to attention disorder means that the only paths remaining between lung cancer and car accident are direct causal chains:

In[18]:=
ResourceFunction["WeakPathGraphs"][
 EdgeDelete[
  cancerGraph, _ \[DirectedEdge] "attention disorder"], "lung cancer", "car accident", VertexLabels -> Placed["Name", Center], GraphLayout -> "LinearEmbedding", ImageSize -> 300, VertexSize -> 0.5]
Out[18]=

Characterize all the "triples" on direction tolerant paths between two vertices as "chains," "forks" or "colliders":

In[19]:=
tripleType[gr_Graph] := Map[#[[1]] -> Switch[Rest[#], {1, 1}, "chain", {0, 2}, "fork", {2, 0}, "collider", _, "other"] &, Thread[List[VertexList[gr], VertexInDegree[gr], VertexOutDegree[gr]]]]
In[20]:=
AssociationMap[tripleType, ResourceFunction["WeakPathGraphs"][cancerGraph, "smoking", "car accident", VertexLabels -> Placed["Name", Center], GraphLayout -> "LinearEmbedding", ImageSize -> 300, VertexSize -> 0.5]]

Neat Examples (1) 

Determine whether two nodes of a graph are "d-separated" from each other by seeing if there are colliders on all the weak paths between two vertices:

In[21]:=
cancerGraph = Graph[{"anxiety", "smoking", "peer pressure", "yellow fingers", "lung cancer", "genetics", "attention disorder", "fatigue", "coughing", "allergy", "car accident", "born on an even day"}, {"anxiety" \[DirectedEdge] "smoking", "peer pressure" \[DirectedEdge] "smoking", "smoking" \[DirectedEdge] "yellow fingers", "smoking" \[DirectedEdge] "lung cancer", "genetics" \[DirectedEdge] "lung cancer", "genetics" \[DirectedEdge] "attention disorder", "lung cancer" \[DirectedEdge] "fatigue", "lung cancer" \[DirectedEdge] "coughing", "allergy" \[DirectedEdge] "coughing", "fatigue" \[DirectedEdge] "car accident", "attention disorder" \[DirectedEdge] "car accident", "coughing" \[DirectedEdge] "fatigue"}, VertexLabels -> "Name", GraphLayout -> "LayeredDigraphEmbedding", ImageSize -> 500]
Out[21]=
In[22]:=
colliderPresentQ[g_Graph] := MemberQ[Thread[List[VertexInDegree[g], VertexOutDegree[g]]], {2, 0}]
In[23]:=
Map[colliderPresentQ, ResourceFunction["WeakPathGraphs"][cancerGraph, "anxiety", "allergy"]]
Out[23]=

Version History

  • 1.1.1 – 23 June 2022
  • 1.1.0 – 13 July 2021

Related Resources

License Information