Sorting out list elements that are nonlinear in a certain function

Question

I have the following (long) list (exemplary I will show you only a few elements of it):

  list={a[om1,om2,om3,om4,om5,om6]*F[om1] F[om2] F[om4] F[om5] F[om6],b[om1,om2,om3,om4,om5,om6]*F[om1] F[om2], c[om1,om2,om3,om4,om5,om6]*F[om2],d[om1, om2, om3, om4,om5,om6]}

I want to keep only those elements that are linear in the function F[_] (i.e. the result in the example should be {c[om1,om2,om3,om4,om5,om6]*F[om2]}). So far I did this with Select, sth like

Select[list, 
 MemberQ[#, F[_]] && FreeQ[#, F[_] __F] &]

For a very large list, however, this becomes too slow (can I invoke Assumptions with Select?). Is there another way, to do the same task in a faster way? I was thinking of Series but it doesn't seem to be applicable to expansions in functions.

Answer 1

Replace MemberQ and FreeQ with Count as follows:

list2 = Join @@ ConstantArray[list, 10000];
RepeatedTiming[A=Select[list2, MemberQ[#, F[_]] && FreeQ[#, F[_] __F] &]][[1]]
RepeatedTiming[B = Select[list2, Count[#, F[_]] == 1 &]][[1]]
A == B

0.302

0.063

True

Speed up: 5x (better than nothing :) )

Answer 2

The question of efficient lookup of terms linear relative expression satisfying a given pattern depends strongly on whether coefficients c[om1,...] themselves can somehow depend on this expression.

If coefficients a, b, c, etc can themselves depend on F, then none of the above solutions can be reliable. For example, the expression Sin[F[om1]] contains exactly one expression matching _F at the first level, so both approaches of Fraccalo and Alexei Boulbitch will return it.

Select[{Sin[F[om1]]}, Count[#, F[_]] == 1 &]
(*Returns {Sin[F[om1]]}*)

ClearAll[count];
count[expr_] := Count[expr, _F, Infinity];
Select[{Sin[F[om1]]}, count[#] == 1 &]
(*Returns {Sin[F[om1]]}*)

In this, the most general case, the only option I see is to use FreeQ:

list={a[om1,om2,om3,om4,om5,om6]*F[om1] F[om2] F[om4] F[om5]    F[om6],b[om1,om2,om3,om4,om5,om6]*F[om1] F[om2],c[om1,om2,om3,om4,om5,om6]*F[om2],d[om1,om2,om3,om4,om5,om6]};
list2=Join@@ConstantArray[list,10000];
RepeatedTiming[
  general=Cases[
    list2,
    (a_/;(FreeQ[a,_F]))*_F
  ]
]//First
(*0.298*)

However, if coefficients themselves cannot depend on F and we just need to figure out how many times F[...] is repeated, then Fraccalo approach is a good option.

RepeatedTiming[
  select = Select[list2, Count[#, F[_]] == 1 &]
] // First
(*0.054*)

But we can improve the result a little bit by exploiting the fact that in this case we are not interested in how many there are F[...] expressions in the terms, what Count computes. We only need to know, whether there is exactly one expression of the form or not. For this reason, we can try the following:

RepeatedTiming[
   pattern = Cases[list2, Repeated[Except[_F], {1}]*_F]
] // First
(*0.0280*)

general === select === pattern
(*True*)

Note, that Except[_F]*_F will not work here because Times is Flat.

Answer 3

Provided each term always has a coefficient (like a[om1,...], c[om1,...] etc.) and may (or may not) have one or several F factors, try this:

Select[list, Length[#] == 2 &]

(* {c[om1, om2, om3, om4, om5, om6] F[om2]}  *)

Edit: taking into account your comment try also this:

count[expr_] := Count[expr, _F, Infinity]

Select[list, count[#] == 1 &]

   (*  {c[om1, om2, om3, om4, om5, om6] F[om2]} *)

Have fun!