Matrix which gives the existence in a graph of a path of length $k$
Why not work with AdjacencyMatrix
instead? For example:
KPaths[g_, k_] := Module[{a, m},
a = AdjacencyMatrix[g];
m = 1 - IdentityMatrix[Length[a]];
Nest[Unitize[(a . #) m]&, a, k-1]
]
Comparison:
SeedRandom[1];
gr=makegraph2[100,{0},10,0.01,0.5];
last = Length[FindPath[gr,#,Last@VertexList[gr],{6}]]&/@VertexList[gr]; //AbsoluteTiming
last
{0.104942, Null}
{0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1,
0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0,
1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0}
r = KPaths[gr, 6]; //AbsoluteTiming
r[[-1]] //Normal
last == r[[-1]]
{0.002574, Null}
{0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1,
0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0,
1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0}
True
Note that KPaths
does all of the vertices instead of just the last vertex.
A method using SparseArray`SparseArrayRemoveDiagonal
to remove the diagonal:
ClearAll[urd, kPaths1, kPaths2]
urd = Unitize @* SparseArray`SparseArrayRemoveDiagonal;
kPaths1[g_, k_] := Module[{a = AdjacencyMatrix @ g}, Nest[urd[a.#] &, a, k - 1]]
Example:
SeedRandom[1];
gr = makegraph2[100, {0}, 10, 0.01, 0.5];
r1 = kPaths1[gr, 6]; // RepeatedTiming // First
0.00078
In comparison, Carl's KPaths
we get
r = KPaths[gr, 6]; // RepeatedTiming // First
0.0017
All three methods give the same result:
r == r1
True