I have a large symbolic expression with six variables a,b,c,d,e,f per term, roughly like this:

expr=a^2 b c d^2 + 1/2 a b (b + I d) e^3 - 1/8 I a (c + 1/2 I (c + I d))^2 (I b + 1/2 (c + I d)) e f

I want to test whether expr contains terms with c and d and e and f. In the example above, there is one term that fulfills the requirement: (-(1/8)-I/16) a b c d e f.

I want a function g[x], which returns a new expression, only containing terms with c*d*e*f.

I can solve it using Expand and symbolic replacements, but this is very slow, and I was hoping for a much faster way. Does anybody have a suggestion for a faster implementation?

Here is the example code - which first creates the expression (such that we can compare our solutions), then defines g[x], runs it and prints the result and time:

(* Same seed for fair comparison *)
SeedRandom[1];

(* Creating one large expression that has to be analysed *)
func = 0;
For[ii = 1, ii <= 100, ii++,
  rndFull = Product[RandomChoice[{a, b, c, d, e, f}], {i, 6}];
  For[jj = 1, jj <= 60, jj++,
   rndVar0 = RandomChoice[{a, b, c, d, e, f}];
   rndVar1 = RandomChoice[{a, b, c, d, e, f}];
   rndVar2 = RandomChoice[{a, b, c, d, e, f}];
   rndFull = rndFull /. {rndVar0 -> 1/2*(I*rndVar1 + rndVar2)};
   ];
  func += Simplify[Exp[(I*\[Pi])/2*RandomInteger[4]]]*rndFull;
  ];

(* g[x] works correctly but is very slow *)
g[expr_] := (Return[Expand[ZERO*expr] /. {ZERO*c*d*e*f -> c*d*e*f} /. {ZERO -> 0}])


CurrTime = AbsoluteTime[];
Print[g[func]]
(* (-(3066695705460323281748465708319/340282366920938463463374607431768211456)-(592396087826201433092643851215 I)/170141183460469231731687303715884105728) a^2 c d e f-(28061855884788386235225/1267650600228229401496703205376-(1188923985339435970275 I)/158456325028528675187087900672) a b c d e f-(23306256125181506635725/2535301200456458802993406410752-(47084620130455206162825 I)/5070602400912917605986812821504) b^2 c d e f *)
Print[AbsoluteTime[] - CurrTime] (* 4.5930638 sec *)

Does anybody have a suggestion for a faster implementation?