Power Function and Non Commutative Multiply

Question

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)

Answer 1

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.

Answer 2

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.

Answer 3

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