Elimination of terms not containing at least one variable from a set

Question

I have an expression with each term therein either containing at least one $n_i \in \left\{ n_1 , n_2 \dots , n_{5} \right\}$ or no $n_i$ at all. I would like to easily eliminate all the terms that are of the latter nature, i.e I would like to reduce the expression down to one containing only terms each with at least an $n_i$.

For example, I would replace

$$\frac{n_1 n_2}{n_3^2 n_4}c_1 + c_2 + \frac{1}{n_5}c_3$$ with $$\frac{n_1 n_2}{n_3^2 n_4}c_1 + \frac{1}{n_5}c_3,$$ eliminating the term with no $n_i$ and keeping those with at least one $n_i$. The $c_i$ are just $n_i$ independent variables.

Here is an expression snippet (note the expr in its entirety is too large to be presented), but the snippet below includes both $n_i$ dependent and $n_i$ independent pieces.

expr = -(s^4/(2 n2 n4 r (r - s) (r + s)^3)) + q/((-r + s) (r + s)^3) - (n1 q)/(2 n2 (-r + s) (r + s)^3) - (n2 q)/(2 n1 (-r + s) (r + s)^3) + (n1 q)/(2 n3 (r + s) (r + s)^3) - (n2 q)/(n3 (-r + s) (r + s)^3) + (n2^2 q)/(2 n1 n3 (-r + s) (r + s)^3) + (3 n1 q^2)/(8 n3 r (-r + s) (r + s)^3) - (n1^2 q^2)/(8 n2n3 r (-r + s) (r + s)^3) - (3 n2 q^2)/(8 n3 r (-r + s) (r + s)^3) + (n2^2 q^2)/(8 n1 n3 r (-r + s) (r + s)^3) + r/((-r + s) (r + s)^3);

I've looked into Filter out all terms not involving a given variable but I couldn't find a way to generalise the answer there with the case keep = b; to more than one symbol or to make terms denote an expression rather than a brace of expressions, e.g

keep = {n1,n2,n3,n4,n5}; (*keep expressions with this symbol in it*) lst = DeleteDuplicates[Cases[#, _Symbol, Infinity]] & /@ expr Pick[expr, MemberQ[#, keep] & /@ lst]

Answer 1

I have one solution which I do not like too much, but still. Let us introduce a function counting how many times n with whatever number enters the expression, provided the expression is completely expanded:

countN[x_] := 
 Count[Flatten[Characters /@ToString/@Join[List @@ Expand[Numerator[x]], 
      List @@ Expand[Denominator[x]]]], "n"];

Now it can be applied to your expression:

Select[expr, countN[#] == 0 &]

(*  q/((-r + s) (r + s)^3) + r/((-r + s) (r + s)^3)  *)

Have fun!

Edit: To address your question: The main aim is to be able to count the number of variables in each term that contains n1, n2,...That is, the variables whose names start with n. For Mma, however, these are absolutely different variables. It cannot easily "see" them. For this reason the idea is

1. to transform the expression into a list. Observing that there are terms containing fractions, let us first transform the fractions into list containing numerator and denominator. This is done by

Join[List @@ Expand[Numerator[x]],List @@ Expand[Denominator[x]]]]

This is applied to one single term of your expression, rather than to the whole expression.

2. We got a list consisting of various terms. Now let us transform each term into a string by mapping the function ToString onto the obtained list. /@ stays for mapping:

   ToString/@Join[List @@ Expand[Numerator[x]],List @@ Expand[Denominator[x]]]

3. Now we have got a list containing strings. Some of them consist of single characters or numbers. But we are interested in those consisting of two characters, such as "n1". Let us transform them into a list of characters, such as {"n","1"}. This is done by mapping the function Charactersonto it:

   Characters /@ToString/@Join[List @@ Expand[Numerator[x]], List @@ Expand[Denominator[x]]]

4. Now one has a nested list, and it can be transformed into a plain one applying Flatten:

   Flatten[Characters /@ToString/@Join[List @@ Expand[Numerator[x]], List @@ Expand[Denominator[x]]]]

5. What we have got with it is an original term of your expression transformed into a plain list. If the expression contained some terms with n1, n2,... or whatever, this list will contain several strings consisting of "n". Attention, in this list n is not a variable, but its head is a String. If there were originally no n-s in the expression, then no such strings "n" will be in the list.

6. It is left to count the number of the stings "n". This is done by the function

   countN[x_] :=Count[here stays our list, "n"];

7. Then the function countN[x] is used in a standard way with Select fixing a condition that there are no strings containing "n" in the list.

Answer 2

Here are two approaches using FreeQ:

DeleteCases:

DeleteCases[expr, s_ /; FreeQ[s, Alternatives @@ keep]]

(n1 q)/(2 n3 (r + s)^4) - s^4/(2 n2 n4 r (r - s) (r + s)^3) - (n1 q)/( 2 n2 (-r + s) (r + s)^3) - (n2 q)/(2 n1 (-r + s) (r + s)^3) - (n2 q)/( n3 (-r + s) (r + s)^3) + (n2^2 q)/(2 n1 n3 (-r + s) (r + s)^3) - (n1^2 q^2)/( 8 n2n3 r (-r + s) (r + s)^3) + (3 n1 q^2)/(8 n3 r (-r + s) (r + s)^3) - ( 3 n2 q^2)/(8 n3 r (-r + s) (r + s)^3) + (n2^2 q^2)/( 8 n1 n3 r (-r + s) (r + s)^3)

Select:

Select[expr, Not @* FreeQ[Alternatives @@ keep]]

(n1 q)/(2 n3 (r + s)^4) - s^4/(2 n2 n4 r (r - s) (r + s)^3) - (n1 q)/( 2 n2 (-r + s) (r + s)^3) - (n2 q)/(2 n1 (-r + s) (r + s)^3) - (n2 q)/( n3 (-r + s) (r + s)^3) + (n2^2 q)/(2 n1 n3 (-r + s) (r + s)^3) - (n1^2 q^2)/( 8 n2n3 r (-r + s) (r + s)^3) + (3 n1 q^2)/(8 n3 r (-r + s) (r + s)^3) - ( 3 n2 q^2)/(8 n3 r (-r + s) (r + s)^3) + (n2^2 q^2)/( 8 n1 n3 r (-r + s) (r + s)^3)

Answer 3

You can also use Internal`LiterallyAbsentQ or Internal`LiterallyOccurringQ in combination with Replace, DeleteCases or Select:

r1 = Replace[expr , _?(Internal`LiterallyAbsentQ[#, keep] &) :> 0, 1];
TeXForm[r1]

$\small -\frac{\text{n1}^2 q^2}{8 \text{n2n3} r (s-r) (r+s)^3}+\frac{\text{n2}^2 q^2}{8 \text{n1} \text{n3} r (s-r) (r+s)^3}+\frac{\text{n2}^2 q}{2 \text{n1} \text{n3} (s-r) (r+s)^3}-\frac{\text{n2} q}{2 \text{n1} (s-r) (r+s)^3}-\frac{\text{n1} q}{2 \text{n2} (s-r) (r+s)^3}+ \\ \frac{3 \text{n1} q^2}{8 \text{n3} r (s-r) (r+s)^3}+\frac{\text{n1} q}{2 \text{n3} (r+s)^4}-\frac{3 \text{n2} q^2}{8 \text{n3} r (s-r) (r+s)^3}-\frac{\text{n2} q}{\text{n3} (s-r) (r+s)^3}-\frac{s^4}{2 \text{n2} \text{n4} r (r-s) (r+s)^3}$

r2 = DeleteCases[expr , _?(Internal`LiterallyAbsentQ[#, keep] &)];
r3 = Select[expr, Internal`LiterallyOccurringQ[#, keep] &];
Equal[r1, r2, r3]

True