3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ It seems that it is so expressed. I must be missing something. $\endgroup$ – Michael E2 Nov 22 '19 at 21:47
  • $\begingroup$ @MichaelE2 the same terms are not collected together, for example, the result might have a x/y+b x/y, while I need terms as (a+b) x/y, but using collect it will have terms like (ax+b)y etc. $\endgroup$ – an offer can't refuse Nov 23 '19 at 2:17
  • $\begingroup$ It does not happen on the example for me. You should give an example that is in fact an example of the problem you face. -- My first suggestion would be Collect, but I don't have an example to be able to know if that would work. $\endgroup$ – Michael E2 Nov 23 '19 at 3:16
  • 2
    $\begingroup$ Maybe Collect[#, x] & /@ Collect[u[x, y] u1[1/x, 1/y], y]? $\endgroup$ – Michael E2 Nov 23 '19 at 3:44
  • 1
    $\begingroup$ What about Collect[#, y] & /@ Collect[u[x, y] u1[1/x, 1/y], {x, y}] $\endgroup$ – Simon Woods Nov 23 '19 at 14:43
4
$\begingroup$

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}]

Mathematica graphics

|improve this answer|||||
$\endgroup$
2
$\begingroup$

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
    ]
   ]]
 ]

Mathematica graphics

|improve this answer|||||
$\endgroup$
2
$\begingroup$

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$

|improve this answer|||||
$\endgroup$
1
$\begingroup$

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 ;;]]]

result

|improve this answer|||||
$\endgroup$
1
$\begingroup$
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

enter image description here

expr == expr2 // Simplify

(* True *)
|improve this answer|||||
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.