# Collecting terms of even exponents

Say I've got a polynomial of $4$ or $5$ variables (we'll say $d_1$, $d_2$, $d_3$, and $d_4$). How would you collect the terms where each $d$ is raised to an even power? It collects the terms of the polynomial that are of the form

$$d_1^{2 \cdot k_1} \cdot d_2^{2 \cdot k_2} \cdot d_3^{2 \cdot k_3} \cdot d_4^{2 \cdot k_4}$$

for $k_1,\dotsc,k_5$ being integers.

Example:

$$d_1^2 \cdot d_2^4 \cdot d_3^2 \cdot d_4^0 + d_1^0 \cdot d_2^3 \cdot d_3^2 \cdot d_4^3$$

would take the

$$d_1^2 \cdot d_2^4 \cdot d_3^2 \cdot d_4^0$$

term and not the

$$d_1^0 \cdot d_2^3 \cdot d_3^2 \cdot d_4^3$$

term.

-

CoefficientRules has all this information build into it.

p = Expand[(x + y + z + w)^4];
vars = {x, y, z, w};
r = CoefficientRules[p, vars];
FromCoefficientRules[Pick[r, And @@ EvenQ[#[[1]]] & /@ r], vars]


-
nice...always learn something –  ubpdqn Nov 5 '13 at 10:38
Nice indeed; a bit shorter: FromCoefficientRules[Cases[r, {__?EvenQ} ~_~ _], vars] –  Mr.Wizard Nov 5 '13 at 13:19

Yet another solution: let's take the symmetric part over all variables

symmPart[expr_, vars_] := Fold[(# + (# /. #2 -> -#2))/2 &, expr, vars] // Expand

pol = x y z^2 + x^2 y^2 + z^2;
symmPart[pol, {x, y, z}]

x^2 y^2 + z^2


It works not only with polynomials

expr = Sin[x]^2 Cos[y] + Sin[x] Sin[y];
symmPart[expr, {x, y, z}]

Cos[y] Sin[x]^2

-
I have learnt a lot from your answers. With respect, though I really like the idea of cancelling out terms, multinomial terms with even number of odd exponent variables, e.g. x^2yz, will not cancel. I understood the question to be collecting multinomial terms with variables with all even exponents. –  ubpdqn Nov 5 '13 at 10:04
@ubpdqn Oh, yes. This was my omission. I update my solution. Unfortunately now it is not so elegant. –  ybeltukov Nov 5 '13 at 13:10

pol = d1^2 - d2^3 + d3^5 - d4^4 + d5^8;


Now collect terms with even powers as follows:

pol /. {(_^n_ | Times[-1, Power[_, n_]]) /; OddQ[n] :> Sequence[]}


Which gives:

d1^2 - d4^4 + d5^8


OR using Cases which gives you the terms as a List:

Cases[pol, (_^n_ | Times[-1, Power[_, n_]]) /; EvenQ[n]]


{d1^2, -d4^4, d5^8}

Of course if you want it back as a polynomial you could just do

Plus @@ Cases[pol, (_^n_ | Times[-1, Power[_, n_]]) /; EvenQ[n]]

-
Going to post as answer - trivial mod to RunnyKine's answer here but can't format code in comment... –  Ymareth Nov 5 '13 at 14:08

Since OP did not provide a test case, let us use

poly = Plus @@ Table[Subscript[c, i] Subscript[g, i]
d1^RandomInteger[{1, 4}] d2^RandomInteger[{1, 4}] d3^
RandomInteger[{1, 4}] d4^RandomInteger[{1, 4}], {i, 30}];


The following code finds the cases to be gathered, factors them, and produces an expression equivalent to the input

Module[{terms = Union[Cases[poly, ___ d1^k1_?EvenQ d2^k2_?EvenQ d3^k3_?EvenQ d4^
k4_?EvenQ :> {k1, k2, k3, k4}]]},
terms = Cases[poly, f : _ d1^#[[1]] d2^#[[2]] d3^#[[3]] d4^#[[4]] :> f] & /@ terms;
terms = Plus @@ Factor@Apply[Plus, terms, {1}];
Expand[poly - terms] + terms]

-

Here is an approach:

fun[pol_, var_] := Module[{p, ex, crit},
p = pol[[#]] & /@ Range[Length[pol]];
ex = Exponent[#, var] & /@ p;
crit = And @@@ (EvenQ /@ ex);
Plus @@ Pick[p, crit]
]


The first argument is expanded polynomial. The second argument is list of variables or single variable.

Test case (expanded) (x+y+z+w)^4,i.e.

f=w^4 + 4 w^3 x + 6 w^2 x^2 + 4 w x^3 + x^4 + 4 w^3 y + 12 w^2 x y +
12 w x^2 y + 4 x^3 y + 6 w^2 y^2 + 12 w x y^2 + 6 x^2 y^2 +
4 w y^3 + 4 x y^3 + y^4 + 4 w^3 z + 12 w^2 x z + 12 w x^2 z +
4 x^3 z + 12 w^2 y z + 24 w x y z + 12 x^2 y z + 12 w y^2 z +
12 x y^2 z + 4 y^3 z + 6 w^2 z^2 + 12 w x z^2 + 6 x^2 z^2 +
12 w y z^2 + 12 x y z^2 + 6 y^2 z^2 + 4 w z^3 + 4 x z^3 +
4 y z^3 + z^4


Applying:

fun[f, {x, y, z, w}]


yields:

w^4 + 6 w^2 x^2 + x^4 + 6 w^2 y^2 + 6 x^2 y^2 + y^4 + 6 w^2 z^2 +
6 x^2 z^2 + 6 y^2 z^2 + z^4

-

A simpler rule, if you just want to kill the odd-powered terms in the original expression, would be

pol /. Power[_,_?OddQ]->0

As ybeltukov pointed out this will not remove terms like x where the power is 1. This can still by matching the OddQ matching powers...

Apply[#-(# /.Power[_,_?EvenQ]->0)&,{pol}]


or as a rule

pol /. expr_:>(expr-(expr /.Power[_,_?EvenQ]->0))

-
How about x+x^2+x^3? x will not be killed. –  ybeltukov Nov 5 '13 at 14:29
You're right, thinking... –  Ymareth Nov 5 '13 at 16:35