1
$\begingroup$

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

enter image description here

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$.

enter image description here

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

$\endgroup$

1 Answer 1

1
$\begingroup$

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,

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.

$\endgroup$
1

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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