Computing basis for the intersection of two vector spaces represented as polynomial subspaces in multiple variables

Question

I was trying to compute intersection of two vector spaces. I did find this link Intersection of two vector spaces with a nifty function being made for this given two lists of basis vectors.

I am having trouble finding an efficient way of putting basis vectors into a list that start as polynomials. For example, I have the vector spaces spanned by {z1, z2, z3} and {z4, z5, z6}

z1 = (1/6 p ((x1 + 2 y1)^2 + (2 x1 + y1)^2) + ((p - 1)/p) (x2 + y2)) (x1 + 2 y1);

z2 = (x1 + 2 y1)^3;

z3 = (x1 + 2 y1) (x2 + 2 y2);

And another given by

z4 = (1/6 p ((x1 + 2 y1)^2 + (2 x1 + y1)^2) + ((p - 1)/p) (x2 + y2)) (2 x1 + y1);

z5 = (2 x1 + y1)^3;

z6 = (2 x1 + y1) (2 x2 + y2);

I am interested in the intersection of these vector spaces. When I try to find an efficient way to put them into list, I was thinking something like

w1 = Flatten[CoefficientList[z1, {x1, y1, x2, y2}];

would work, but I don't get vectors of the same size, as illustrated below

Flatten[CoefficientList[z1, {x1, y1, x2, y2}]]

{0, 0, 0, 0, 0, (2 (-1 + p))/p, (2 (-1 + p))/p, 0, 0, 0, 0, 0, (5 p)/3, 0, 0, 0, 
 0, (-1 + p)/p, (-1 + p)/p, 0, 0, 0, 0, 0, (7 p)/2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
 3 p, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, (5 p)/6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}

Flatten[CoefficientList[z2, {x1, y1, x2, y2}]]

{0, 0, 0, 8, 0, 0, 12, 0, 0, 6, 0, 0, 1, 0, 0, 0}

Any suggestions?

Answer 1

This way is perhaps a little kluge-y, and it can be certainly be elegant-ized, but here's a first pass at the problem.

We first construct a generic polynomial with all of the possible monomials in your polynomials using my answer here:

polynomial[vars_List, degree_Integer, coeff_] :=
   #.Array[coeff, Length@#] &@ DeleteDuplicates[Times @@@ Tuples[Prepend[vars, 1], degree]]
Protect[temp];
poly = polynomial[{x1, x2, y1, y2}, 3, temp[] &];

We then add this polynomial to each of yours to guarantee that it has all of the possible monomials. We then use CoefficientRules on the polynomials, set temp[] to zero, and then extract the entries. For instance, using one of your example polynomials from your post:

Last /@ CoefficientRules[
   z1 + polynomial[{x1, x2, y1, y2}, 3, temp[] &],
   {x1, x2, y1, y2}
  ] /. temp[] -> 0
(* {(5 p)/6, 0, 3 p, 0, 0, 0, 0, 0, 1 - 1/p, (7 p)/2, 0, 0, 0, 1 - 1/p, 0, 0, 0,
    0, 0, 0, 0, 2 - 2/p, 0, 0, 0, (5 p)/3, 0, 0, 0, 2 - 2/p, 0, 0, 0, 0, 0} *)

This vector is of length 35 because there are 35 monomials (including 1) of degree up to 3 in four variables.