# Highlight all paths in a graph below some threshold length

I have a weighted graph, for example, a random geometric graph within a square domain $$[-1/2,1/2]^2$$, with a node fixed at the origin.

How do I use HighlightGraph to show all paths which start at the origin, but have a length (sum of weights along the edges) less than $$l$$?

It is relatively easy to get the shortest paths to some nodes at bounded graph distance from the origin, but what about the "wetted" region, which includes all paths less than length $$l$$? AllPaths will take too long, I think, and there are too many to count. You can see in the picture that nodes in the wetter region are blue, but not all edges. I essentially want to know, how do I pick out the edges of the wetted region. Perhaps some use of a line graph?

Attempt:

<< IGraphM
col1 = Blue;
col2 = Red;
(**Define the functions which produce the graph, and pick out the \
geodesics***)
listnodes[t_, gr_] := Module[{pts, gdm},
gdm = GraphDistanceMatrix[gr][[All, 1]];
Position[gdm, _?(t - 0.05 < # < t + 0.05 &)]
]
listbacknodes[t_, gr_] := Module[{pts, gdm},
gdm = GraphDistanceMatrix[gr][[All, 1]];
Position[gdm, _?(# < t + 0.03 &)]
]
col1 = Blue;
col2 = Red;
pth1[x_] := {a1[[x]],
Style[VertexList[a1[[x]]][[#]], EdgeForm[{col2, Thick}],
FaceForm[Darker@col2]] & /@ Range[1, Length@VertexList[a1[[x]]]],
Style[EdgeList[a1[[x]]][[#]], col2, Thickness[0.007]] & /@
Range[1, Length@EdgeList[a1[[x]]]]}
pth2[x_] := {a2[[x]],
Style[VertexList[a2[[x]]][[#]], EdgeForm[{col1, Thin}],
FaceForm[col1]] & /@ Range[1, Length@VertexList[a2[[x]]]],
Style[EdgeList[a2[[x]]][[#]], col1, Thickness[0.003]] & /@
Range[1, Length@EdgeList[a2[[x]]]]}
nng1[ww_, hh_, x_] := Module[{},
w1 = ww;
h1 = hh;
width = w1;
height = h1;
density = x;
volume = width*height;
Npoints = density*volume;
pts = Table[{RandomReal[{-width/2, width/2}],
RandomReal[{height/2, -height/2}]}, {i, 1, Npoints}];
cp = CirclePoints[width/2, 12];
pts = Join[cp, pts];
pts = Flatten[Join[{{{0, 0}}, pts}], 1];
DelG1 =
IGEdgeMap[Apply[EuclideanDistance],
EdgeWeight -> IGEdgeVertexProp[VertexCoordinates],
NearestNeighborGraph[pts, 7, GraphStyle -> "CoolColor",
VertexSize -> {"Scaled", 0.005},
EdgeStyle -> {Thickness[100], Blue},
VertexCoordinates -> pts]];
DelG1 =
GraphStyle -> "CoolColor", VertexSize -> {"Scaled", 0.005},
EdgeStyle -> {Thickness[100], Blue}];
DelG1 =
IGEdgeMap[Apply[EuclideanDistance],
EdgeWeight -> IGEdgeVertexProp[VertexCoordinates], DelG1];
DelG1
];
nng2[g_, T_] := Module[{},
DelG1 = g;
a1 = PathGraph[FindShortestPath[DelG1, 1, #]] & /@
Flatten[listnodes[T, DelG1]];
a2 = PathGraph[FindShortestPath[DelG1, 1, #]] & /@
Flatten[listbacknodes[T, DelG1]];
pnng10 = HighlightGraph[DelG1,
Join[Flatten[pth2[#] & /@ Range[1, Length@a2], 1],
Flatten[pth1[#] & /@ Range[1, Length@a1], 1]],
ImageSize -> 200]
];
(***Draw a graph, then display the wetted region, and the geodesics \
to the boundary***)
gr1 = nng1[20, 20, 3]
Grid[{{nng2[gr1, 2], nng2[gr1, 4], nng2[gr1, 7], nng2[gr1, 10]}}]


• I had to look up where to get the IGraphM package, so I'm putting that here for other's convenience... Get["https://raw.githubusercontent.com/szhorvat/IGraphM/master/IGInstaller.m"] Jan 10, 2019 at 21:07
• @Alexander How large is the graph for which you want to do that in the end? Jan 10, 2019 at 21:32
• Not large, it is simply for a figure, graphs about the size in the post. And it can take e.g. an hour to produce, no need for speed at all.
– apg
Jan 10, 2019 at 22:26

i = 1;
d = 8.;

vertices = RandomPrivatePositionsOf[
UnitStep[d - IGDistanceMatrix[gr1, {i}][[1]]],
1
];
edges = With[{u = SparseArray[Partition[vertices, 1] -> 1, {VertexCount[gr1]}]},
];
pathfun = FindShortestPath[gr1, 1, All];
paths = pathfun /@ vertices;
pathedges = DeleteDuplicates[Join @@ (Partition[#, 2, 1] & /@ paths)];


All shortest paths to points in the "wetted" region:

HighlightGraph[gr1, {UndirectedEdge @@@ pathedges, vertices}]


All wetted edges:

HighlightGraph[gr1, {UndirectedEdge @@@ edges, vertices}]


This is how to obtain the spanning paths. The code uses that the shortest paths going out of vertex 1 for a tree and that the "boundary vertices" are the leaves of this tree. And the leaves have vertex out degree 0.

deg = VertexOutDegree[Graph[Range[VertexCount[gr1]], DirectedEdge @@@ pathedges]];
spanningpaths = Pick[paths, deg[[paths[[All, -1]]]], 0];
`
• Ideal, thank you. Is it possible to add also another figure with all shortest paths to points only on the "boundary" of the wetted region (i.e. to the wetted nodes at distance about t from the origin)? Do I just change the last arg of FindShortestPath[gr1, 1, All] to the chosen nodes?
– apg
Jan 10, 2019 at 23:22
• Ok that in fact worked. Thanks again.
– apg
Jan 14, 2019 at 14:45
• You're welcome. Jan 14, 2019 at 14:46