4
$\begingroup$

I have got a list:

lis:={
{{1, 2, 3, 4}},
{{1, 2, 3}, {4}},
{{1, 2, 4}, {3}},
{{1, 2}, {3, 4}},
{{1, 2}, {3}, {4}},
{{1, 3, 4}, {2}},
{{1, 3}, {2}, {4}},
{{1, 4}, {2, 3}},
{{1}, {2, 3, 4}},
{{1}, {2, 3}, {4}},
{{1, 4}, {2}, {3}},
{{1}, {2, 4}, {3}},
{{1}, {2}, {3, 4}},
{{1}, {2}, {3}, {4}}
};

and I would like to pick out those lists which satisfy the following condition:

list == Mod[list+2,4,1]

but, they should be "equal" as a set of lists, not in a "element to element" way. For example, {{1,2},{3,4}} is a list satisfied the condition, since Mod[{{1,2},{3,4}}+2,4,1] is {{3, 4}, {1, 2}}, which is not equal to {{1,2},{3,4}} since the "position" is not right, but we should regard it as equal in the sense of set, since they are both the set of {1,2} and {3,4}.

An example which not satisfied our condition is that {{1,2,3},4}, since Mod[{{1, 2, 3}, 4} + 2, 4, 1] is {{3, 4, 1}, 2}, as a set they are not equal, one is the union of {1,2,3} and {4}, but the results is the union of {1,3,4} and {2}.

Can I use a pattern to sort out the one satisfied my condition in the list? I would like to make it work with any list.

$\endgroup$
4
$\begingroup$

If my reading of your question is correct, this does the job:

sets = {{{1, 2, 3, 4}}, {{1, 2, 3}, {4}}, {{1, 2, 4}, {3}}, {{1, 2}, {3, 4}},
        {{1, 2}, {3}, {4}}, {{1, 3, 4}, {2}}, {{1, 3}, {2}, {4}},
        {{1, 4}, {2, 3}}, {{1}, {2, 3, 4}}, {{1}, {2, 3}, {4}},
        {{1, 4}, {2}, {3}}, {{1}, {2, 4}, {3}}, {{1}, {2}, {3, 4}},
        {{1}, {2}, {3}, {4}}};

Cases[sets, list_List /; Equal @@ Map[Sort, {list, Mod[list + 2, 4, 1]}, 2]]
   {{{1, 2, 3, 4}}, {{1, 2}, {3, 4}}, {{1, 3}, {2}, {4}},
    {{1, 4}, {2, 3}}, {{1}, {2, 4}, {3}}, {{1}, {2}, {3}, {4}}}
$\endgroup$
  • $\begingroup$ yes, it seems you were right, thanks! but could you please explain the code for me? why it works? $\endgroup$ – van abel Sep 28 '12 at 15:07
  • $\begingroup$ The condition I used within Cases[] can be written in an equivalent, longer, but maybe more transparent form: Sort[Map[Sort, list]] == Sort[Map[Sort, Mod[list + 2, 4, 1]]]. I trust that this form might be more understandable to you. The key is in the third argument of Map[]; see the docs for details. $\endgroup$ – J. M. will be back soon Sep 28 '12 at 15:14
  • $\begingroup$ you means that the argument 2 of map means to sort the two list in the list {list, mod...}(whose element are numbers), not to sort the whole list (whose elements are lists)? $\endgroup$ – van abel Sep 28 '12 at 15:40
  • $\begingroup$ If you're doubting how something like Map[] works here, it is instructive to replace the Sort[] with a "generic" function. Try Remove[f]; With[{l = {{1}, {2}, {3, 4}}}, Map[f, {l, Mod[l + 2, 4, 1]}, 2]]. $\endgroup$ – J. M. will be back soon Sep 28 '12 at 15:43
  • $\begingroup$ ok, good demo. thanks! $\endgroup$ – van abel Sep 28 '12 at 23:55
6
$\begingroup$

A more mathematically intuitive formulation would be to use Intersection, as then the logic is self-explanatory. You can also create a custom container to make the sets orderless so that {1,2,3}, {3,1,2} and {2,3,1} are all treated the same (alternately, you can use Sort). For example:

equivalentQ[func_] := Block[{f},
    SetAttributes[f, Orderless];
    With[{set = # /. List -> f}, 
        Intersection[set, func@# /. List -> f] === set
    ]
] &; 

Sets that equal those transformed by func should yield True. With this, you can write your condition as cond = equivalentQ[Mod[# + 2, 4, 1] &] (and easily extend it to other transformation functions).

  1. Select:

    Select[list, cond]
    (* {{{1, 2, 3, 4}}, {{1, 2}, {3, 4}}, {{1, 3}, {2}, {4}}, 
        {{1, 4}, {2, 3}}, {{1}, {2, 4}, {3}}, {{1}, {2}, {3}, {4}}} *)
    
  2. Cases:

    Cases[list, x_List /; cond[x]]
    
  3. Pick:

    Pick[list, cone /@ list]
    
  4. Reap & Sow:

    Last@Reap@Scan[If[cond[#], Sow[#]] &, list]
    
$\endgroup$
3
$\begingroup$

Along the same lines as @R.M.'s approach:

eqvlntQ = Union[Union /@ #] == Union[Union /@ Mod[# + 2, 4, 1]] &;

which can be used with Pick, Select, Cases and Reap/Sow as in @R.M's answer.

Row[{{#, eqvlntQ[#]} & /@ sets // Grid[#, Frame -> All] &, 
 Pick[sets, eqvlntQ /@ sets] // Column[#, Frame -> All] &}, Spacer[10]]

enter image description here

$\endgroup$
  • $\begingroup$ yes, you were right: since Union has the function of sort as mentioned the doc Union[list_1,list_2],...] gives a sorted list of all the distinct elements that appear in any of the list_i. $\endgroup$ – van abel Sep 29 '12 at 0:11
3
$\begingroup$

I failed to spell out a working solution for your problem the first time. Here is what I intended:

sortall = # /. List :> Composition[Sort, List]&;

Select[lis, sortall @ #  === sortall @ Mod[# + 2, 4, 1] &]
{{{1, 2, 3, 4}}, {{1, 2}, {3, 4}}, {{1, 3}, {2}, {4}},
 {{1, 4}, {2, 3}}, {{1}, {2, 4}, {3}}, {{1}, {2}, {3}, {4}}}

J.M.'s method is cleaner, and in this case without a downside that I can see. (The sortall function is useful if you want to sorts Lists and only Lists at any level in an expression.) I still prefer Select here:

Select[lis, Equal @@ Map[Sort, {#, Mod[# + 2, 4, 1]}, 2] &]
$\endgroup$
  • 1
    $\begingroup$ they are both not work for the lis={{1, 5, 6}, {2, 3, 4}}. $\endgroup$ – van abel Sep 28 '12 at 14:55
  • $\begingroup$ @vanabel please explain in detail how that set passes your test. $\endgroup$ – Mr.Wizard Sep 28 '12 at 14:58
  • 1
    $\begingroup$ (Mod[# + 6/2, 6, 1] /. List :> Composition[Sort, List]) & /@ lis will output {{2, 3, 4}, {1, 5, 6}}, which is not equal to {{1,5,6},{2,3,4}} as a "list". $\endgroup$ – van abel Sep 28 '12 at 15:00
  • 1
    $\begingroup$ Both versions miss the lists with a mix of singletons and longer lists, like {{1, 3}, {2}, {4}}. To fix the first one: Select[lis, Sort[Sort /@ #] === Sort[Sort /@ Mod[# + 2, 4, 1]] &] $\endgroup$ – J. M. will be back soon Sep 28 '12 at 15:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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