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

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]

• Have you seen the function FreeQ? Also have a look at Nothing. Aug 20, 2018 at 9:24
• Yes, thanks, I have seen those. As standalone functions they don't help because the output of FreeQ is just True or False. Nothing would be good but the expressions are large so to manually replace each $n_i$ independent term with Nothing would be tedious.
– CAF
Aug 20, 2018 at 9:30
• But of course, FreeQ should be used together with the conditional operator. Please have in mind that people here request that you include Mma code of your expression along with the code showing your trials. Otherwise, they may appear reluctant to help you. Aug 20, 2018 at 9:36
• I see. The expression is large to be coded here (around 2000 terms of the form given in the question) so I thought a small snippet as given would be ok. Regarding my trials, the FreeQ is used within an operator in the SE question I linked to in my question but I can't seem to find a way to generalise that.
– CAF
Aug 20, 2018 at 9:40
• We all never give the full expressions, but only its representative part. It must contain all terms necessary to demonstrate the problem at hand, but not more. Aug 20, 2018 at 9:43

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.

1. 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]]]

2. 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]]]

3. 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]]]]

4. 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.

5. 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"];

6. 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.

• Nice! works like a charm, so then the expression I want is then my original expression subtract the Select[expr, countN[#] == 0 &] so that all terms now have at least one $n_i$. As a novice to MMa, I can't really understand what the components of your function mean, could you elaborate on that maybe in your answer?
– CAF
Aug 20, 2018 at 15:29
• @CAF Please, have a look at the edit Aug 20, 2018 at 15:58

Here are two approaches using FreeQ:

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[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)

You can also use InternalLiterallyAbsentQ or InternalLiterallyOccurringQ in combination with Replace, DeleteCases or Select:

r1 = Replace[expr , _?(InternalLiterallyAbsentQ[#, 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 , _?(InternalLiterallyAbsentQ[#, keep] &)];
r3 = Select[expr, InternalLiterallyOccurringQ[#, keep] &];
Equal[r1, r2, r3]
`

True