17
$\begingroup$

Given a polynomial in $x,y$, I want to collect on $x,y$ and any products of these also. As given using Maple's collect with the distributed option.

Currently Mathematica will collect on $x$ then collect on $y$. But this is not what I want.

An example will explain. Given this

ClearAll["Global`*"]
eq = -x^6*y*c[5] + x^6*y*c[9] - x^5*y^2*c[4] + x^5*y^2*c[10] - 
  x^6*c[5] + x^6*c[9] - 2*x^5*y*c[4] + 2*x^5*y*c[10] + x^4*y^2*c[5] - 
  x^4*y^2*c[9] - x^5*c[4] - x^5*c[6] + x^5*c[8] + x^4*y*c[1] - 
  x^4*y*c[3] - 2*x^4*y*c[7] + 2*x^3*y^2*c[2] - 2*x^3*y^2*c[4] - 
  x^3*y^2*c[8] + x^2*y^3*c[3] - x*y^4*c[4] + x^4*c[1] - x^4*c[3] - 
  2*x^3*y*c[6] + 3*x^2*y^2*c[1] - 2*x^2*y^2*c[3] - y^4*c[3]

If I just collect on x,y this is the result

 Collect[eq,{x,y}]

Mathematica graphics

What I want is to collect on anything involving $x,y$ or products of these. This is what Maple's distributed option allows:

eq := -x^6*y*c[5] + x^6*y*c[9] - x^5*y^2*c[4] + x^5*y^2*c[10] - x^6*c[5] + x^6*c[9] 
 - 2*x^5*y*c[4] + 2*x^5*y*c[10] + x^4*y^2*c[5] - x^4*y^2*c[9] - x^5*c[4] - x^5*c[6] 
 + x^5*c[8] + x^4*y*c[1] - x^4*y*c[3] - 2*x^4*y*c[7] + 2*x^3*y^2*c[2] - 2*x^3*y^2*c[4] 
 - x^3*y^2*c[8] + x^2*y^3*c[3] - x*y^4*c[4] + x^4*c[1] - x^4*c[3] - 2*x^3*y*c[6] 
 + 3*x^2*y^2*c[1] - 2*x^2*y^2*c[3] - y^4*c[3];
 collect(eq,[x,y],distributed)

enter image description here

You see the difference. The reason I wanted this, is to be able to set equations of all coefficients of anything thing that has $x$ or $y$ in order to solve for the unknowns $c_i$. The output given by Maple makes this much easier.

Here is another example to make it more clear

ClearAll["Global`*"]
eq=(-x^3)*a[1] - x*y*a[1] - x^4*a[2] - 2*x^2*y*a[2] - y^2*a[2] + (-x^2 + y)*(a[0] + x*a[1] + y*a[2]) + x^3*b[1] + x*y*b[1] + x^2*b[2] - x*(b[0] + y*b[1] + x*b[2]) == 0
Collect[eq,{x,y}]

Mathematica graphics

Compare to

eq:=(-x^3)*a[1] - x*y*a[1] - x^4*a[2] - 2*x^2*y*a[2] - y^2*a[2] + (-x^2 + y)*(a[0] + x*a[1] + y*a[2]) + x^3*b[1] + x*y*b[1] + x^2*b[2] - x*(b[0] + y*b[1] + x*b[2]) = 0;
collect(eq,[x,y],distributed)

enter image description here

The question is: How to obtain the same output as Maple's in this case?

$\endgroup$
1
  • 1
    $\begingroup$ Thanks both for great answers, I wish I can accept both. $\endgroup$
    – Nasser
    Jul 29, 2023 at 9:27

4 Answers 4

17
$\begingroup$
CoefficientRules[eq, {x, y}] /. ({a_, b_} -> c_) :> c x^a y^b // Total

Generalize it to a function:

maplecollect[a_ == b_, varlst_List] := maplecollect[a - b, varlst] == 0
maplecollect[poly_, varlst_List] := 
 CoefficientRules[poly, varlst] /. (lhs_ -> rhs_) :> rhs Times @@ (varlst^lhs) // 
  Total    

eq = -x^6*y*c[5] + x^6*y*c[9] - x^5*y^2*c[4] + x^5*y^2*c[10] - x^6*c[5] + x^6*c[9] - 
   2*x^5*y*c[4] + 2*x^5*y*c[10] + x^4*y^2*c[5] - x^4*y^2*c[9] - x^5*c[4] - x^5*c[6] +
    x^5*c[8] + x^4*y*c[1] - x^4*y*c[3] - 2*x^4*y*c[7] + 2*x^3*y^2*c[2] - 
   2*x^3*y^2*c[4] - x^3*y^2*c[8] + x^2*y^3*c[3] - x*y^4*c[4] + x^4*c[1] - x^4*c[3] - 
   2*x^3*y*c[6] + 3*x^2*y^2*c[1] - 2*x^2*y^2*c[3] - y^4*c[3];

maplecollect[eq, {x, y}]
(* 
x^2 y^2 (3 c[1] - 2 c[3]) + x^4 (c[1] - c[3]) + x^2 y^3 c[3] - y^4 c[3] - 
 x y^4 c[4] - 2 x^3 y c[6] + x^4 y (c[1] - c[3] - 2 c[7]) + 
 x^3 y^2 (2 c[2] - 2 c[4] - c[8]) + x^5 (-c[4] - c[6] + c[8]) + 
 x^4 y^2 (c[5] - c[9]) + x^6 (-c[5] + c[9]) + x^6 y (-c[5] + c[9]) + 
 x^5 y^2 (-c[4] + c[10]) + x^5 y (-2 c[4] + 2 c[10]) *)
   
eq2 = (-x^3)*a[1] - x*y*a[1] - x^4*a[2] - 2*x^2*y*a[2] - 
    y^2*a[2] + (-x^2 + y)*(a[0] + x*a[1] + y*a[2]) + x^3*b[1] + x*y*b[1] + x^2*b[2] -
     x*(b[0] + y*b[1] + x*b[2]) == 0;

maplecollect[eq2, {x, y}]
(* -x^2 a[0] + y a[0] - x^4 a[2] - 3 x^2 y a[2] - x b[0] + 
  x^3 (-2 a[1] + b[1]) == 0 *)
$\endgroup$
11
$\begingroup$

Update 2:

An alternative way to define a function that works like Maple's collect using CoefficientRules + FromCoefficientRules:

collectLikeMaple = FromCoefficientRules[CoefficientRules@##, #2] &;

{collectLikeMaple[eq, {x, y}] == 
   Collect[eq, {x, y}, $distributed],
 (collectLikeMaple[First@SubtractSides@eq2, {x, y}] == 0) == 
  Collect[eq2, {x, y}, $distributed],
 collectLikeMaple[eq3, {x, y, z}] == 
  Collect[eq3, {x, y, z}, $distributed]}
 {True, True, True}

Alternatively, use TagSetDelayed to add an argument to Collect that makes it behave like Maple's collect:

ClearAll[doItLikeMappleDoes]
doItLikeMappleDoes /: 
 Collect[p_Plus, vl_List, h_ : Identity, doItLikeMappleDoes] := 
 FromCoefficientRules[MapAt[h, {All, 2}] @ CoefficientRules[p, vl], vl]

doItLikeMappleDoes /: 
 Collect[e_Equal, vl_List, h_ : Identity, doItLikeMappleDoes] := 
 Collect[First @ SubtractSides @ e, vl, h, doItLikeMappleDoes] == 0

Examples:

{Collect[eq, {x, y}, doItLikeMappleDoes] == 
  Collect[eq, {x, y}, $distributed],
 Collect[eq2, {x, y}, doItLikeMappleDoes] == 
  Collect[eq2, {x, y}, $distributed],
 Collect[eq3, {x, y, z}, Simplify, doItLikeMappleDoes] == 
  Collect[eq3, {x, y, z}, Simplify, $distributed]}
 {True, True, True}

Update:

Use TagSetDelayed to add an argument to Collect to make it behave like Maple collect

$distributed /: Collect[e_, vl_List, h___, $distributed] := 
 Collect[e, 
 {Splice @ MapApply[Times] @ Reverse @ Subsets[#, {2, Length @ #}],
  Splice @ #} & @ Map[#^_. &] @ vl, h]

Examples:

Collect[eq, {x, y}, $distributed] 

enter image description here

Collect[eq2, {x, y}, $distributed] 

enter image description here

eq3 = Expand[(a + b x + c y + d  z + e y x + y z + y^2)^2]

Collect[eq3, {x, y, z}, Simplify, $distributed]

enter image description here

Original answer:

Use a pattern in the second argument of Collect:

Collect[eq, {x^_. y^_., x^_., y^_.}]

![enter image description here

Collect[ExpandAll @ eq2, {x^_. y^_., x^_., y^_.}]

enter image description here

$\endgroup$
6
  • $\begingroup$ Thanks for the suggestion, but this does not produce the desired output all the time. For example, trying on the second example I gave, it gives this !Mathematica graphics which is not same as Maple's output. May be it could be modified to do so? $\endgroup$
    – Nasser
    Jul 29, 2023 at 8:26
  • $\begingroup$ I think your most recent update changed thing too much. Now it no longer matches Maple. What you had before seemed better, which is Collect[ExpandAll@eq, x^_. y^_.]. Here is screen shot showing the difference !Mathematica graphics $\endgroup$
    – Nasser
    Jul 29, 2023 at 8:40
  • 1
    $\begingroup$ @Nasser, please try the updated version. $\endgroup$
    – kglr
    Jul 29, 2023 at 8:49
  • $\begingroup$ Yes, much better version now. $\endgroup$
    – Nasser
    Jul 29, 2023 at 8:52
  • 1
    $\begingroup$ ExpandAll can be taken away :) . $\endgroup$
    – xzczd
    Jul 29, 2023 at 8:53
9
$\begingroup$

Another way:

Plus @@ MonomialList[eq, {x, y}]

(*
x^2 y^2 (3 c[1] - 2 c[3]) + x^4 (c[1] - c[3]) +
 x^2 y^3 c[3] - y^4 c[3] - x y^4 c[4] - 2 x^3 y c[6] +
 x^4 y (c[1] - c[3] - 2 c[7]) + x^3 y^2 (2 c[2] - 2 c[4] - c[8]) +
 x^5 (-c[4] - c[6] + c[8]) + x^4 y^2 (c[5] - c[9]) +
 x^6 (-c[5] + c[9]) + x^6 y (-c[5] + c[9]) +
 x^5 y^2 (-c[4] + c[10]) + x^5 y (-2 c[4] + 2 c[10])
*)

Or, 2nd OP's example, two solutions:

Plus @@ MonomialList[#, {x, y}] & /@ eq
Plus @@ MonomialList[Subtract @@ eq, {x, y}] == 0

(* both:
-x^2 a[0] + y a[0] - x^4 a[2] - 3 x^2 y a[2] - x b[0] + 
  x^3 (-2 a[1] + b[1]) == 0
*)
$\endgroup$
3
  • $\begingroup$ Total @ instead of Plus @@ depending on one's taste. (Not a packed array, so no big difference.) $\endgroup$
    – Michael E2
    Jul 29, 2023 at 23:11
  • 1
    $\begingroup$ Oh, I didn't know MonomialList collect the coefficient! (+1 of course. ) $\endgroup$
    – xzczd
    Jul 30, 2023 at 1:03
  • $\begingroup$ Simpler, nice! (+1) $\endgroup$ Jul 30, 2023 at 2:59
7
$\begingroup$

Another idea is to use a wrapper around the coefficients, and then expanding:

DistributedCollect[a_, b_, h_:Identity] := Activate @ Expand @ Collect[a, b, Inactive[h]]

Example:

eq:=-x^6*y*c[5]+x^6*y*c[9]-x^5*y^2*c[4]+x^5*y^2*c[10]-x^6*c[5]+x^6*c[9]-2*x^5*y*c[4]+2*x^5*y*c[10]+x^4*y^2*c[5]-x^4*y^2*c[9]-x^5*c[4]-x^5*c[6]+x^5*c[8]+x^4*y*c[1]-x^4*y*c[3]-2*x^4*y*c[7]+2*x^3*y^2*c[2]-2*x^3*y^2*c[4]-x^3*y^2*c[8]+x^2*y^3*c[3]-x*y^4*c[4]+x^4*c[1]-x^4*c[3]-2*x^3*y*c[6]+3*x^2*y^2*c[1]-2*x^2*y^2*c[3]-y^4*c[3];

DistributedCollect[eq, {x, y}]

x^2 y^2 (3 c[1] - 2 c[3]) + x^4 (c[1] - c[3]) + x^2 y^3 c[3] - y^4 c[3] - x y^4 c[4] - 2 x^3 y c[6] + x^4 y (c[1] - c[3] - 2 c[7]) + x^3 y^2 (2 c[2] - 2 c[4] - c[8]) + x^5 (-c[4] - c[6] + c[8]) + x^4 y^2 (c[5] - c[9]) + x^6 (-c[5] + c[9]) + x^6 y (-c[5] + c[9]) + x^5 y^2 (-c[4] + c[10]) + x^5 y (-2 c[4] + 2 c[10])

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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