Replacement rules for powers of a symbol

Question

Suppose, I have an expression like so:

In[68]:= expr = 2 + 5*q + q^2 + 8 q^3 + 19 q^7

Out[68]= 2 + 5 q + q^2 + 8 q^3 + 19 q^7

Now I want to take all powers of q lying between 0 and 2 to zero i.e. my desired output is:

$8 q^3 + 19 q^7$

I tried the following without success:

In[72]:= expr /. q^n_. /; 0 <= n <= 2 -> 0

Out[72]= 2

What could be a neat way to do it? I know the following works:

In[73]:= Plus @@ (If[0 <= Exponent[#, q] <= 2, 0, #] & /@ List @@ expr)

Out[73]= 8 q^3 + 19 q^7

I just wanted to do this with simple pattern matching and replacement.

Any help will be appreciated.

Answer 1

There are already several good answers. Here are three other possibilities that are closer to what OP had in mind:

exp = 2 + 5 q + q^2 + 8 q^3 + 19 q^7;
exphold = HoldForm[2 q^0 + 5 q + q^2 + 8 q^3 + 19 q^7];

Replace[exp, q^n_. /; 1 <= n <= 2 -> 0, {2}] - (exp /. q -> 0)
Replace[q exp // Expand, q^n_. /; 1 <= n <= 3 -> 0, {2}]/q // Expand
Replace[exphold, q^n_. /; 0 <= n <= 2 -> 0, {3}] // ReleaseHold

all of which return 8 q^3 + 19 q^7, as expected.

For fun:

FromDigits[
  Reverse[CoefficientList[exp, q] Table[Boole[Not[0 <= n <= 2]], {n, 0, Exponent[exp, q]}]]
, q]
Sum[q^n/n! (D[exp, {q, n}] /. q -> 0), {n, 3, Exponent[exp, q]}] // Expand

which also return 8 q^3 + 19 q^7.

Answer 2

Ignoring your requirement of using simple replacement rules, you could do:

Normal @ Series[expr, {q, Infinity, -3}]

8 q^3 + 19 q^7

Answer 3

expr = 2 + 5*q + q^2 + 8 q^3 + 19 q^7;
vars = Variables[expr]; 
FromCoefficientRules[
 Select[CoefficientRules[expr, vars], First[First[##]] > 2 &], vars]

For large expressions you can convert output of CoefficientRules to Associations, and then manipulate Key/Value pairs. That would result into very fast program.

Answer 4

Integrate[D[expr,{q,3}],q,q,q]

Answer 5

Another answer using pattern matching and replacement:

{expr /. {q^2 -> 0, _ q -> 0}} - Cases[expr, _?NumberQ]
Part[%,1]
8 q^3 + 19 q^7

(Edited to fit the comments).