I want to find two sublists in a list by an element they contain, and then union them, keeping them in the list.

I have this code that seems to do the job, but it seems rather clunky. Is there a better way to do it?

It finds the sublists from the example list 'groups' containing b and g, then unions them. You have to do the check to verify that the elements don't belong to the same sub-list already, or else you end up deleting the sub-list they're both contained in.

The master list will always be two levels deep, and wouldn't have any duplicates.

groups = {{a}, {b, c}, {d}, {e, f, g}}
firstPart = b;
secondPart = g;
fPAddress = Part[Position[groups, firstPart, 2], 1, 1];
sPAddress = Part[Position[groups, secondPart, 2], 1, 1];
If[fPAddress != sPAddress,
 groups = ReplacePart[groups, fPAddress ->
     Part[groups, fPAddress],
     Part[groups, sPAddress]
 groups = Delete[groups, sPAddress];

5 Answers 5


Using rules:

groups //. {a___, x : {___, b | g, ___}, b___, y : {___, b | g, ___}, c___} :>
{a, Union[x, y], b, c}

This behaves differently compared to your code when there are more than two sublists which contain either b or g, in that it will take the union of all of them whereas your code doesn't do that. I hope this is what you intended, or perhaps it's never the case that there are more than two sublists involved?

Or, inspired by march's solution, we might also write

{hasNot, has} = GatherBy[groups, MemberQ[b | g]];
Append[hasNot, Union @@ has]

which can also be written

Append[#, Union @@ #2] & @@ GatherBy[groups, MemberQ[b | g]]

MemberQ can be replaced by ContainsAny. If performance is important, one might try this.

  • $\begingroup$ Yes, they work as intended, thank you! $\endgroup$
    – Eriek
    Jan 27, 2017 at 16:54
Flatten /@ Gather[groups, MemberQ[#1, b | g] && MemberQ[#2, b | g] &]
conditionalUnion[test_] := Reap[
   If[test @ #, 
      Sow[#, Apply @ Union], 
      Sow[#, Apply @ Sequence]] & /@ #,
    _, Construct][[2]] &;


conditionalUnion[MatchQ[{___, b | g, ___}]] @ groups

{{a}, {d}, {b, c, e, f, g}}

conditionalUnion[ContainsAny[{b, g}]] @ groups

{{a}, {d}, {b, c, e, f, g}}

Take the union of sublists with lengths less than 3:

conditionalUnion[Length[#] <= 2&] @ groups

{{a, b, c, d}, {e, f, g}}

  • 1
    $\begingroup$ (+1) I really like this approach with Reap and Sow :-) $\endgroup$ Jan 10 at 21:21
groups = {{a}, {b, c}, {d}, {e, f, g}};

Using GroupBy

{#[False], Union @@ #[True]}& @ GroupBy[groups, ContainsAny @ {b, g}]

{{{a}, {d}}, {b, c, e, f, g}}

{#[False], Union @@ #[True]}& @ GroupBy[groups, ContainsAny @ {a, g}]

{{{b, c}, {d}}, {a, e, f, g}}

  • $\begingroup$ Hi, @eldo! You can add If[MatrixQ[#], Splice@#, #] & in the third argument of GroupBy to get the solution in the form {{a}, {d}, {b, c, e, f, g} } :-) $\endgroup$ Jan 10 at 21:24
  • 1
    $\begingroup$ Do you mean GroupBy[groups, ContainsAny@{b, g}, If[MatrixQ[#], #, Splice@#] &] ? - That doesn't seem to function, $\endgroup$
    – eldo
    Jan 10 at 23:40

Using Cases and ReplaceAll:

groups = {{a}, {b, c}, {d}, {e, f, g}};

{hasNot, has} = {s_ /; ! ContainsAny[s, {b, g}] :> s, 
                 s_ /; ContainsAny[s, {b, g}] :> Splice@s};

ReplaceAll[m_ /; MatrixQ[m] :> Splice@m][Cases[groups, #] & /@ {hasNot, has}]

(*{{a}, {d}, {b, c, e, f, g}}*)

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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