# Looking for two vertex-disjoint (chordless) cycles with length 10

Two cycles in a graph are vertex-disjoint if they have no common vertex. I am looking for two vertex disjoint (chordless) cycles with length 10.

g = Graph[{0 <-> 1, 1 <-> 2, 2 <-> 7, 7 <-> 6, 6 <-> 8, 2 <-> 3,
3 <-> 4, 4 <-> 10, 10 <-> 11, 11 <-> 12, 12 <-> 9, 9 <-> 13,
13 <-> 15, 0 <-> 12, 6 <-> 13, 15 <-> 14, 14 <-> 4, 1 <-> 5,
16 <-> 15, 11 <-> 16, 8 <-> 0, 3 <-> 9, 10 <-> 5, 7 <-> 19,
19 <-> 18, 16 <-> 17, 17 <-> 8, 5 <-> 18, 14 <-> 19, 17 <-> 18},
VertexLabels -> Automatic]


c10 = FindCycle[g, {10}, All]; (* find all cycles with length 10.*)

convelist[cycle_] := Union[Flatten[Map[List @@ # &, cycle]]] (* convert cycle to vertex lists*)
noIntersectionQ[list1_, list2_] := Intersection[list1, list2] == {};(* test if vertex lists of two cycles are disjoint *)
(*main function*)
finddisjointcycles[listOfLists_] :=
Module[{n = Length[listOfLists], i, j},
For[i = 1, i <= n - 1, i++,
For[j = i + 1, j <= n, j++,
If[noIntersectionQ[listOfLists[[i]], listOfLists[[j]]],
Return[{i, j, listOfLists[[i]], listOfLists[[j]]}]]]];
Return[None]];


finddisjointcycles[listcycle]


{1, 111, {3, 4, 9, 13, 14, 15, 16, 17, 18, 19}, {0, 1, 2, 5, 6, 7, 8, 10, 11, 12}}

HighlightGraph[g, {c10[[1]], c10[[111]]}]


I feel like my code is too cumbersome. I hope it can be simplified.

The second objective is to find two vertex-disjoint chordless cycles with length 10. Both of the cycles found above are not chordless cycle.

A chord of a graph cycle $$C$$ is an edge not in the edge set of $$C$$ whose endpoints lie in the vertex set $$C$$.

For example, in the following graph, the edge $$3-4$$ is a chord of the cycle $$1-2-3-4-1$$.

A chordless cycle of a graph $$G$$ is a graph cycle in $$G$$ that has no cycle chord.

# Streamlining the code

In convelist,

• Map[List@@#&,cycle] is succinctly written as List@@@cycle.
• You can map on the second level (i.e. over the vertex indices instead of the UndirectedEdges): for instance, Union@Reap[Map[Sow,cycle,{2}]][[2,1]].
• Since each edge in a cycle is ordered consistently, you can just use Span to take the first vertex in each edge: cycle[[;;,;;,1]]

Your noIntersectionQ can be replaced with DisjointQ.

In finddisjointcycles,

• If you forgo For loops, declaring i, j and n becomes unnecessary. Keeping in mind Is there a Break[] equivalent for short-circuiting in Table?, you could use Table:

Table[
If[DisjointQ@@listOfLists[[{i,j}]], Return[{i,j},Table]],
{i,Length@listOfLists},{j,i-1}]


While your functions are very useful for learning the internals of Mathematica, I'd say they're simple enough to not warrant definition. So I'd write something like

finddisjointcycle[g_Graph]:=
Table[ If[DisjointQ@@#[[{i,j}]],Return[{i,j},Table]],
{i,Length@#},{j,i-1}]& @FindCycle[g,{10},All][[;;,;;,1]]


If you want to find all such cycles, you can exploit SequencePosition:

finddisjointcycles[g_Graph] := SequencePosition[
FindCycle[g,{10},All][[;;,;;,1]],
{x_,___,y_}/;DisjointQ[x,y]:>{x,y},Overlaps->True]


with the added benefit that you can simply include an extra ,1 parameter to limit it to one instance.

# Chordless

You could somehow filter the result of FindCycle to only deal with chordless ones. Alternatively, I believe FindFundamentalCycles would return all chordless cycles, so you can filter its result for 10 long single face cycles.