all rooted subgraphs of size $k$ in the grid graph

Question

I would like to compute all rooted subgraphs of size $k$ in the grid graph. I use the following approach, I start from the root, then traverse the graph along edges in all possible ways until I have reached $k−1$ other vertices.
g = GridGraph[{10, 10}, VertexLabels -> "Name"];

root=36;
k=4
y = {{root, funPathCal[{}, root}};
resul = y;
Table[

y2 = Table[{#, nextStep[y[[i]][[1]], #]} & /@ y[[i]][[2]], {i, 1, 
   Length[y]}];
resul = AppendTo[resul, y2];
y = Flatten[y2, 1];, {k-1}]
nextStep[curVer_, verl_] := Module[{},
 DeleteCases[VertexList[NeighborhoodGraph[g, verl, 1]], 
  Alternatives @@ {verl, curVer}]
 
 ]

I have two questions:
1)Any suggestion on how to calculate all possible walks?
2)How efficiency calculate walks from my resul?

Daniel Huber · Accepted Answer

To simplify calculations, we introduce an x/y coordinate system x=1..10/y=1..10. The root: 36 reads then: {4,6}.
To change from x/y to linear coordinates, we define:
Clear[testwalked, step, tolin];
tolin[pos_] := (pos[[2]] + 10 (pos[[1]] - 1));

We further need a routine that checks if a move is acceptable:
testwalked[walked_List, dir_] := Module[{pos = Last@walked},
  Which[
   dir == -1, 
   If[Mod[pos[[1]], 10] == 1, False, ! MemberQ[walked, pos - {1, 0}]],
   dir ==   1, 
   If[Mod[pos[[1]], 10] == 0, False, ! MemberQ[walked, pos + {1, 0}]],
   dir == -2, 
   If[Mod[pos[[2]], 10] == 1, False, ! MemberQ[walked, pos - {0, 1}]],
   dir ==   2, 
   If[Mod[pos[[2]], 10] == 0, False, ! MemberQ[walked, pos + {0, 1}]]
   ]]

To recursively create all allowed path we define:
step[walked_List] := Module[{pos = Last[walked]},
  If[Length[walked] == k, Return[walked]];
  {If[testwalked[walked, -1], step[Append[walked, pos - {1, 0}]], 
    Nothing],
   If[testwalked[walked,   1], step[Append[walked, pos + {1, 0}]], 
    Nothing],
   If[testwalked[walked, -2], step[Append[walked, pos - {0, 1}]], 
    Nothing],
   If[testwalked[walked,   2], step[Append[walked, pos + {0, 1}]], 
    Nothing]
   }
  ]

Your test example reads now:
root = {4, 6}; (*start of path*)
k = 4; (*path length*)
paths = Flatten[step[{root}], 2];

This gives the paths in x/y coordinates. To change to linear coordinates:
paths = Map[tolin, paths, {2}]

kglr · Answer

We can use VertexComponent and FindPath to find all paths from a starting node as follows:
ClearAll[f] 
f[g_, v_, l_] := Join @@ (FindPath[g, v, #, {l-1}, All] & /@ VertexComponent[g, v, l-1])

Example:
g = GridGraph[{10, 10}, VertexStyle -> White, 
   VertexLabels -> Placed["Name", Center], VertexSize -> Large];

Multicolumn[f[g, 36, 4], 6]

Highlight a random sample of 9 paths from 36 paths in f[g, 36, 4]:
Multicolumn[HighlightGraph[g,
    {Style[EdgeList @ PathGraph @ #, Thick, Red], Style[#, Yellow]}, 
    PlotLabel -> #, ImageSize -> Medium] & /@ 
  RandomChoice[f[g, 36, 4], 9], 3]

Tugrul Temel · Answer

I should indicate from the outset that this is not an answer to the question but an option to the OP for exploring different versions of his/her question. I should further indicate that the main function in the following code belongs to @kglr, who has developed it a few years ago. I could not find the link to share with you. Therefore, I give a small example.
(* Identify all the pathways from a source to a sink in a digraph *)
edgeW = Module[{
g = #, 
e = DirectedEdge @@@ Partition[#, 2, 1] & /@ 
   FindPath[##, [Infinity], All]
}, Transpose[{e, PropertyValue[{g, #}, EdgeWeight] & /@ # & /@ e}]] &;  (*from @kglr*)

SeedRandom[11];
n = 10;
d = 0.3;
G = RandomGraph[{Round[n], Round[n*(n - 1)*d]},  DirectedEdges -> True];
system = AdjacencyMatrix[G]*
RandomReal[1, {10, 10}];  (*AdjacencyMatrix of G*)
sa = SparseArray[system];
wG = Graph[sa["NonzeroPositions"], EdgeWeight -> sa["NonzeroValues"], 
DirectedEdges -> True, VertexSize -> .3, 
EdgeLabels -> "EdgeWeight"];

(*list of all the pathways in the sub-graph from "source" to "sink"*)
scenario = {source = 5, sink = 2};
edgeW[wG, source, sink][[All, 1]]    
HighlightGraph[wG, edgeW[wG, source, sink][[All, 1]], 
GraphHighlight -> {source, sink}, 
VertexLabels -> Table[i -> Placed["Name", {1/2, 1/2}],  {i, n}], VertexSize -> 0.3, EdgeLabels -> "EdgeWeight"]

generates the list of all the paths from source to sink:
{
{5 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 6, 6 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 9, 9 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 9, 9 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 9, 9 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 9, 9 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 6, 6 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 4, 4 [DirectedEdge] 9, 9 [DirectedEdge] 2}, {5 [DirectedEdge] 8, 8 [DirectedEdge] 4, 4 [DirectedEdge] 9, 9 [DirectedEdge] 7, 7 [DirectedEdge] 1, 1 [DirectedEdge] 6, 6 [DirectedEdge] 2}
}

and the directed graph with edgeweights:

all rooted subgraphs of size $k$ in the grid graph

3 Answers

Add your own answers!

Ask a Question