# Recognizing special cases of a defined function for permuted arguments

I have a number of ugly ways to implement the following pattern recognition task, but I'm looking for something elegant to keep my notebook tidy.

I need to define a function of six variables $f(a,b,c;A,B,C)$ which is known to be unchanged under the simultaneous interchange of any two of $a,b,c$ and of the corresponding $A,B,C$:

\begin{align}&f(a,b,c;A,B,C) = f(a,c,b;A,C,B) = f(b,a,c;B,A,C) \\ =&f(b,c,a;B,C,A) = f(c,a,b;C,A,B) = f(c,b,a;C,B,A)\end{align}

EDIT for clarity: Given one definition, how do I get Mathematica to try all possibilities within the restricted set of permutations shown above for pattern matching? I need to mimic the effect of SetAttributes[f,Orderless].

More concretely, if I define the special case:

f[a_, 0, b_, A_, 0, C_] := (a+b)/(A-C)


a function call f[x, y, 0, m, n, 0] should match, and return (x+y)/(m-n). But f[x, y, 0, m, 0, n] should not match, and thus return it must be returned unevaluated.

Added question: Instead of finding a way to get Mathematica to try all the possibilities when pattern matching, would it be easier to write code such that when a representative definition for f is made, the kernel automatically adds further definitions of f for the remaining permutations of the arguments?

## 4 Answers

I think Bob Hanlon had the right idea in using Orderless but his suggestion is overly naive.
Instead we must treat only the triplets as orderless so we will need an additional head.

Edit: my answer was also wrong, but I am updating it with the correction from your comment below.

SetAttributes[f1, Orderless]

f[a_, b_, c_, A_, B_, C_] :=
With[{body = f1[{a, A}, {b, B}, {c, C}]}, body /; Head[body] =!= f1]

f1[{a_, A_}, {0, 0}, {c_, C_}] := (a + c)/(A - C)


Now:

f[x, y, 0, m, n, 0]

f[x, y, 0, m, 0, n]

(x + y)/(m - n)

f[x, y, 0, m, 0, n]

• This is better, but the invariance of the function $f$ isn't for permutations of first three arguments $a,b,c$ independent of the second three $x,y,z$. They are tied together. But no problem; your answer and @BobHanlon's answer pointed me in the right direction: I could declare SetAttributes[f1, Orderless] but with the arguments arranged f1[{a_,x_},{b_,y_},{c_,z_}], and make the library of special cases for f1. Then finally, I put f[a_,b_,c_,d_,e_,f_] = f1[{a,x},{b,y},{c,z}]. I tried a few cases and it seems to work. What do you think? Jul 24, 2014 at 8:31
• Sorry, you're right, I wasn't thinking clearly. Hopefully thinking better now, and your solution sounds just fine. Why don't you self-answer so I can vote for it? Jul 24, 2014 at 9:25
• @QuantumDot This question just got bumped by Community♦ because it has no positively voted answer. Please post the method in your comment above as a self-answer. If you don't I shall edit my answer to include it. Aug 23, 2014 at 8:19
• Thanks for the notification; you can go ahead and include the solution your answer. Then I'll mark it as accepted. Aug 23, 2014 at 14:39
• Might this be a good way to enable definitions through f instead of f1?: f /: SetDelayed[f[a_, b_, c_, d_, e_, f_], expr_] := (f1[{a, d}, {b, e}, {c, f}] := expr). Ditto for set. Sometimes I overlook pitfalls with such workarounds. Sep 1, 2014 at 21:22

I think you need to use a group-theoretical construction. In this way you will have full freedom in specifying any group of permutations you need. In your case the group is

G = PermutationGroup[{Cycles[{{1, 2}, {4, 5}}], Cycles[{{1, 2, 3}, {4, 5, 6}}]}];


This generates a symmetric group on {1, 2, 3}, which also forces the same permutations on {4, 5, 6}. These are the group elements, as permutation lists:

PermutationList[#, 6] & /@ GroupElements[G]

{{1, 2, 3, 4, 5, 6}, {1, 3, 2, 4, 6, 5}, {2, 1, 3, 5, 4, 6}, {2, 3, 1, 5, 6, 4}, {3, 1, 2, 6, 4, 5}, {3, 2, 1, 6, 5, 4}}


There are six permutations, corresponding to those of the symmetric group on {1, 2, 3}.

Now construct the following function:

SetAttributes[SetDelayedPermuted, {HoldAll, SequenceHold}];

SetDelayedPermuted[f_[args___], rhs_, group_] := ((f[##] := rhs) & @@@ Permute[{args}, group];)


Let us try your definition, though I'm changing the - sign in the denominator to a + sign, because otherwise I think there is some inconsistency:

SetDelayedPermuted[f[a_, 0, b_, A_, 0, C_], (a + b)/(A + C), G]


Now we check your two cases (remember I changed a sign):

f[x, y, 0, m, n, 0]

(x + y) / (m + n)

f[x, y, 0, m, 0, n]

f[x, y, 0, m, 0, n]


We can see how many definitions were actually needed:

??f

Globalf

f[b_,0,a_,C_,0,A_]:=(a+b)/(A+C)
f[b_,a_,0,C_,A_,0]:=(a+b)/(A+C)
f[0,b_,a_,0,C_,A_]:=(a+b)/(A+C)


Note how symmetry in both a<->b and A<->C was implemented simultaneously (hence we ended up with 3 definitions, instead of 6). That's why I think a consistent definition was having (a+b)/(A+C) or (a-b)/(A-C) but not (a+b)/(A-C) on the right hand side.

• Nice answer! and kudos to you for making the RHS consistent. I like especially how it generates the necessary definitions. Sep 3, 2014 at 18:57
• A really nice solution! Congratulations, bounty hunter. :-) Sep 5, 2014 at 10:47
• I edited your code to make it a bit shorter. I also changed the formatting with hope of making it easier to copy and paste the code sections. I hope you don't mind. Sep 5, 2014 at 10:51
• Thank you QuantumDot! And thank you Mr.Wizard for improving the answer.
– jose
Sep 5, 2014 at 14:43
• Thanks for this! I actually have an application where a function I'm interested in is only partly symmetric. I think I'll use this instead of what I have now. Aug 2, 2016 at 6:27

I would do this by defining a preferred ordering to sort the first three arguments. In this example I will use canonical Mathematica Ordering but in principle you could use anything.

I would define

f[a_, b_, c_, A_, B_, C_] := With[
{order = Ordering[{a, b, c}]}, (* Get ordering of first three arguments *)
f @@ {
Sequence @@ ({a, b, c}[[order]]), (* Sort first three arguments *)
Sequence @@ ({A, B, C}[[order]])  (* Reorder second three similarly *)
}
] /; Not[OrderedQ[{a, b, c}]] (* Avoid infinite loop. *)


Then

f[c, b, a, C, B, A]
(* = f[a, b, c, A, B, C] *)
f[3, 0, -3, foo, bar, baz]
(* = f[-3, 0, 3, baz, bar, foo] *)


etc.

• How I'd have done it: f[a_, b_, c_, A_, B_, C_] /; ! OrderedQ[{a, b, c}] := f @@ Flatten[{{a, b, c}, {A, B, C}}[[All, Ordering[{a, b, c}]]]] Aug 2, 2016 at 6:37

Give f the attribute Orderless

SetAttributes[f, Orderless];

f[0, 0, 0, 0, z_, z_] = -(1/z);
f[0, 0, 0, 0, y_, z_] = -(1/(y - z)) Log[y/z];

f @@@ Permutations[{0, 0, 0, 0, z, z}] // Union


{-(1/z)}

f @@@ Permutations[{0, 0, 0, 0, y, z}] // Union
`

{-(Log[y/z]/(y - z))}

• This won't work because $f$ isn't completely orderless among all six variables. Jul 24, 2014 at 7:04