10
$\begingroup$

Given

lis={{{a},{b,c,d}},{{a,b},{b,c}},{{b,c},{a,b,c}},{{b},{d}},{{a,b},{c,d}}}

I want to delete sublists which have one or more elements in common. So that I would get

{{{a},{b,c,d}},{{b},{d}},{{a,b},{c,d}}}

Is there a way without flattening Level 3 first?

$\endgroup$
  • $\begingroup$ user57467, could you clarify what would be the desired output for input list lis3 = {{{a, a}, {b, c, d}}, {{a, b}, {b, c}}};? $\endgroup$ – kglr Jan 20 at 19:35
10
$\begingroup$

Select+ ContainsNone

Select[Apply[ContainsNone]]@lis

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

Pick + ContainsNone:

Pick[#, ContainsNone @@@ #] & @ lis

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

Cases + ContainsNone

Cases[{a_, b_} /; ContainsNone[a, b]]@lis

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

DeleteCases + ContainsAny

DeleteCases[{a_, b_} /; ContainsAny[a, b]]@lis

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

DeleteCases

DeleteCases[{{___, a_, ___}, {___, a_, ___}}] @ lis

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

Note: If either element of the sublist pairs contains duplicates, as in

lis2 = {{{a, a}, {b, c, d}}, {{a, b}, {b, c}}, {{b, c}, {a, b, c}}, 
  {{b}, {d}}, {{a, b}, {c, d}}};

then

Select[Apply[ContainsNone]] @ lis2
Pick[#, ContainsNone @@@ #] & @ lis2
Cases[{a_, b_} /; ContainsNone[a, b]] @ lis2
DeleteCases[{a_, b_} /; ContainsAny[a, b]] @ lis2
DeleteCases[{{___, a_, ___}, {___, a_, ___}}] @ lis2

all give

{{{a, a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

while the methods proposed by @Nasser and @ThatGravityGuy

Cases[lis2, {x_, y_} /; Length@Union[x, y] == (Length[x] + Length[y]) :> {x, y}]
Select[lis2, DuplicateFreeQ@*Flatten]

both give

{{{b}, {d}}, {{a, b}, {c, d}}}

$\endgroup$
  • $\begingroup$ You just blew my head off! Great! $\endgroup$ – user57467 Jan 21 at 4:55
10
$\begingroup$

I am sure there are many ways to do this. One possible way is to take the union of both sublists, and check if its length is same as sum of length of both sublists. Since when making union, duplicates are automatically removed.

lis = {{{a}, {b,c,d}}, {{a,b}, {b,c}}, {{b,c},{a,b,c}}, {{b},{d}}, {{a,b}, {c,d}}};

Cases[lis, {x_, y_} /; Length@Union[x, y] == (Length[x] + Length[y]) :> {x, y}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Good explanation for your code! $\endgroup$ – user57467 Jan 20 at 6:18
9
$\begingroup$

Another method with DuplicateFreeQ, where @* is shorthand/infix notation for Composition.

Select[lis, DuplicateFreeQ@*Flatten]

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

Another way of really doing the exact same thing is with Pick.

Pick[lis, DuplicateFreeQ@*Flatten /@ lis]

Basically, either method picks out the elements of lis such that DuplicateFreeQ@*Flatten[elem] == True.

$\endgroup$
  • $\begingroup$ Could you explain the code, please? What is "@*"? $\endgroup$ – user57467 Jan 20 at 11:38
3
$\begingroup$
lis//Pick[#,IntersectingQ@@@#,False]&

{{{a}, {b, c, d}}, {{b}, {d}}, {{a, b}, {c, d}}}

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