3
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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

For your example:

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Marilla Feb 23 '17 at 10:12
4
$\begingroup$

I think this is what you're after:

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

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]] &;
$\endgroup$
  • $\begingroup$ Many thanks for your answer; It's exactly what I want. $\endgroup$ – Marilla Feb 23 '17 at 10:05
1
$\begingroup$

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

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]
$\endgroup$
  • $\begingroup$ Thanks David for your reply. Actually, the list2 would be the list to find; So, I don't have it from the beginning. $\endgroup$ – Marilla Feb 23 '17 at 10:08
0
$\begingroup$
list = {{1, 2, 9}, {2, 3, 7}, {5, 6, 9}, {8, 10, 11}};

DeleteDuplicates[list, IntersectingQ]

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


As your Preferably

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

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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