1
$\begingroup$

I have a list of 6 (possibly repeated) integers:

ints = {a,b,c,d,e,f};

and also a set of symmetry conditions:

  1. You can switch the signs of elements 1 and 4 at the same time: $$ \{a,b,c,d,e,f\} \equiv \{-a,b,c,-d,e,f\} $$

  2. You can switch any of the pairs of elements (1, 4), (2, 5), (3, 6) with another one

$$ \{a,b,c,d,e,f\} \equiv \{a,c,b,d,f,e\} \equiv \{b,a,c,e,d,f\} \equiv \{b,c,a,e,f,d\} \equiv \{c,a,b,f,d,e\} \equiv \{c,b,a,f,e,d\} $$

  1. The first three elements and the last 3 elements can be switched $$ \{a,b,c,d,e,f\} \equiv \{d,e,f,a,b,c\} $$

I want to write a function F[{a,b,c,d,e,f}] which would produce all (unrepeated) sets which can be generated from the argument via repeated application of the symmetries.

For example:

F[{-1, -1, -1, -1, -1, -1}] = {{-1, -1, -1, -1, -1, -1}, {-1, -1, 1, -1, -1, 1}, {-1, 1, -1, -1, 1, -1}, {-1, 1, 1, -1, 1, 1}, {1, -1, -1, 1, -1, -1}, {1, -1, 1, 1, -1, 1}, {1, 1, -1, 1, 1, -1}, {1, 1, 1, 1, 1, 1}}

and

F[{0, 0, 0, 0, 0, 0}] = {0, 0, 0, 0, 0, 0}

and

F[{-1, -1, -1, -1, -1, 0}] = {{-1, -1, -1, -1, -1, 0}, {-1, -1, -1, -1, 0, -1}, {-1, -1, -1, 0, -1, -1}, {-1, -1, 0, -1, -1, -1}, {-1, -1, 0, -1, -1, 1}, {-1, -1, 1, -1, -1, 0}, {-1, -1, 1, -1, 0, 1}, {-1, -1, 1, 0, -1, 1}, {-1, 0, -1, -1, -1, -1}, {-1, 0, -1, -1, 1, -1}, {-1, 0, 1, -1, -1, 1}, {-1, 0, 1, -1, 1, 1}, {-1, 1, -1, -1, 0, -1}, {-1, 1, -1, -1, 1, 0}, {-1, 1, -1, 0, 1, -1}, {-1, 1, 0, -1, 1, -1}, {-1, 1, 0, -1, 1, 1}, {-1, 1, 1, -1, 0, 1}, {-1, 1, 1, -1, 1, 0}, {-1, 1, 1, 0, 1, 1}, {0, -1, -1, -1, -1, -1}, {0, -1, -1, 1, -1, -1}, {0, -1, 1, -1, -1, 1}, {0, -1, 1, 1, -1, 1}, {0, 1, -1, -1, 1, -1}, {0, 1, -1, 1, 1, -1}, {0, 1, 1, -1, 1, 1}, {0, 1, 1, 1, 1, 1}, {1, -1, -1, 0, -1, -1}, {1, -1, -1, 1, -1, 0}, {1, -1, -1, 1, 0, -1}, {1, -1, 0, 1, -1, -1}, {1, -1, 0, 1, -1, 1}, {1, -1, 1, 0, -1, 1}, {1, -1, 1, 1, -1, 0}, {1, -1, 1, 1, 0, 1}, {1, 0, -1, 1, -1, -1}, {1, 0, -1, 1, 1, -1}, {1, 0, 1, 1, -1, 1}, {1, 0, 1, 1, 1, 1}, {1, 1, -1, 0, 1, -1}, {1, 1, -1, 1, 0, -1}, {1, 1, -1, 1, 1, 0}, {1, 1, 0, 1, 1, -1}, {1, 1, 0, 1, 1, 1}, {1, 1, 1, 0, 1, 1}, {1, 1, 1, 1, 0, 1}, {1, 1, 1, 1, 1, 0}}
Improve this question
$\endgroup$
2
  • $\begingroup$ Start by consulting PermutationGroup: reference.wolfram.com/language/ref/… $\endgroup$ Commented Aug 18, 2024 at 8:37
  • 1
    $\begingroup$ I do not think there could be any shortcut to get the result other than brute-force. $\endgroup$ Commented Aug 18, 2024 at 9:14

1 Answer 1

Reset to default
3
$\begingroup$

The first argument is identity permutation. The second argument is list of rules/permutations and the third argument is an expression on which the function is applied.

fu[x_, rules_, expr_] := Block[{out = {expr}, new}, While[new = Complement[Flatten[rules /. Thread[x -> #] & /@ out, 1], out]; out = Join[out, new]; new != {}]; out ]

So for the three examples we have:

rules = {{-a, b, c, -d, e, f}, {a, c, b, d, f, e}, {b, a, c, e, d, f}, {b, c, a, e, f, d}, {c, a, b, f, d, e}, {c, b, a, f, e, d}, {d, e, f, a, b, c}}; fu[{a, b, c, d, e, f}, rules, {-1, -1, -1, -1, -1, -1}] Length[%] fu[{a, b, c, d, e, f}, rules, {0, 0, 0, 0, 0, 0}] Length[%] fu[{a, b, c, d, e, f}, rules, {-1, -1, -1, -1, -1, 0}] Length[%] 
{{-1, -1, -1, -1, -1, -1}, {1, -1, -1, 1, -1, -1}, {-1, -1, 1, -1, -1, 1}, {-1, 1, -1, -1, 1, -1}, {1, -1, 1, 1, -1, 1}, {1, 1, -1, 1, 1, -1}, {-1, 1, 1, -1, 1, 1}, {1, 1, 1, 1, 1, 1}} 8 {{0, 0, 0, 0, 0, 0}} 1 {{-1, -1, -1, -1, -1, 0}, {-1, -1, -1, -1, 0, -1}, {-1, -1, -1, 0, -1, -1}, {-1, -1, 0, -1, -1, -1}, {1, -1, -1, 1, -1, 0}, {-1, -1, 1, -1, 0, 1}, {-1, -1, 1, 0, -1, 1}, {-1, 0, -1, -1, -1, -1}, {-1, 1, -1, -1, 1, 0}, {-1, 1, -1, 0, 1, -1}, {0, -1, -1, -1, -1, -1}, {1, -1, -1, 0, -1, -1}, {1, -1, -1, 1, 0, -1}, {1, -1, 0, 1, -1, -1}, {-1, -1, 1, -1, -1, 0}, {-1, 0, 1, -1, -1, 1}, {-1, 1, -1, -1, 0, -1}, {-1, 1, 0, -1, 1, -1}, {0, -1, -1, 1, -1, -1}, {0, -1, 1, -1, -1, 1}, {0, 1, -1, -1, 1, -1}, {1, -1, 1, 0, -1, 1}, {1, -1, 1, 1, 0, 1}, {1, 0, -1, 1, -1, -1}, {1, 1, -1, 0, 1, -1}, {1, 1, -1, 1, 1, 0}, {-1, -1, 0, -1, -1, 1}, {-1, 0, -1, -1, 1, -1}, {-1, 1, 1, -1, 0, 1}, {-1, 1, 1, -1, 1, 0}, {-1, 1, 1, 0, 1, 1}, {0, -1, 1, 1, -1, 1}, {0, 1, -1, 1, 1, -1}, {1, -1, 1, 1, -1, 0}, {1, 0, 1, 1, -1, 1}, {1, 1, -1, 1, 0, -1}, {1, 1, 0, 1, 1, -1}, {-1, 0, 1, -1, 1, 1}, {-1, 1, 0, -1, 1, 1}, {0, 1, 1, -1, 1, 1}, {1, -1, 0, 1, -1, 1}, {1, 0, -1, 1, 1, -1}, {1, 1, 1, 0, 1, 1}, {1, 1, 1, 1, 0, 1}, {1, 1, 1, 1, 1, 0}, {0, 1, 1, 1, 1, 1}, {1, 0, 1, 1, 1, 1}, {1, 1, 0, 1, 1, 1}} 48
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.