Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

How to match set-patterns against sets?

A set (in the mathematical sense) is a list of elements without repetition and order of elements does not matter. For example, we have a pattern set {3, 1} that should match sets {1, 3}, {1, 2, 3}, {1, 2, 3, 4} and so on. Note, that the list-length of the pattern is not relevant: any set that contains elements 3 and 1 should match the pattern. So far, this is simple subset testing - but there are two problems:

  1. Since order does matter for the patternmatcher, one has to write e.g. Cases[sets, {___, 3, ___, 1, ____}|{___, 1, ___, 3, ____}] which causes a combinatorial expansion for an increasing number of element-wise matches. Thus I used MemberQ instead of structural patterns.

  2. I would like to use more complicated patterns, like: "Find all sets that contain 1 and 3 but not 2!".

I have a working solution, but it is neither effective nor elegant in my opinion. It involves a Boolean description of the pattern (And to include all listed elements, Or to include any listed element, Not to exclude an element), but I am not sure it is the right way to do it. The function simply wraps each element that apperas in the pattern into MemberQ, so the Boolean expression translates to a logical combination of MemberQ and Not@MemberQ calls.

setCases[sets_List, patt_] := Module[{elem = Union @@ sets},
   Cases[sets, _?((patt /. x_ /; MemberQ[elem, x] :> MemberQ[#, x]) &), {1}]
   ];

Define a list of sets, and a list of patterns for testing:

sets = Subsets[{1, 2, 3, 4}];

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}

Grid[{#, setCases[sets, #]} & /@ patterns, Alignment -> Left, 
 Background -> {None, {{LightGray, White}}}, Spacings -> {1, 1}] // TraditionalForm

Mathematica graphics

Let's examine one case closer, by displaying the ultimate pattern that is tested:

(1 \[Or] 2) \[And] \[Not] 3 /. x_Integer :> MemberQ[#, x]
(MemberQ[#1, 1] & || (MemberQ[#1, 2] &)) && ! (MemberQ[#1, 3] &)

As one can see, the function is far from being economic: alternatives could have been gathered under one MemberQ (MemberQ[#, 1]& || MemberQ[#, 2]& is equivalent to MemberQ[#, 1|2]&) and I think that Except should be used as well, though have no idea how. I am interested in robust, fast solutions.

Note: Do NOT try to simplify the logical patterns, as:

Simplify[And[1, 2]] ==> 2
Simplify[And[0, 1]] ==> False
share|improve this question

3 Answers 3

up vote 7 down vote accepted

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.

share|improve this answer
    
You know how it is... After 3 days of intensive brainstorming you close in on the core of your problem. And that is the point where you won't see the wood from the tree. –  István Zachar Feb 16 '13 at 18:13
    
To answer your Q about the complicatedness of life in general: in my case I refrained to use Union, Intersection and Complement because I inject the sets later into placeholders which are not sets themselves, thus functions like Union must be hold. Instead of holding, I went the other way. –  István Zachar Feb 16 '13 at 18:19
    
@IstvánZachar Actually, I changed my mind after reading the question more carefully, for more complex patterns of the type you ask for we may benefit from something else than Complement and Intersection - such as pattern-matcher. Working on an automatic translator from your patterns to the ones I use here... –  Leonid Shifrin Feb 16 '13 at 18:24
2  
Ha! The late addition Simplify was the problem: apparently, Simplify[And[1,2]] simplifies to 2. I didn't know that 0/1 booleans are handled this way! –  István Zachar Feb 16 '13 at 18:42
1  
@IstvánZachar I analyzed the current setup and came to a conclusion that your pattern language is ambiguous because it is underspecified. What you need is to introduce two new quantors: exists and for all. Then, your logical operators such as Not or Identity will be applied to these. Then, there will be no ambiguities left. –  Leonid Shifrin Feb 16 '13 at 19:13

This solution is in the same spirit as your approach:

Clear@findSets
findSets[list_, all_, any_, none_] := Block[{set},
    SetAttributes[set, {Flat, Orderless}];
    Select[set @@@ list, 
        Function[s,
            !FreeQ[s, set @@ all] &&
            Or @@ (! FreeQ[s, set@#] & /@ any /. {} -> True) &&        
            And @@ (FreeQ[s, set@#] & /@ none)
        ]
   ] /. set -> List
]

Use an empty set if you're not specifying anything. You can also use default values of {} or convert the arguments to options such as Any -> {1,2}, All -> {3}, None -> {4} if that's easier to read. Here's an example usage:

l = Subsets[{1, 2, 3, 4}];
findSets[l, {2}, {3}, {}]
(* {{2, 3}, {1, 2, 3}, {2, 3, 4}, {1, 2, 3, 4}} *)

findSets[l, {1, 2}, {}, {4}]
(* {{1, 2}, {1, 2, 3}} *)

findSets[l, {1}, {2, 4}, {3}]
(* {{1, 2}, {1, 4}, {1, 2, 4}} *)
share|improve this answer

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
share|improve this answer
    
Looks like I won't have time to look at this today, but I will surely do as soon as I have time, and +1 in advance :) –  Leonid Shifrin Feb 17 '13 at 16:32
    
I just realized you hit 20k without me saying anything: congratulations! –  Mr.Wizard Feb 17 '13 at 19:28
    
@Mr.Wizard thanks :), now go get the 50k –  Rojo Feb 17 '13 at 19:34

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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