Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question

4 Answers 4

up vote 6 down vote accepted

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]
share|improve this answer
2  
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? –  QuantumDot Jul 24 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? –  Mr.Wizard Jul 24 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. –  Mr.Wizard Aug 23 at 8:19
    
Thanks for the notification; you can go ahead and include the solution your answer. Then I'll mark it as accepted. –  QuantumDot Aug 23 at 14:39
1  
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. –  Michael E2 Sep 1 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
Global`f

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.

share|improve this answer
    
Nice answer! and kudos to you for making the RHS consistent. I like especially how it generates the necessary definitions. –  QuantumDot Sep 3 at 18:57
    
A really nice solution! Congratulations, bounty hunter. :-) –  Mr.Wizard Sep 5 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. –  Mr.Wizard Sep 5 at 10:51
    
Thank you QuantumDot! And thank you Mr.Wizard for improving the answer. –  jose Sep 5 at 14:43

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))}

share|improve this answer
1  
This won't work because $f$ isn't completely orderless among all six variables. –  QuantumDot Jul 24 at 7:04

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.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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