# Constructing a function with Flat and OneIdentity attribute with the property that otimes[a]:>a

I want to have a function (called otimes) with the following two properties:

1. it has the attribute OneIdentity and Flat
2. if evaluated with a single argument it returns that argument

The built-in function Times has these properties; e.g., evaluating Times[a] yields a.

I am struggling implementing my own function having the same behavior. What I tried is the obvious implementation

SetAttributes[otimes,{OneIdentity,Flat}]
otimes[a_]:=a

However this does not work and leads to an infinite recursion when I evaluate otimes[a,b]. I do not now how to implement the desired behavior consistently. Maybe somebody can help?

-
I'm not sure what you're trying to do, but you might want to look into NonCommutativeMultiply. The very purpose of this function is to allow the user to set up their own version of multiplication. It already has the attribute OneIdentity. –  Mark McClure May 3 '12 at 16:38
What's the code that leads to the undesired infinite recursion? –  Rojo May 3 '12 at 17:11
@MarkMcClure: it also does not work with NonCommutativeMultiply. NonCommutativeMultiply[a] remains unevaluated. –  Fabian May 3 '12 at 17:12
@Rojo: otimes[anything] –  Fabian May 3 '12 at 17:12
I still don't understand the question. In particular, MatchQ[b, otimes[a_]] yields the same as MatchQ[b, Times[a_]]. So could you state more clearly what the problem is that gives infinite recursion? –  Jens May 3 '12 at 17:16

I see now. The problem arises with Flat then. Just set the attributes after setting the definitions. Or at least the Flat attribute

ClearAll[otimes];
SetAttributes[otimes, OneIdentity]
otimes[a_] := a
SetAttributes[otimes, Flat]

Check out this answer for more details on why this works.

Basically, MMA remembers if the symbol was Flat or not at the time each DownValue is defined. The infinite recursion is more related to this:

SetAttributes[f, Flat];
Replace[Hold@f[2], Hold@f[i_] :> Hold[i]]

So, when you did otimes[2] and it checked the otimes[a_]:=a downvalue, it matched a with otimes[2], so you got your infinite recursion

-

I'm guessing a bit at what you're doing here, so I do hope some of this is relevant. Trying to define your own version of multiplication is essentially trying to implement a group structure in mathematics. Here's how I would implement the dihedral group using NonCommutativeMultiply. At the end, you'll notice that I do need to deal with expressions like NonCommutativeMultiply[a].

The dihedral group of order $2n$ has presentation $$\langle a,b : a^2=b^2=(ab)^n=1 \rangle.$$

Given a finite string of $a$s and $b$s representing an element of the dihedral group, there is a standard procedure to place that string into one of the following four canonical forms: $(ab)^m$, $(ab)^m b$, $(ba)^m$, or ($ba)^m a$, where $m$ is an integer such that $0\leq m<n$. To do so, simply remove each consecutive pair of identical symbols and then reduce the exponent of $ab$ or $ba$ modulo $n$. This solves the so called Word Problem for the dihedral group.

To implement this in Mathematica, first associate UpValues with a and b representing the order of those elements.

a /: a ** a = 1;
b /: b ** b = 1;
a /: a ** 1 = a;
b /: b ** 1 = b;
a /: 1 ** a = a;
b /: 1 ** b = b;

Now, let's generate a long product of $a$s and $b$s.

SeedRandom[1];
w = NonCommutativeMultiply @@ RandomChoice[{a, b}, 100]

a ** b ** a ** b ** a ** b ** a ** b ** a ** b ** a ** b ** a ** b ** a ** b

The result is much shorter than 100 because cancellation has already occurred. Now let's put it in it's final form. Assuming you're working in $D_6$, you can do the following:

n = 3;
finalForm[w : NonCommutativeMultiply[a, ___, b]] :=
(a ** b)^Mod[Length[w]/2, n];
finalForm[w : NonCommutativeMultiply[a, ___, a]] :=
(a ** b)^Mod[(Length[w] - 1)/2, n] ** a;
finalForm[w : NonCommutativeMultiply[b, ___, a]] :=
(b ** a)^Mod[Length[w]/2, n];
finalForm[w : NonCommutativeMultiply[b, ___, b]] :=
(b ** a)^Mod[(Length[w] - 1)/2, n] ** b;
finalForm[w]

(a ** b)^2

finalForm[a ** a ** a]

finalForm[a]

We've run into exactly the problem you've described. To fix it, simply associate DownValues with finalForm.

finalForm[a] = a;
finalForm[b] = b;
finalForm[a ** a ** a]

a

More generally, you might define a function simplify with the property that

simplify[NonCommutativeMultiply[a_]] := a
-
Thanks for your question. I figured out that my example was a bit to minimal. I changed the question such that now it is clear where the infinite recursion appears. –  Fabian May 3 '12 at 17:35
This is off-topic for the question, but by any chance do you have any insight into this question? –  rcollyer May 3 '12 at 17:39
@rcollyer Can't you see I've got only 196 cred on mathematics.SE? –  Mark McClure May 3 '12 at 18:19
I hadn't noticed that. But, you're the first mathematician (other than J.M, despite his protests that he isn't one) about this question, and with the use of group theory above, I thought maybe you may have some insight into the issue. –  rcollyer May 3 '12 at 18:26
As to having a rep of 196, not any more. :) –  rcollyer May 3 '12 at 18:30

If I understand the question it's an issue I sent to MathGroup about ten years ago. Alan Hayes solved it for me, and it's all discused at http://www.verbeia.com/mathematica/tips/HTMLLinks/Tricks_A-K_27.html Go there and read the part, "A problem with the Flat attribute and how to solve it".

-
Thank you: this is exactly the problem I was suffering. In fact, I did know that Flat affects the pattern matching but I did not know that for a pattern only the attributes at the time when it is set are important and that the attributes are then stored. –  Fabian May 4 '12 at 6:31