Choosing sets from Subset[list]

Question

Say I have a set, S, and I take Subsets[S] (the power set of S). For example:

S={a,b,c}
Subsets[S]={{}, {a}, {b}, {c}, {a, b}, {a, c}, {b, c}, {a, b, c}}

How can I make a list which takes only sets which have an element of a subset, but not the whole set. Ideally, using the example above, something like this:

f[Subsets[S],a]={{a},{a,b},{a,c}}

Further, say I have a set of subsets. Using the above example:

L={{a},{b}}

How can I choose the elements from Subsets[S] so that any of the elements of L are subsets, but not including the whole set. Again, using the above:

g[Subsets[S],L]={{a},{b},{a,b},{a,c},{b,c}}

Ideally, g could be generalized for any power set and set of subsets.

Any help would be greatly appreciated, thank you.

Answer 1

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.

Answer 2

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

Answer 3

You should use SubsetQ[list1,list2] which is True exactly if list2 is a subset of list1. So define

SubsetLQ[list1_,listoflists_]:=And@@(SubsetQ[list1,#]&/@listoflists)

This should give you True exactly if all elements of listoflists are a subset of list1. Then use

Select[Subsets[S],SubsetLQ[#,L]&&Length@#<Length@S&]

This should work, provided I understood correctly what you are looking for

Answer 4

Update with more general solution that makes at most one extra subset and works when items are not in set.

h[set_List, items_List] :=
 With[{comp = Complement[set, items]},
  Select[Length@# != Length@comp + Length@items &]@
   Flatten[Outer[Flatten@*Join, Subsets[items, {1, Length@items}], Subsets[comp], 1], 1]
  ]

h[{a, b, c}, {a}]
(* {{a}, {a, b}, {a, c}} *)

h[{a, b, c}, {a, b}]
(* {{a}, {a, c}, {b}, {b, c}, {a, b}} *)

h[{a, b, c}, {f}]
(* {{f}, {f, a}, {f, b}, {f, c}, {f, a, b}, {f, a, c}, {f, b, c}} *)

---

Original post

ContainsAny with Select (twice).

g[set_List, items_List] := 
 Select[set != # &]@Select[ContainsAny[items]]@Subsets[set]

s = {a, b, c}; t = {a};
g[s, t]

(* {{a}, {a, b}, {a, c}} *)

t = {{a}, {b}};
g[s, Flatten@t]

(* {{a}, {b}, {a, b}, {a, c}, {b, c}} *)

Hope this helps.

Answer 5

Select[Subsets[{a, b, c}], MemberQ[#, a] && Length@# < 3 &]

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

Select[Subsets[{a, b, c}], MemberQ[#, a | b] && Length@# < 3 &]

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