# Is there any way to speed up FindCycle[list, {length}, All] for a large graph of coprime integers?

I am doing undergraduate research and am hitting a wall with the FindCycle[] function in Mathematica. Specifically I have built a list of 34 integers and if they are coprime link them with an UndirectedEdge. The code is: s34list = {}; Do[If[CoprimeQ[i, j], AppendTo[s34list, i <-> j], Next], {i, 34 }, {j, i - 1}] This can also be graphed with the built in Graph[] function. I have used Findcycle[s34list, {5}, All] to find all cycles of length 5 in that list. It doesn't take very long and there are just over 530,000. I then can finish my work on the list of cycles of length 5. My problem is that when I try to find all cycles of 7 or more, my computer runs out of memory. I have played around with it and see that it can find at least 10,000,000 cycles of length 7 on that same list, so it appears that there is a very large amount. So, my question is if there is any way to speed up FindCycle when looking for "All" cycles. I am wondering if each cycle is unique, and how does mathematica determine it has found all of them? On a side note, mathematica tells me I can't use Parallelize[] on this and I don't understand how to get CUDALink to run this. Any help is appreciated.

• You might edit your post to mention how much memory you have. If you have less than 32GB then buy more, it is cheap and MMA works much better when you have WAY too much memory. It will be far far slower, but you might see if you can tell your computer to use 64GB of hard drive as "swap space" where it can push some data onto the hard drive and get it back later. It is much better if you can estimate how much space and time will be needed for a big problem before you start if there is any way that you can do that. – Bill Jun 21 '17 at 17:22

I see that my suggested answer has already been provided by @DavidGStork, but perhaps it is a bit more fleshed out.

One idea is to use the syntax FindCycle[{g, v}, {7}, All] to find all cycles in the graph g that include v. Then, delete the vertex v from g and repeat with the next vertex. Here is your graph:

s34list = {};
Do[
If[CoprimeQ[i, j], AppendTo[s34list, i <-> j], Next],
{i, 34},
{j, i - 1}
]


And here I will show code that does this for 5-cycles. Note that I only store the length because storing all of the cycles will take a lot of memory, and storing the actual result instead (the cycles) in a memory efficient way would be a different question.

g = Graph[s34list];
vl = VertexList[g];

s1 = Table[
Length @ FindCycle[
{VertexDelete[g, Take[vl, i-1]], vl[[i]]},
{5},
All
],
{i,Length[vl]}
]; //MaxMemoryUsed //AbsoluteTiming
Total[ s1 ]


{0.987802, 67530616}

531317

Compare this to:

s2 = Length @ FindCycle[g, {5}, All]; //MaxMemoryUsed //AbsoluteTiming
s2


{0.970028, 280607864}

531317

We see that we get the same answer in about the same time, with a savings on maximum memory used. Now, I won't repeat this for 7-cycles because it takes a lot more memory and time, but I will instead just do one.

r = Length @ FindCycle[{g, vl[[1]]}, {7}, All]; //MaxMemoryUsed //AbsoluteTiming
r


{63.1629, 14828708456}

22066522

It takes about 14.8 GB of memory to do 1 vertex. So, as long as you have enough memory, it shouldn't take much longer than a half hour to find all of the cycles, although you may not be able to store all of them in memory.

• Carl Woll's algorithm implements what I suggested, but I recommend an improvement (in speed): order the vertexes by increasing order (the number of adjacent vertexes). This way you'll reduce the most computationally complex searches first. This will use the least memory. – David G. Stork Jun 22 '17 at 1:51

A possible way forward:

g = Graph[Range[34], s34list]


Then search for all cycles of length $7$ restricted to going through vertex 1:

FindCycle[{g, 1}, {7}]


then restricted to going through vertex 2:

FindCycle[{g, 2}, {7}]


and so on.

If you're clever, you may be able to eliminate searches through certain vertexes since they've already been found.

Another approach is to find the nodes that have the fewest neighbors and hence are likely to be part of the fewest cycles:

Total /@ AdjacencyMatrix[g]


(*

{33, 17, 23, 17, 28, 11, 30, 17, 23, 14, 31, 11, 32, 15, 19, 17, 32, 11, 33, 14, 20, 15, 33, 11, 28, 16, 23, 15, 33, 9, 33, 17, 21, 16}

*)

So it is clear that vertex 30 has the fewest neighbors (just $9$). So search for loops containing vertex 30:

FindCycle[{g, 30}, {7}]


Then delete vertex 30 from the graph, find which node of the reduced graph has the fewest neighbors, search for loops containing that vertex, and iterate.