3
$\begingroup$

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?

$\endgroup$
2
$\begingroup$

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}]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you very much! $\endgroup$ – Kiril Danilchenko Mar 2 at 11:37
2
$\begingroup$

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] 

enter image description here

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]

enter image description here

$\endgroup$
1
$\begingroup$

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:

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.