I'm trying to define a non-commutative product with respect to which, certain quantities (e.g. numbers, and some other quantities defined in my code) behave as "scalars" and can be pulled out.

My naive attempt:

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply/: xxx___ **(s:(_?NumericQ | [OTHER CONDITIONS ... ]))**yyy___ :=s*(xxx**yyy)


As a trivial test, I want NonCommutativeMultiply[a,b,3,c] to return 3 a**b**c . But instead Mathematica freezes with error message "\$RecursionLimit: Recursion dept of 1024 exceeded during evaluation of NumericQ[a]". I'm not sure what this means. Why can't I define a rule like this, and how can I solve this most cleanly? Beyond a solution, any hints about where I am wrong would be helpful, as I am still trying to properly understand TagSetDelayed.

• the above works fine if I replace NonCommutativeMultiply with an "operator without built-in meaning" like CenterDot, but I'm already using this elsewhere in my code.
• it still fails when I remove all the other conditions for the terms I want to pull out of the product, but it succeeds when I replace the s pattern by s_Integer.
• I am able to achieve my desired output using replacement rules, i.e. NonCommutativeMultiply[a, b, 3, c] /. {aaa___ ** (q : (_?NumericQ)) ** bbb___ :> q*aaa ** bbb} evaluates fine.
• The warning message is quite clear: you are running into a recursion. You are defining a NonCommutativeMultiply by another NonCommutativeMultiply, so you get into an infinite loop. It's difficult to help you without the actual full code (conditions), but roughly speaking, you have to write some other condition that will prevent this recursion to occur. Feb 6 at 20:57
• The cause of the issue is not so straightfoward as defining one NCM in terms of another, like if you set g[x_]:=g[x]---it's an unpleasant result from NCM being Flat interacting poorly with the pattern matcher. For NCM it's usually OK to turn off flatness. See mathematica.stackexchange.com/a/131339/7936 where I use a sort of one-way flatness to get around exactly the infinite recursion issue. Feb 6 at 21:01
• @Domen the problem also occurs when I remove all other conditions and the pattern is simply s:(_?NumericQ). Do you know whether there might be a way to prevent the recursion by delaying evaluation of the conditions? Feb 6 at 21:21
• @evanb thanks, removing Flat and then manually reimplementing it for most situations seems to fix things Feb 6 at 21:22

Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply];
criterion = NumericQ;
NonCommutativeMultiply[args___] /; AnyTrue[{args}, criterion] := With[{
grouping = GroupBy[{args}, criterion ]
},
Times[
Times @@ Lookup[grouping, True, {}],
Replace[
Lookup[grouping, False, {}],
{
{} -> 1,
{el_} :> el,
list_List :> NonCommutativeMultiply @@ list
}
]
]
]