# Power Function and Non Commutative Multiply

I'm trying to figure out the best way to define a Power function for non commutative multiply that retains some of the regular features of the ordinary power function. As of now, what I've been writing has a normal ordering feature so all like-terms should sit next to one another

1. I'd like to use it to Up Set expressions such that I get something like*

In: a**a**a**b**b**c Out: a^3**b^2**c

2. I'd like to have access to the exponents somehow, ~{a,3,b,2,c,1}

3. Hopefully this function would inherit Up Sets of ** that I've already defined. These are just commutators to order and simplify expressions with particular heads "z". These lines are like e.g. p___**b_z**a_z**q___ ^:= p**(1+a**b)**q for [a,b]=1. I'd hope that when I manipulate expressions containing powers it orders them properly.

Extra Info: I'm lightly using NCAlgebra as a backbone for my notebook, so I'm also open to suggestions based on this package

For context, the supreme goal here is to have something that can do symbolic computations involving expressions like In: Exp[b]Exp[a] Out:Exp[a]Exp[b-1] when [a,b]=1 by using the power expansion of Exp[-]. This is probably not (easily) achievable, so I'll settle for the functionality of being able to work with complicated expressions involving powers and manually manipulating the series myself

*(I'm not super sure how to go about pattern matching something like this, suggestions welcome)

• Welcome to Mma.SE. Start by taking the tour now and learning about asking and what's on-topic. Always edit if improvable, show due diligence, give brief context, include minimal working example of code and data in formatted form. By doing all this you help us to help you and likely you will inspire great answers. The site depends on participation, as you receive give back: vote and answer questions, keep the site useful, be kind, correct mistakes and share what you have learned. Aug 31, 2018 at 16:22

Since you mention UpSet, I assume you want the definitions attached to a specific head, such as z. In this case, it turns out to be more convenient to rely on TagSet than UpSet, however. I use z as the head for these patterns, feel free to change it as necessary.

z /: a_z ** a_z := a^2;
z /: a_z^n_ ** a_z := a^(n + 1);


This accomplishes the same goal of attaching the pattern to the z symbol, without needing to Unprotect NonCommutativeMultiply or Power.

Now appropriately headed expressions will automatically collect neighboring powers:

z[a] ** z[a] ** z[a] ** z[b] ** z[b] ** z[c]


z[a]^3 ** z[b]^2 ** z[c]

Assuming you're primarily interested in extracting powers from expressions with these heads, you can then define something like:

extractPowers[NonCommutativeMultiply[x__]] := Map[extractPowers, {x}, 1];
extractPowers[Power[x_z, y_]] := {x, y};
extractPowers[x_z] := {x, 1};


Then:

extractPowers[z[a] ** z[a] ** z[a] ** z[b] ** z[b] ** z[c]]


{{z[a], 3}, {z[b], 2}, {z[c], 1}}

Regarding your third point, so long as the head is consistent between sets I see no reason this shouldn't work.

• Thanks for the response! Unfortunately this gives me an infinite iterations error on simple trials for some reason? I haven't been able to work out why. I've quit my kernel prior to running. No tags: In[1]:= ClearAll["Global*"] In[2]:=SetNonCommutative[a] In[3]:=a ** a Out[1]:= a**a With Tags: In[1]:= ClearAll["Global*"] In[2]:= SetNonCommutative[a] In[3]:= a /: a ** a := a^2; In[4]:= a /: a^n_ ** a := a^(n + 1); In[3]:=a ** a Out[1]:= $IterationLimit::itlim: Iteration limit of 4096 exceeded. Out[2]:=Hold[a^2] Sep 1, 2018 at 13:10 • It works when I don't load the NC algebra package so I guess I'll have to sift through the code to figure out what I need to block Sep 1, 2018 at 13:13 • Found it-- for anyone with the same issues as me, Power was unprotected in NonCommutativeMultiply.m in version 5.0 and later. Sep 1, 2018 at 13:24 • So this rule doesn't seem to handle abstract powers, so if I write z^m**z^n it will not simplify. Trying to include the tag z /: a_z^n_ ** a_z^m_ := a^(n + m); produces an error claiming the assignment is too deep. I can't UpSet this either without unprotecting Power. So if I can't find a work around, I will need to bite the bullet and unprotect power or use transformation rules. Sep 1, 2018 at 13:46 Regarding the handling of Power in NCAlgebra, the reason for expanding powers is for normalizing NC expressions. It might seem obvious that you would want a**a**b to look like a^2**b but it is much less obvious what one should do with a**b**a**b. Should it be processed into (a**b)^2 or not? Rules for that case, and their more complex variants (think general associative sums and products), would have to be input in pretty much all algebraic operations. The extra complexity and associated slow down due to the processing of the many additional rules is not worth the effort. For this reason NCAlgebra takes the approach that all powers are expanded to avoid that additional complication. Since version 5 we also have special structures for handling NC polynomials. Check out NCPolynomial and NCPoly. Those might have the features you are looking for. It can sort and manipulate polynomials by degree and they implement ordering of monomials. As OP noted in comments NCAlgebra package is pretty aggressive in changing definitions of built-in functions, it changes definition of Power, so that integer powers are automatically expanded to non-commutative products opposite thing to what OP wants. To have full control over evaluations we can define our own power head and function converting repeated product to power expression: << NC << NCAlgebra ncPower // ClearAll ncPower // Attributes = OneIdentity; ncPower // Default = 1; ncPower[x_?CommutativeQ, y_] := Power[x, y] ncPower[_, 0] = 1; ncPower[x_, 1] := x ncPower /: MakeBoxes[ncPower[x_, y_], StandardForm] := TemplateBox[ { Parenthesize[x, StandardForm, Power, Left], Parenthesize[y, StandardForm, Power, Right] }, "ncPower", Tooltip -> "ncPower", DisplayFunction -> (SuperscriptBox[#1, RowBox@{"", "**", #2}]&) ] ncPowerCollect // ClearAll ncPowerCollect[expr_, patt_ : _] := NCReplaceRepeated[ expr //. HoldPattern@Power[x : patt, y_] :> ncPower[x, y], HoldPattern[ncPower[x : patt, y1_.] ** ncPower[x : patt, y2_.]] :> ncPower[x, y1 + y2] ]  simple examples of usage: a ** a ** a ** b ** b ** c // ncPowerCollect (* ncPower[a,3] ** ncPower[b,2] ** c *) tmp = a ** ncPower[a, m] ** a ** ncPower[a, n] ** a ** b ** b ** c ** c ** b (* a ** ncPower[a, m] ** a ** ncPower[a, n] ** a ** b ** b ** c ** c ** b *) tmp // ncPowerCollect (* ncPower[a, 3 + m + n] ** ncPower[b, 2] ** ncPower[c, 2] ** b *) ncPowerCollect[tmp, a] (* ncPower[a, 3 + m + n] ** b ** b ** c ** c ** b *) ncPowerCollect[tmp, b] (* a ** ncPower[a, m] ** a ** ncPower[a, n] ** a ** ncPower[b, 2] ** c ** c ** b *) ncPowerCollect[tmp, b | c] (* a ** ncPower[a, m] ** a ** ncPower[a, n] ** a ** ncPower[b, 2] ** ncPower[c,2] ** b *)  To get list of power bases and exponents we can use Cases: Cases[ncPower[a,(3 + m + n)] ** ncPower[b,2] ** ncPower[c,2] ** b, ncPower[x_, y_.] :> {x, y}] (* {{a, 3 + m + n}, {b, 2}, {c, 2}, {b, 1}} *)  To reorder non-commutative products we can add two more functions. commutator that we'll use to define commutation relations and ncOrder that will reorder desired operators, in given products, using defined commutators: $commutatorSpecialAssignment = True;

commutator // ClearAll
commutator[a_, a_] = 0;
commutator[a_?CommutativeQ, b_] = 0;
commutator[a_, b_?CommutativeQ] = 0;
commutator[b_, a_] /; Not@OrderedQ@{b, a} := -commutator[a, b]
commutator /: (set : Set | SetDelayed /; $commutatorSpecialAssignment)[commutator[p1_, p2_], rhs_] := Block[{$commutatorSpecialAssignment = False},
set[commutator[p2, p1], -rhs];
set[commutator[p1, p2], rhs]
]
commutator /: (Unset /; $commutatorSpecialAssignment)@commutator[p1_, p2_] := Block[{$commutatorSpecialAssignment = False},
commutator[p2, p1]=.;
commutator[p1, p2]=.
]
commutator /: MakeBoxes[commutator[x_, y_], StandardForm] :=
TemplateBox[
{MakeBoxes@x, MakeBoxes@y},
"commutator",
Tooltip -> "commutator",
DisplayFunction -> (RowBox@{"[", #1, ",", #2, "]"}&)
]

ncOrder // ClearAll
ncOrder[expr_, vars_List : Automatic] := Module[{orderedQ, applicableQ},
orderedQ = If[vars === Automatic,
#1 =!= #2 && OrderedQ@{#1, #2} &
(* else *),
With[{ord = PositionIndex[vars][[All, 1]]},
ord@#1 < ord@#2 &
]
];
applicableQ[a_, b_] := applicableQ[a, b] =
orderedQ[a, b] && With[{comm = commutator[a, b]},
TrueQ[commutator[a, comm] == 0] && TrueQ[commutator[comm, b] == 0]
];
ncPowerCollect@expr //. {
c_. pre___ ** ncPower[b_, nb_.] ** ncPower[a_, na_.] ** post___ /; applicableQ[a, b] :>
Module[{i = Unique@"i", n, k},
{n, k} = Sort@{na, nb};
If[IntegerQ@n, Sum, Inactive@Sum][
c Binomial[n, i] Pochhammer[k - i + 1, i] commutator[b, a]^i ncPowerCollect[pre ** ncPower[a, na - i]] ** ncPowerCollect[ncPower[b, nb - i] ** post],
{i, 0, n}
]
],
c_. pre___ ** Exp[Optional[cb_?CommutativeQ] b_] ** Exp[Optional[ca_?CommutativeQ] a_] ** post___ /; applicableQ[a, b] :>
c pre ** Exp[ca a] ** Exp[cb b] ** Exp[- ca cb commutator[a, b]] ** post
}
]


Above function will reorder only pairs of expressions which commutator commutes with both of them, but it can be extended to handle more complicated situations.

Let's define commutator of a and b to be 1 and see basic usage example of ncOrder function usage. First we order product to canonical order than we reorder it back:

commutator[a, b] = 1;

b ** b ** b ** a ** a
% // ncOrder
ncOrder[%, {b, a}]


Example with symbolic powers:

SetCommutative[n, k]
ncPower[b, 2] ** ncPower[a, k] // ncOrder
ncPower[b, n] ** ncPower[a, 3] // ncOrder
ncPower[b, n] ** ncPower[a, k] // ncOrder


Example with Exp function:

Exp[2 b] ** Exp[3 a] ** c // ncOrder
ncOrder[%, {b, a}]