# How to extract mutually disjoint elements(lists) of a list of lists?

Suppose that I have a list of lists, for example:

my_list = {{1,2,9},{2,3,7},{5,6,9},{8,10,11}}


I want to manipulate the list such that it contains only all the mutually disjoint elements of the list, as follows:

my_list = {{1,2,9},{8,10,11}}


or

my_list = {{2,3,7},{5,6,9},{8,10,11}}


Preferably, the instances with more elements, like the second one.

Thanks in advance for any help and guide.

I would turn your question into a graph problem. Consider your lists as vertices, and an edge between two vertices exists if there is a common element. Then, FindIndependentVertexSet should find the set with the maximal number of vertices with no common edge, i.e., what you're interested in. Here is the code:

maximalDisjointSubset[list_]:=Module[{vertices = Range@Length@list,edges},
edges=Cases[
Subsets[vertices,2],
{i_,j_} /; Intersection @@ list[[{i,j}]] != {} :> i<->j
];
list[[First @ FindIndependentVertexSet @ Graph[vertices,edges]]]
]


maximalDisjointSubset[{{1,2,9},{2,3,7},{5,6,9},{8,10,11}}]


{{2, 3, 7}, {5, 6, 9}, {8, 10, 11}}

Note that finding a maximal independent vertex set is an NP-hard optimization problem.

• Many thanks Carl for your answer; yes, that's exactly what I want as well. Actually, I was thinking to use the "FindIndependentVertexSet", but by considering every individual number as a vertex and not every list. Considering the lists solves the problem. That's great. Feb 23 '17 at 10:12

I think this is what you're after:

fn=Module[{ms = Subsets[#, {2, Length@#}]},
Take[Reverse[Pick[ms, And @@ DisjointQ @@@ Subsets[#, {2}] & /@ ms]],UpTo]] &;

mylist = {{1, 2, 9}, {2, 3, 7}, {5, 6, 9}, {8, 10, 11}}
fn@mylist


{{{2, 3, 7}, {5, 6, 9}, {8, 10, 11}}}

BTW, don't use underscores willy-nilly (note I used mylist vs my_list), or you'll be in for some nasty surprises.

If you want all the instances, in order of length (as opposed to one of the longest cases as in OP), use:

fn2 = Module[{ms = Subsets[#, {2, Length@#}]},
Pick[ms, And @@ DisjointQ @@@ Subsets[#, {2}] & /@ ms]] &;

• Many thanks for your answer; It's exactly what I want. Feb 23 '17 at 10:05

Perhaps for small lists:

my = {{1, 2, 9}, {2, 3, 7}, {5, 6, 9}, {8, 10, 11}};
g = RelationGraph[Intersection[#1, #2] == {} &, my];
FindClique[g, Infinity, All]


yields:

{{{2, 3, 7}, {5, 6, 9}, {8, 10, 11}}, {{1, 2, 9}, {8, 10, 11}}}

• slightly simpler RelationGraph[DisjointQ, my]? (+1)
– kglr
Feb 23 '17 at 2:48
• @kglr thank you for the refinement and the vote Feb 23 '17 at 3:02
• Many thanks for your answers and guide. Actually, Clique is not what I need, but I'll test RelationGraph as well. Feb 23 '17 at 10:06
• @Marilla sorry for the misunderstanding. Good luck Feb 23 '17 at 10:08
• no problem at all; I appreciate your time and consideration. Feb 23 '17 at 11:21

It is unclear what you're asking, but perhaps this is your solution:

list1 = {{1, 2, 9}, {2, 3, 7}, {5, 6, 9}, {8, 10, 11}};
list2 = {{1, 2, 9}, {8, 10, 11}};
Complement[list1, list2]

• Thanks David for your reply. Actually, the list2 would be the list to find; So, I don't have it from the beginning. Feb 23 '17 at 10:08
list = {{1, 2, 9}, {2, 3, 7}, {5, 6, 9}, {8, 10, 11}};

DeleteDuplicates[list, IntersectingQ]


{{1, 2, 9}, {8, 10, 11}}

First[FindIndependentVertexSet[RelationGraph[IntersectingQ, list]]]