Choosing sets from Subset[list]

This is my attempt to cover the generalized case that you describe. I went ahead and made it even a little bit more general, as the tests will show.

Solution:

SelectSubsets[S_, el : Except[_List]] := SelectSubsets[S, {el}]
SelectSubsets[S_, lists : {{__} ..}] := SelectSubsets[S, #] & /@ lists
SelectSubsets[S_, list_] := Cases[Subsets[S], Except[S,
   Prepend[___]@Append[___]@Riffle[ConstantArray[Alternatives @@ list, Length@list], ___]
   ]]

Tests:

S = {a, b, c, d};
SelectSubsets[S, a]

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

SelectSubsets[S, {a, b}]

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

SelectSubsets[S, {{a}, {b}}]

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

Union @@ SelectSubsets[S, {{a}, {b}}]

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

SelectSubsets[S, {{a, b}, {b, d}}]

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

Explanation

SelectSubsets is implemented in terms of Cases[list, form] which compares every element in list to the pattern form in order to determine if it should be included in the result.

Except is used in the pattern to remove the full set from the list:

S = {a, b, c};
Cases[Subsets[S], Except[S]]

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

The heart of the solution is this pattern:

Prepend[___]@Append[___]@Riffle[ConstantArray[Alternatives @@ list, Length@list], ___]

For example if list is {a, b} then this results in

{___, a|b, ___, a|b, ___}

and if list is {a, b, c} it evaluates to

{___, a|b|c, ___, a|b|c, ___, a|b|c, ___}

So, this pattern will find every subset that includes a, b, and c.

The more complex inputs can be handled using the pattern described above. You will find that the two first definitions of SelectSubsets are just ways to do what they are supposed to do in terms of this pattern.


To not generate all subsets we can do something like:

ClearAll[sel]
sel[el_, set_] := Flatten[#, 1] & /@ Most @ Tuples[{
     Rest @ Subsets[el], 
     Subsets @ DeleteCases[set, Alternatives @@ el]
}]

sel[{a}, {a, b, c}]
{{a}, {a, b}, {a, c}}
sel[{a, b}, {a, b, c}]
{{a}, {a, c}, {b}, {b, c}, {a, b}}