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.

Improve this question
$\endgroup$

4 Answers 4

Reset to default
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}}}
Improve this answer
$\endgroup$
5
  • $\begingroup$ yes, it seems you were right, thanks! but could you please explain the code for me? why it works? $\endgroup$
    – van abel
    Commented Sep 28, 2012 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.'s missing motivation ♦
    Commented Sep 28, 2012 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
    Commented Sep 28, 2012 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.'s missing motivation ♦
    Commented Sep 28, 2012 at 15:43
  • $\begingroup$ ok, good demo. thanks! $\endgroup$
    – van abel
    Commented Sep 28, 2012 at 23:55
7
$\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, cond /@ list]

  4. Reap & Sow:

    Last@Reap@Scan[If[cond[#], Sow[#]] &, list]
Improve this answer
$\endgroup$
0
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

Improve this answer
$\endgroup$
1
  • $\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
    Commented Sep 29, 2012 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] &]
Improve this answer
$\endgroup$
4
  • 1
    $\begingroup$ they are both not work for the lis={{1, 5, 6}, {2, 3, 4}}. $\endgroup$
    – van abel
    Commented Sep 28, 2012 at 14:55
  • $\begingroup$ @vanabel please explain in detail how that set passes your test. $\endgroup$
    – Mr.Wizard
    Commented Sep 28, 2012 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
    Commented Sep 28, 2012 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.'s missing motivation ♦
    Commented Sep 28, 2012 at 15:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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