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