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

Question

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

it has the attribute OneIdentity and Flat
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 with 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 know 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 03 '12 at 16:38
What's the code that leads to the undesired infinite recursion? — Rojo, May 03 '12 at 17:11
@MarkMcClure: it also does not work with NonCommutativeMultiply. NonCommutativeMultiply[a] remains unevaluated. — Fabian, May 03 '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 03 '12 at 17:16
Sorry for the confusion. I tried to find a minimal example and it was too minimal (and I did not see that some old Attributes were still set). I edit the question... — Fabian, May 03 '12 at 17:33
Can you edit the otimes part out of your title? Without any idea of what otimes is (which is mentioned only in the body), it is meaningless in the title... — rm -rf, May 03 '12 at 18:27
@Fabian: From the name of the function, I think he actually wants CircleTimes. Of course he would have to add the definitions anyway; the only special thing about CircleTimes is that it displays as infix ⊗ (or as prefix if there is only one argument; but then, that case would be handled by his one-argument definition anyway). — celtschk, May 03 '12 at 18:33

score 14 · Accepted Answer · edited Apr 13 '17 at 12:55

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

Carl Woll · Answer 2 · 2018-06-01T15:50:05.850

Update

I came up with a better answer in my response to (174384), and since that question was closed as a duplicate of this question, I thought it might be nice to include it here. Basically, one can avoid the iteration error caused by the Flat pattern matcher by inserting a Verbatim into the definition. So use:

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

Examples:

otimes[a, b]
otimes[a]

otimes[a, b]

a

Original answer

Another possibility is to use something like:

SetAttributes[otimes, {OneIdentity,Flat}]
a_otimes /; Length[Unevaluated[a]]==1 := First @ Unevaluated @ a

Then,

otimes[a]

a

No recursion issues!

score 4 · Answer 3 · answered May 03 '12 at 17:20

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

Well, that's cool but what about this example:

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 03 '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 03 '12 at 17:39
@rcollyer Can't you see I've got only 196 cred on mathematics.SE? — Mark McClure, May 03 '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 03 '12 at 18:26

score 4 · Answer 4 · answered May 03 '12 at 23:26

4

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".

answered May 03 '12 at 23:26

Ted Ersek

7,124
19
41

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 04 '12 at 06:31

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

4 Answers4

Linked

Related