Count heads: e.g. neglect all terms $\sin(x) \sin (y) \sin (z) \sin (w)$ for all values of the argument

Question

I have a polynomial (functional) expression $E[F]$ in terms of a function $F$.

I want to take an $F$-cube truncation in the sense that I want to and make terms of the form $F[w]F[x]F[y]F[z]$ vanish for any value of the arguments $w,\ldots,z$ that are not real variables but complicated to describe and (thus not realistic to list).

For concreteness, take $F(x)=\sin(x)$; one could imagine $D$, the domain of $F$, has cardinality $1000$ (which is why I would not like to list $1000^4$ evaluated elements) and I'd like to neglect $\mathcal O (\sin^4)$-terms, in the sense described above. An example would be

Truncation of

$$\sin^2(v)\sin(w)\sin^2(x)\sin^2(w) \sin(y)+ \sin^2(x) \sin(y) \sin(w)+\sin(w)\sin(x)\sin(y)+ 2\sin(y) + 3 $$

to be for all $v,w,x,y,z$

$$ \sin(w)\sin(x)\sin(y)+2\sin(y) +3 $$

i.e.

Sin[v]^2 Sin[w]Sin[x]^2 Sin[w] ^2 Sin[y] + Sin[x]^2 Sin[y] Sin[w]+Sin[w] Sin[x] Sin[y]+ 2Sin[y] + 3 

(*should yield ==>>  Sin[w] Sin[x] Sin[y]+ 2Sin[y] + 3*)

How to annihilate multiple products of the image of a custom function? So I start it making the truncation linear

VariableList={(*not easy to describe*)}
Truncation[x_Plus] := Truncation[#] & /@ x
Truncation[c_ x_] := c Truncation[x] /; And @@ FreeQ[c, VariableList])

where x_ would be a polynomial in $F[x_1] \cdots F[x_n]$. But

Count[expr_implying_F , F]

yields 0 since $F$ is a head.

Also the suggested Count[expr_, _F, All] does not work because of:

Count[F[y] F[x] F[z] F[w] , _F, All] (*yielding 4 as it should*)
Count[F[x] F[x] F[x] F[w] , _F, All] (*yielding 2, it should be 4*)
Count[F[x] F[x] F[x] F[x] , _F, All] (*yielding 1, it should be 4*)

• This counting has been solved here for $F(x)=\sqrt x$, but the soulution relies on properties of the square root.

• The solution should not refer to properties of the function $F$, e.g. in the example, not to evoke trigonometric identities.

Answer 1

Try this:

expr = Sin[v]^2 Sin[w] Sin[x]^2 Sin[w]^2 Sin[y] + 
  Sin[x]^2 Sin[y] Sin[w] + Sin[w] Sin[x] Sin[y] + 2 Sin[y] + 3;

We will exchange any Sin[something]->ϵ*Sin[someting] and then expand in series in terms of ϵ:

expr2=Series[expr /. Sin[x_] -> ϵ*Sin[x], {ϵ, 0,3}] // Normal

(* 3 + 2 ϵ Sin[y] + ϵ^3 Sin[w] Sin[x] Sin[y] *)

After that one only need to put ϵ=1. Finally

expr2 /. ϵ -> 1

(*  3 + 2 Sin[y] + Sin[w] Sin[x] Sin[y]  *)

Have fun++!