Efficiently strip off coefficients in front of variables?

I am working with multivariate polynomials and need a very efficient way to decompose monomials into coefficients and pure monomials. for instance consider variables x[1] and x[2] and the monomial

monomial = C1 x[1] x[2]^2;


To get just the coefficient efficiently, I can do:

coefficient = monomial /.x[_]->1;


Then, to obtain the pure monomial without the coefficient, until now I have been doing:

puremonomial = monomial/coefficient;


However, as the coefficient grows larger in complexity (depending on a sum over rational expressions in many unfixed parameters), this seemingly trivial division takes Mathematica longer and longer to perform. (Having an iteration in place that has to perform this operation several thousand times, makes the code slow.) Therefore, I wonder if there is a command that would strip off the coefficient in front of a monomial efficiently, regardless of its complexity? So, I would like a function:

pureMonomial[monomial_,variables_]


such that

pureMonomial[monomial,{x[1],x[2]}]


x[1]x[2]^2

does not slow down with growing size of C1. Any suggestions?

• What about: Replace[monomial, coef_ t : Times[Power[x[_], _.] ..] :> (1 t)] ?
– user31159
Apr 1, 2016 at 18:46
• Or Replace[expr, Times[Except[_x, _], l_] :> (1 l)] ?
– user31159
Apr 1, 2016 at 18:50
• @Xavier. That's fast. I suggest posting it as a solution! (After verifying robustness, maybe.) Apr 1, 2016 at 19:02
• @Kagaratsch, maybe just monomial /. (monomial /. x[_] -> 1) -> 1 Apr 1, 2016 at 19:29

Replace[monomial, coefs_ t : Times[Power[_x, _.] ..] :> {coefs, 1 t}]


Examples:

Replace[C1 x[1] x[2]^2, coefs_ t : Times[Power[_x, _.] ..] :> {coefs, 1 t}]

(* {C1, x[1] x[2]^2} *)

Replace[C1 C2 x[1] x[2]^2 x[3], coefs_ t : Times[Power[_x, _.] ..] :> {coefs, 1 t}]

(* {C1 C2, x[1] x[2]^2 x[3]} *)


An approach that generalizes to polynomials:

splitpoly[poly_, vars_] := Module[{
cl = CoefficientList[poly, vars]},
{Extract[cl, #], Times @@ (vars^(# - 1))} & /@
Position[cl, Except[0], {-1}, Heads -> False] ]

splitpoly[1 + C0 x[1] + C1 x[1] x[2]^2, {x[1], x[2]}]


{{1, 1}, {C0, x[1]}, {C1, x[1] x[2]^2}}

recover the polynomial:

 Times @@@ % // Total


1 + C0 x[1] + C1 x[1] x[2]^2

Given a polynomial like so:

poly=1. x-0.166667 x^3+0.00833333 x^5-0.000198413 x^7+2.75573*10^-6 x^9-2.50518*10^-8 x^11+1.60463*10^-10 x^13-7.3532*10^-13 x^15


Use CoefficientRules like so:

pairs=Sort[CoefficientRules[poly]]
(* {{1}->1.,{3}->-0.166667,{5}->0.00833333,{7}->-0.000198413,{9}->2.75573*10^-6,{11}->-2.50518*10^-8,{13}->1.60463*10^-10,{15}->-7.3532*10^-13} *)


To get the coefficients:

coeffs=Values[pairs]
(* {1.,-0.166667,0.00833333,-0.000198413,2.75573*10^-6,-2.50518*10^-8,1.60463*10^-10,-7.3532*10^-13} *)


To get the degrees of the terms:

degrees=Flatten[Keys[pairs]]
(* {x,x^3,x^5,x^7,x^9,x^11,x^13,x^15} *)


Take your variable to the power of the degrees to get the monomial:

monos=x^degrees
{x,x^3,x^5,x^7,x^9,x^11,x^13,x^15}