I implement one by myself. ```mathematica Clear["Global`*"]; Needs["IGraphM`"] count1Cycles[g_Graph] := List @@@ EdgeList[g] // Count[#, _?(#[[1]] == #[[2]] &)] & count2Cycles[g_Graph] := Map[#[[2]] &, EdgeList[g] // Tally] // Select[# >= 2 &] // Map[Binomial[#, 2] &, #] & // Total UndirectedKCycles[graph_Graph, k_Integer] := Module[{H, tr, numNeighbors, adjacencyMatrix, subgraphs, vertices, n}, vertices = VertexList[graph]; n = VertexCount[graph]; adjacencyMatrix = AdjacencyMatrix[graph]; subgraphs = Select[Subsets[vertices, {1, n}], ConnectedGraphQ[Subgraph[graph, #]] &]; tr[A_, power_] := Tr[MatrixPower[A, power]]; numNeighbors[H_] := Length@Complement[vertices, VertexList[H], Flatten[VertexList /@ NeighborhoodGraph[graph, #] & /@ VertexList[H]]]; Switch[k, 1, (* If k == 1*) count1Cycles[graph], 2, (* If k == 2*) count2Cycles[graph], _, (* Otherwise, use the formula *) Total[ ((-1)^k / (2*k)) * Table[ With[{H = Subgraph[graph, sg]}, Binomial[numNeighbors[H], k - VertexCount[H]] * (-1)^VertexCount[H] * tr[AdjacencyMatrix[H], k] ], {sg, subgraphs}] ] ] ] ``` I have verified the Mathematica code with these following test cases. ```Mathematica n = 5; g = CompleteGraph[n] UndirectedKCycles[g, #] & /@ Range[1, n, 1] (* https://oeis.org/A284947 *) ``` ``` n = 3; g = CompleteGraph[{n,n}] UndirectedKCycles[g, #] & /@ Range[1, 2*n, 1] ``` ``` n = 3; g = CompleteGraph[{n, n, n}] UndirectedKCycles[g, #] & /@ Range[1, 3*n, 1] ``` ``` g = Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 1, 1 \[UndirectedEdge] 1, 2 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 2}] UndirectedKCycles[g, #] & /@ Range[1, 10 , 1] ``` --- **But the code fails for these test cases.** **Can you correct the code? Any help would be appreciated.** ``` n = 2; g = GridGraph[{n, n, n}] UndirectedKCycles[g, #] & /@ Range[1, n^3, 1] Length /@ FindCycle[g, Infinity, All] // Tally HighlightGraph[g, #]& /@ FindCycle[g, Infinity, All] ``` ``` n = 3; g = GridGraph[{n, n}] UndirectedKCycles[g, #] & /@ Range[1, n^2, 1] Length /@ FindCycle[g, Infinity, All] // Tally HighlightGraph[g, #]& /@ FindCycle[g, Infinity, All] ``` ``` n = 7; g = WheelGraph[n] UndirectedKCycles[g, #] & /@ Range[1, n, 1] Length /@ FindCycle[g, Infinity, All] // Tally HighlightGraph[g, #] & /@ FindCycle[g, Infinity, All] ```