# How to find a cycle between different groups of edges?

For example, I have four groups of data in a list

{{{1, 2}, {1, 3}},
{{3, 4}, {3, 5}, {4, 2}},
{{4, 1}, {1, 4}, {1, 3}},
{{2, 3}, {1, 5}}}


I want to find a directed cycle of size 4, with each edge from each group, the order of the group does not matter. In this case {1, 2, 3, 4} should be returned. My current brute force solution is to generate all the permutations of the rest $4-1$ groups and try if the last element is equal to the first element in the next list for any two adjacent groups. Are there any better solutions?

• I was trying to come up with a good way to do this with coloured graph isomorphism, but I wasn't able to. The problem is that colours should be interchangeable (" the order of the group does not matter") which means that I have to generate too many different colourings for the cycle (4!/4 = 6 I think) before I match it. Then the solution is just not simple anymore. Basically it's the same as yours. So you might as well use FindCycle to find all cycles and then verify that the edges of the cycle are in different groups. Aug 1, 2016 at 15:27
• @Szabolcs my method is bad even after generating 3! Permutations. If you have a good method after that, I am very interested in learning it. Aug 1, 2016 at 15:31
• OK, I posted how I'd do it with FindCycles. But I suggest you don't accept the answer and instead wait to see if people show better methods. I am sure there are better ways. Aug 1, 2016 at 15:36

## 1 Answer

One way is to use FindCycle and then filter out those cycles where the four edges are not all from different groups.

edgeGroups =
Apply[DirectedEdge, {{{1, 2}, {1, 3}}, {{3, 4}, {3, 5}, {4,
2}}, {{4, 1}, {1, 4}, {1, 3}}, {{2, 3}, {1, 5}}}, {2}];


Let us assign "colours" (integers) to the edges based on which group they are in:

colours =
Association@
Flatten[Thread /@ Thread[edgeGroups -> Range@Length[edgeGroups]]]


Since we have this, we might as well visualize the graph with colours:

g = Graph[Keys[colours],
EdgeStyle -> Normal[ColorData[97] /@ colours],
VertexLabels -> "Name"]


Now we find all cycles:

cycles = FindCycle[g, {4}, All]

(* {{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 4, 4 \[DirectedEdge] 1}} *)


And keep only those where all the edges come from different groups:

Select[
cycles,
Length@Union@Lookup[colours, #] == Length[edgeGroups] &
]


I.e. we want to have 4 different edge colours in the cycle because we have 4 colours in total.