Perhaps funs = {f, e, g, h} apply = {sf, se, sgen, sgen} k[a_, b_, c_] := c[a] b Collect[ z[x] expr , Blank /@ funs] /. (Times[a___, l : #, r___] :> k[a r, l, Head@l /. Thread[funs -> apply]] & /@ (Blank /@ funs)) (* e[y] se[(x + y) z[x]] + e[x] se[(-2 x + x^2 + y) z[x]] + f[x] sf[(x^2 + y^2) z[x]] + g[x] sgen[x^2 z[x]] + h[x] sgen[y^2 z[x]] *)