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 commutator
s:
$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}]
