# 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?

I think Bob Hanlon had the right idea in using Orderless but his suggestion is overly naive.

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