How do I collect different exponents together?

Question

Suppose I have:

ClearAll[u1];
phi = 2 Pi/3;
u[x_, y_] := Exp[-I phi] x + Exp[I phi] y + x y;
u0[x_, y_] := 1 + Exp[I phi] x + Exp[-I phi] y;
u1[x_, y_] = u0[x, y] + u[x, y];
Collect[u[x, y] u1[1/x, 1/y], {x, y}]
Expand[u[x, y] u1[1/x, 1/y]]

How do I express the final results as the sum of different powers of $x^my^n$? Where m and n are integers, maybe 0, maybe negative, maybe positive.

Note that I need the terms with the same $m,n$ be grouped together.

Answer 1

I think @SimonWoods's tweak of my faulty idea should be posted as a possible answer:

Collect[#, y] & /@ Collect[u[x, y] u1[1/x, 1/y], {x, y}]

Answer 2

Mathematica has lots of tools for polynomials, but few for Laurent polynomials (Series will return a truncated Laurent series) and none really for treating monomials in multivariate polynomials as a flat sum. To get at the monomials of a polynomial (not a Laurent polynomial), one can use CoefficientList or CoefficientArrays. I used Series to find the lowest degree (if below zero) of each variable; maybe there's a better way (e.g. Exponent[p /. x -> 1/x, x]). This is needed to convert Laurent polynomial to a ordinary polynomial so that we can apply CoefficientList.

ClearAll[minExponent];
minExponent::laurent = "`` is not a Laurent polynomial.";
minExponent[p_, x_] := Module[{res},
  res = Series[p, {x, 0, 0}];
  If[Head[res] === SeriesData,
   res = res[[4]];
   If[PolynomialQ[x^-res p, x],
    Message[minExponent::laurent, p];
    res = $Failed],
   Message[minExponent::poly, x^-res p];
   res = $Failed];
  res /; FreeQ[res, $Failed]
  ]

Block[{p = u[x, y] u1[1/x, 1/y]},
 With[{xd = minExponent[p, x], yd = minExponent[p, y]},
  With[{c = CoefficientList[x^-xd y^-yd p, {x, y}]},
   Total[
    c*
     Transpose[{x^Range[xd, xd + Dimensions[c][[1]] - 1]}].
      y^{Range[xd, yd + Dimensions[c][[2]] - 1]},
    2
    ]
   ]]
 ]

Answer 3

For this sort of problem, I like to use the 3-arg version of Collect. For example:

tmp = Collect[u[x, y] u1[1/x, 1/y], {x, y}, Hold]

Hold[E^(-((2 I π)/3))]/y + ( Hold[E^((2 I π)/3)] + y Hold[1 + E^(-((2 I π)/3))])/x + Hold[3 + E^(-((2 I π)/3)) + E^((2 I π)/3)] + x (y Hold[1] + Hold[1 + E^((2 I π)/3)]/y + Hold[2 E^(-((2 I π)/3)) + E^((2 I π)/3)]) + y Hold[E^(-((2 I π)/3)) + 2 E^((2 I π)/3)]

Notice how every coefficient is wrapped in Hold. Now, we can use Expand, and then release the hold:

tmp //Expand //ReleaseHold //TeXForm

$x y+\frac{\left(1+e^{\frac{2 i \pi }{3}}\right) x}{y}+\frac{\left(1+e^{-\frac{2 i \pi }{3}}\right) y}{x}+\left(2 e^{-\frac{2 i \pi }{3}}+e^{\frac{2 i \pi }{3}}\right) x+\frac{e^{\frac{2 i \pi }{3}}}{x}+\left(e^{-\frac{2 i \pi }{3}}+2 e^{\frac{2 i \pi }{3}}\right) y+\frac{e^{-\frac{2 i \pi }{3}}}{y}+e^{\frac{2 i \pi }{3}}+e^{-\frac{2 i \pi }{3}}+3$

Answer 4

This is another way, albeit ad hoc, to do it.

phi = 2 Pi/3;
u[x_, y_] := Exp[-I phi] x + Exp[I phi] y + x y;
u1[x_, y_] = u0[x, y] + u[x, y];

Module[{a, b},
  a = Collect[#, x] & /@ Collect[u[x, y] u1[1/x, 1/y], y];
  b = (Collect[#, y] & /@ Collect[u[x, y] u1[1/x, 1/y], x])[[5]];
  a[[;; 4]] + b + a[[7 ;;]]]

Answer 5

Clear["Global`*"];
phi = 2 Pi/3;
u[x_, y_] := Exp[-I phi] x + Exp[I phi] y + x y;
u0[x_, y_] := 1 + Exp[I phi] x + Exp[-I phi] y;
u1[x_, y_] = u0[x, y] + u[x, y];

expr = u[x, y] u1[1/x, 1/y];

expr2 = (Simplify /@ Collect[expr /. {x -> t*x, y -> t*y}, t]) /. 
  t -> 1

expr == expr2 // Simplify

(* True *)