Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
add comment

6 Answers

up vote 6 down vote accepted

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]

Mathematica graphics

share|improve this answer
1  
nice...always learn something –  ubpdqn Nov 5 '13 at 10:38
2  
Nice indeed; a bit shorter: FromCoefficientRules[Cases[r, {__?EvenQ} ~_~ _], vars] –  Mr.Wizard Nov 5 '13 at 13:19
add comment

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
share|improve this answer
    
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
add comment

How about:

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]]
share|improve this answer
    
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
add comment

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]
share|improve this answer
add comment

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
share|improve this answer
add comment

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))
share|improve this answer
    
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
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.