How to do Cases with multiple related patterns?

Question

I would like to write a function similar to Cases, but can search for a group of related patterns together. For example,

casesList[f[x] g[x] + f[y] + g[y]/f[z], {f[a_], g[a_]}]

{{f[x], g[x]}, {f[y], g[y]}}

By "related patterns", I mean that in the above example a_ matches the same x for both f and g at the first list, and matches y at the second list.

Note that here the input {f[a_], g[a_]} could be any other patterns. As another example,

caseList[D[f[x,y],x] + D[f[x,y],y] + D[g[x,y],x] + D[g[x,y],y],
    {D[f_[x_,y_],x_], D[f_[x_,y_],y_]}]

{{Derivative[1, 0][f][x, y], Derivative[0, 1][f][x, y]}, {Derivative[1, 0][g][x, y], Derivative[0, 1][g][x, y]}}

Is there a simple way to do this? Thanks!

EDIT: To further clarify the question, I'd like to compare the situation with Cases for a list. For example,

Cases[{{f[a], f[b]}, {f[c], f[c]}}, {f[a_], f[a_]}, Infinity]

{{f[c], f[c]}}

Cases[{{f[c], f[c]}}, {f[a_], f[b_]}, Infinity]

{{f[c], f[c]}}

In the above two examples, Cases does exactly what I want. However, more generally the expressions which match f[a_] does not necessarily stays in a list structure, but rather may be at elsewhere in the expression. This is the major difficulty I met.

Answer 1

I'm not entirely sure whether this is right and works correctly, but the following could be an idea for a general rule-based approach. The idea is to use Cases to extract all matching expression separately for the given list of patterns. Let me illustrate this by your simple f example

expr = f[x] g[x] + f[y] + g[y]/f[z];

Cases[expr, #, Infinity, Heads -> True] & /@ {f[a_], g[a_]}
(* {{f[y], f[x], f[z]}, {g[x], g[y]}} *)

Now we have two result lists where all in the first list match f[a_] and all in the second list match g[a_]. Having this, the next step is kind of obvious: We need a replacement rule, where the a_ will match the same in both patterns. Given our result, this should be an easy rule of the following form

{{___,f[a_],___},{___,g[a_],___}} :> {f[a], g[a]}

The only tedious work is to build this rule from the input pattern list {f[a_], g[a_]}. Let's assume we have already build this, then we can use ReplaceList to get all possibilities

ReplaceList[{{f[y], f[x], f[z]}, {g[x], 
   g[y]}}, {{___, f[a_], ___}, {___, g[a_], ___}} :> {f[a], g[a]}]
(* {{f[y], g[y]}, {f[x], g[x]}} *)

Looks OK for me. With this in mind, we can write our CasesList combining all ideas. Here you see how the last replacement rule is built automatically

CasesList[expr_, pattern_List] := 
 With[{cases = Cases[expr, #, Infinity, Heads -> True] & /@ pattern,
   ruleLHS = {___, #, ___} & /@ pattern,
   ruleRHS = pattern /. Verbatim[Pattern][arg_, ___] :> arg
   },
  ReplaceList[cases, ruleLHS :> ruleRHS]
 ]

Now, let's try this with your second example

CasesList[D[f[x,y],x]+D[f[x,y],y]+D[g[x,y],x]+D[g[x,y],y],
   {D[f_[x_,y_],x_],D[f_[x_,y_],y_]}]

{{Derivative[1, 0][f][x, y], Derivative[0, 1][f][x, y]}, {Derivative[1, 0][g][x, y], Derivative[0, 1][g][x, y]}}

Answer 2

This question may be underspecified. My impression is that you want a Gather-type operation of subexpressions of a particular type, but this is complicated by your first example.

The FullForm of your first input expression is:

Plus[f[y], Times[f[x], g[x]], Times[Power[f[z], -1], g[y]]]

As you can see f[x], g[x] are adjacent, but f[y], g[y] are not. The first is easily found with:

Cases[f[x] g[x] + f[y] + g[y]/f[z], f[a_] g[a_], -1]

{f[x] g[x]}

Perhaps you want to consider all appearances of f[_] and g[_] and then find pairs. This could be done as follows:

Cases[f[x] g[x] + f[y] + g[y]/f[z], f[_] | g[_], -1]

GatherBy[%, First]

{f[y], f[x], g[x], f[z], g[y]}

{{f[y], g[y]}, {f[x], g[x]}, {f[z]}}

From there you could filter the results you want. (I'll wait for confirmation of what you want before attempting to implement this, as things like order must be considered.)

Answer 3

Examples are good but I find hard to get what would be a general description for that function.

DeleteCases[
 GatherBy[
  Cases[f[x] g[x] + f[y] + g[y]/f[z], z : (f[x_] | g[x_]) :> {z, x}, ∞],
  Last][[;; , ;; , 1]]
, {_}]

{{f[y],g[y]},{f[x],g[x]}}

The same idea works for second case

DeleteCases[
 GatherBy[
  Cases[D[f[x, y], x] + D[f[x, y], y] + D[g[x, y], x] + D[g[x, y], y]
        , z : (D[f_[x_, y_], x_] | D[f_[x_, y_], y_]) :> {z, f}, ∞],
 Last][[;; , ;; , 1]]
, {_}]

{{Derivative[0, 1][f][x, y], Derivative[1, 0][f][x, y]}, 
 {Derivative[0, 1][g][x, y], Derivative[1, 0][g][x, y]}}