Patternmatching sets

A main idea of a pattern-based solution

I don't know why we should make life so complicated, since you can always use things like Intersection and Complement to test whether a given set is a subset of another set. But if you want to use the pattern-matcher, here is one option:

ClearAll[set];
SetAttributes[set, {Orderless, Flat, OneIdentity}];

ClearAll[setCasesLS]
setCasesLS[sets : {__List}, patt_] :=
   List @@@ Cases[set @@@ sets, patt];

Now, for example:

setCasesLS[sets, set[1,__]]

(*  {{1}, {1, 2}, {1, 3}, {1, 4}, {1, 2, 3}, {1, 2, 4}, {1, 3, 4}, {1, 2, 3, 4}}  *)

setCasesLS[sets,set[1,Except[2|set[3 ,Except[4]]]...]]

(* {{1},{1,3},{1,4},{1,3,4}}  *)

It may be an interesting sub-problem to to translate your specs into the patterns used here (involving Except etc), but at least conceptually this could be a valid starting point.

Pattern translator (a sketch, may contain errors)

Ok, it seems that I was able to write a pattern translator which translates your patterns into those which can be used with setCasesLS. But the code is long and ugly, and I would not be suprised if it won't work in more complicated cases. Anyway, here goes:

This is a set of preprocessing functions:

ClearAll[or, and, not];
SetAttributes[{or, and}, {Flat, OneIdentity}];
or[left : Except[_not] ..., x_not, y : Except[_not], rest___] :=
   or[left, y, x, rest];
and[left : Except[_not] ..., x_not, y : Except[_not], rest___] :=
   and[left, y, x, rest];
and[not[x_], not[y_]] /; FreeQ[{x, y}, _not] := not[or[x, y]];
not[not[x_]] := x;
not[and[x_, y_]] := or[not[x], not[y]];
and[left___, or[not[x_], y___], right___] :=
   or[and[left, not[x], right], and[left, y, right]];

Clear[process];
process[expr_] :=  expr /. {And -> and, Not -> not, Or -> or}

Here is a pattern converter:

ClearAll[convert];
convert[HoldPattern[pattern[or[simple : Except[_not | _and] .., rest___]]]] :=
   Alternatives[
     set[Alternatives @@ simple, ___],
     Sequence @@ convert[pattern[or[rest]]]
   ];
convert[HoldPattern[pattern[or[args___]]]] :=
    Alternatives @@ 
        Map[
          If[MatchQ[#, _not], set[convert[#]], convert[pattern[#]]] &, 
          {args}
        ];
convert[HoldPattern[pattern[and[args : Except[_not] ..]]]] :=
   set @@ Append[Map[convert, {args}], ___];
convert[HoldPattern[pattern[and[args___]]]] :=
   set @@ Map[convert, {args}];
convert[HoldPattern[pattern[not[x_]]]] := Except[convert[pattern@x]];
convert[HoldPattern[not[x_]]] := Except[convert[x]] ...;
convert[HoldPattern[or[args___]]] := Alternatives[args];
convert[pattern[x_]] := set[x, ___];
convert[x_] := x;

and this is a main function to bring it all together:

ClearAll[fullConvert];
fullConvert[patt_] :=
  With[{res = convert@pattern@process@patt},
     res /; FreeQ[res, not | and | or]
  ];
fullConvert[patt_] :=
  With[{res = convert@pattern@not@process@Not@patt},
     res /; FreeQ[res, not | and | or]
  ];
fullConvert[patt_] := $Failed;

If it does not succeed in converting a direct pattern, it attempts to convert a negated one. If that also fails, it returns $Failed.

Here is how this works on your patterns:

fullConvert/@patterns

{
    set[1,___],
    Except[set[1,___]],
    set[1,Except[2]...],
    set[1,___]|set[Except[2]...],
    set[1,___]|set[2,___]|set[3,___],
    set[1,2,3,___],
    set[1,Except[2|3]...],
    set[1,___]|set[2,Except[3]...],
    set[1,Except[3]...]|set[1,Except[2]...],
    set[1,Except[2|3]...],
    Except[set[2,___]|set[3,Except[4]...]|set[Except[1]...]],
    Except[set[1,___]|set[4,___]|set[2,___]|set[3,___]]
 }

If you now execute

 setCasesLS[sets, fullConvert[#]]} & /@ patterns

you get the results identical to yours.

I actually think that I am missing some simplificatins which would make the above code shorter, more general and more robust at the same time, but the current solution still seems interesting enough to post it.

This is just to give set the proper attributes and make it simplify double ___ and __

ClearAll[set];
set[a___, Verbatim[___], Verbatim[___] .., b___] := set[a, ___, b];
set[a___, Verbatim[__], Verbatim[__] .., Verbatim[___] ..., b___] := 
  set[a, __, b];
SetAttributes[set, {Orderless, Flat, OneIdentity}];

The patterns will be a boolean function of subset[el1, el2, el3...], with the possibility of mixing patterns, so Except[subset[1,2]] would represent any subset that is not subset[1,2], and subset[1, 3, _] would represent any subset with 1, 3, and any other element.

forms = {"DNF", "CNF",  "AND", "OR"};

convertPattern[patt_, 
  type : (Alternatives @@ forms | Automatic) : Automatic] := 
 With[{pat = BooleanMinimize[patt, type]}, 
  Internal`InheritedBlock[{And, Or}, SetAttributes[{And, Or}, Orderless]; 
   ClearAttributes[{And, Or}, Flat]; And[patt] //. convertionRules]]

convertionRules = {
   And[a___, b : (\[Not] _) .. // Longest] :> 
    Except[Alternatives[b]~Thread~Not // First, And[a]],
   And[a_subset, b__subset, rest___ // Shortest] :> 
    And[set @@ 
      Append[List @@@ Unevaluated@leastCommonElements[a, b], ___], 
     rest],
   (subset | And)[a___] :> set[a, ___], Or -> Alternatives,
   Not -> Except,
   Verbatim[Alternatives][a_] :> a};

(*Thanks @rm-rf*)
leastCommonElements[lists___List] := 
 Join @@ Composition[Last, Sort] /@ 
   GatherBy[Join @@ Gather /@ {lists}, First]

So given

patterns = {1, \[Not] 1, 1 \[And] \[Not] 2, 1 \[Or] \[Not] 2, 
  1 \[Or] 2 \[Or] 3, 1 \[And] 2 \[And] 3, 
  1 \[And] \[Not] 2 \[And] \[Not] 3, 1 \[Or] (2 \[And] \[Not] 3), 
  1 \[And] \[Not] (2 \[And] 3), 1 \[And] \[Not] (2 \[Or] 3), 
  1 \[And] \[Not] (2 \[Or] (3 \[And] \[Not] 4)), \[Not] 
    1 \[And] \[Not] 2 \[And] \[Not] 3 \[And] \[Not] 4}

sets = Subsets[Range[6]];

To translate your patterns to our form we just need to wrap the integers in subset, if I understood correctly

newPatterns = patterns /. i_Integer :> subset[i]

Now, we can see the patterns converted

Table[{patterns, convertPattern[#, form] & /@ (newPatterns)}\[Transpose] // 
  TableForm , {form, forms}]

Finally, we can test it

Cases[set @@@ sets, convertPattern[#]]&/@newPatterns/.set->List//Column