Finding All Chordless Simple Cycles In A Graph

Here's a weird way to find chordless cycles in V12+: convert the Graph into a Molecule and query for the set of smallest rings.

Your example:

grapht = Graph[
{
  1 <-> 2, 1 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 
  6 <-> 7, 3 <-> 5, 3 <-> 9, 5 <-> 8, 8 <-> 9
},
VertexLabels -> "Name"];

rings = Molecule[grapht]["SmallestSetOfSmallestRings"]
{{1, 2, 4, 5, 3}, {6, 5, 4}, {8, 9, 3, 5}}
HighlightGraph[grapht, PathGraph[Append[#, First[#]]]] & /@ rings

enter image description here

Now it seems a graph with vertex degree greater than 4 can't become a molecule, but we can work around this with a hidden option. I've packed this into a function:

ChordlessRings[g_?GraphQ] :=
  Block[{mol, rings},
    mol = Quiet[Molecule[IndexGraph[g], "GraphValenceRules" -> {_ -> "C"}]];
    (
      rings = mol["SmallestSetOfSmallestRings"];

      rings /; ListQ[rings]

    ) /; MoleculeQ[mol]
  ]

ChordlessRings[___] = $Failed;

A larger example:

SeedRandom[4];
vm = VoronoiMesh[RandomReal[{-1, 1}, {100, 2}], {{-1, 1}, {-1, 1}}];
g = PlanarGraph[MeshCells[vm, 1][[All, 1]], VertexSize -> Large]

(rings = ChordlessRings[g]) // Length
100
HighlightGraph[g, PathGraph[Append[#, First[#]]]] & /@ rings[[1 ;; 5]]

enter image description here

Graphics @ GraphicsComplex[
  GraphEmbedding[g], 
  {EdgeForm[Black], {RandomColor[Hue[_]], Polygon[#]} & /@ rings}
]

Or we can ensure no 2 adjacent faces share the same color:

Block[{Print}, << IGraphM`]

imat = SparseArray[Join @@ MapIndexed[Thread[Thread[{First[#2], #1}] -> 1] &, rings]];
faceadj = Unitize[imat.Transpose[imat]];
faceconn = SimpleGraph@AdjacencyGraph[faceadj];

colors = IGMinimumVertexColoring[faceconn];

Graphics @ GraphicsComplex[
  GraphEmbedding[g], 
  {EdgeForm[Black], MapThread[{ColorData[112, #2], Polygon[#]} &, {rings, colors}]}
]


First, let us find all cycles in the graph. Then, we will filter out the ones that contain chords; this we can detect by checking if the $n$-vertex induced subgraph is isomorphic to a cycle of length $n$ or not.

Let us use your graph as an example:

g = Graph[{1 <-> 2, 1 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 
   6 <-> 7, 3 <-> 5, 3 <-> 9, 5 <-> 8, 8 <-> 9}, 
  VertexLabels -> "Name"];

cy = VertexList[Graph[#]] & /@ FindCycle[g, Infinity, All];
Select[cy, IsomorphicGraphQ[CycleGraph[Length[#]], Subgraph[g, #]] &]
(* {{4, 5, 6}, {5, 8, 9, 3}, {1, 2, 4, 5, 3}} *)

HighlightGraph[g, %]

Of course, if you have additional constraints, you can simply modify the call to FindCycle with different parameters to only find cycles of length e.g. of size 5, 6, 7, or 8. To achieve this, just do FindCycle[g, {5, 8}, All] instead.


IGraph/M may help with this.

IGLADFindSubisomorphisms can look for induced subgraphs, and you are looking for induced cycles.

We can construct a function like this:

Needs["IGraphM`"]
chordlessCycles[graph_?UndirectedGraphQ] := 
  Join @@ Table[
    DeleteDuplicatesBy[Sort]@Values@IGLADFindSubisomorphisms[CycleGraph[k], graph, "Induced" -> True], 
    {k, IGGirth[graph], VertexCount[graph]}
  ]

This function will look for cycles of all sizes starting with the girth up to the vertex count. For your graph, it returns

chordlessCycles[graph]
(* {{3, 4, 12, 13, 11}, {1, 6, 5, 4, 3, 2}, {3, 7, 8, 9, 10, 11}} *) 

Beware that in general there may be a very large number of induced cycles. Stealing Chip's graph generation code, here's an example:

SeedRandom[4];
vm = VoronoiMesh[RandomReal[{-1, 1}, {10, 2}], {{-1, 1}, {-1, 1}}];
g = PlanarGraph[MeshCells[vm, 1][[All, 1]], VertexSize -> Large]

enter image description here

cycle[vlist_] := PathGraph[Append[vlist, First[vlist]]]

HighlightGraph[g, cycle[#], GraphHighlightStyle -> "Thick", 
   ImageSize -> 60] & /@ chordlessCycles[g]

enter image description here