How to automatically find sequence of linear transformations

Question

I have a set of three polynomials in x and y, and 9 real coefficients a1, b1, ... c3:

poly = {a1 x + b1 y + c1, a2 x + b2 y + c2, a3 x + b3 y + c3}

Is there a built-in Mathematica function that can automatically find a linear transformation (scalings and shifts only) that transformations the polynomials to the form:

poly = {d1 x, d2 y, d3 (x+y)+d4}

where d1, d2, d3, d4 are real numbers independent of x and y. I'm having a lot of trouble with this since using Solve keeps resulting in d4 depending on x and y.

I only need to find one solution to this problem. The reason I would like to automate the solution is because sometimes certain coefficients may be zero (such as a3=0 and b2=0 etc...).

Answer 1

These commands do not produce what you want since you said that a3 or b2 can be zero. Still they might be a good alternative of what you have done...

mStart = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}};
mStart.{x, y, 1}   
(* {c1 + a1 x + b1 y, c2 + a2 x + b2 y, c3 + a3 x + b3 y} *)

mEnd = {{d1, 0, 0}, {0, d2, 0}, {d3, d3, d4}};
mEnd.{x, y, 1}  
(* {d1 x, d2 y, d4 + d3 x + d3 y} *)

ClearAll[v]
vMat = Array[v, {3, 3}];
eqs = Thread[Flatten[mStart*vMat] == Flatten[mEnd]];
sol = Solve[eqs, Flatten[vMat], Reals]

(* {{v[1, 1] -> d1/a1, v[1, 2] -> 0, v[1, 3] -> 0, v[2, 1] -> 0, 
  v[2, 2] -> d2/b2, v[2, 3] -> 0, v[3, 1] -> d3/a3, v[3, 2] -> d3/b3, 
  v[3, 3] -> d4/c3}} *)

MatrixForm[vMat /. First[sol]]

((mStart*vMat) /. First[sol]).{x, y, 1}

(* {d1 x, d2 y, d4 + d3 x + d3 y} *)