Partial monomial pattern matching

Question

Is there an elegant way to "partially" match monomials in a polynomial expression?

Let me explain what I mean by "partially" with an example. Suppose I have

expr = x^2*y + x*y^2 + x*y^3

and I would like to use pattern matching to write a rule that replaces x*y^2 -> z. Of course, taken literally, this pattern only matches the second term of expr, but what I would like to achieve is that the result of the replacement is x^2*y + z + y*z, i.e. if the monomial expression on the LHS of the rule appears (with at least the powers given on the LHS) this monomial expression should be replaced by the RHS.

I know about optional patterns and conditions, i.e. something like

expr /. x^a_.*y^b_. /; a >= 1 && b >= 2 :> z*x^(a-1)*y^(b-2)

does what I want, but it feels rather clumsy and fragile.

Is there a more elegant way to do this?

Answer 1

Simplify or FullSimplify using z == x y^2 as the second argument gives the desired result for the example in OP:

FullSimplify[#, z == x y^2] & /@ expr

x^2 y + z + y z

Simplify[#, z == x y^2] & /@ expr

x^2 y + z + y z

Answer 2

Another way to do it is to deconstruct the polynomial into vector-matrix products with CoefficientList, apply conversion factors (e.g. z / (x y^2)) to the right elements of the coefficient matrix, then reconstruct the polynomial with Dot.

monosub[poly_, lhs_ -> rhs_, vars_] := With[
  {dims = (*Effective dimensions of CoefficientList array*) Exponent[poly, vars]},
  If[
    (*If the power of either variable is not in poly, no sub is done*)
    Or @@ Thread[Exponent[lhs, vars] > dims],
    poly,
    (*Reconstruct the polynomial*) Dot[
      (*Variable 1 monomial-vector e.g. {1, x, x^2, ...}*) vars[[1]]^Range[0, dims[[1]]],
      (*Apply conversion factors to the right coefficients*)
      CoefficientList[poly, vars] SparseArray[
        Band[Exponent[lhs, vars] + 1] -> ConstantArray[rhs/lhs, dims - Exponent[lhs, vars] + 1], 
        dims + 1,
        1
      ],
      (*Variable 2 monomial-vector*) vars[[2]]^Range[0, dims[[2]]]
    ]
  ] // Expand
]

Then for the example polynomial

monosub[x^2*y + x*y^2 + x*y^3, x y^2 -> z, {x, y}]

x^2 y + z + y z

And for a more general example

KroneckerProduct[Array[a[#] x^# &, 2, 0], Array[b[#] y^# &, 3, 0]]~Total~2
monosub[%, x y -> z, {x, y}]

a[0] b[0] + x a[1] b[0] + y a[0] b[1] + x y a[1] b[1] + y^2 a[0] b[2] + x y^2 a[1] b[2]

a[0] b[0] + x a[1] b[0] + y a[0] b[1] + z a[1] b[1] + y^2 a[0] b[2] + y z a[1] b[2]