4
$\begingroup$

CoefficientRules acts like the following.

In[1]:= CoefficientRules[2 x^3 + 3 x^2 y + 4 x y^2 - 5 x + 1]
Out[1]= {{3, 0} -> 2, {2, 1} -> 3, {1, 2} -> 4, {1, 0} -> -5, {0, 0} -> 1}

My question is how one can "extend" this function so that it may allow the negative integer power of the variable as its input. In particular, I would like to obtain a function such that

In[2]:= function[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1]
Out[2]= {{3, 0} -> 2, {-2, 1} -> 3, {1, 2} -> 4, {0, -3} -> -5, {0, 0} -> 1}

instead of getting

In[3]:= CoefficientRules[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1]
Out[3]= {{0, 0} -> 1 + 2 x^3 - 5/y^3 + (3 y)/x^2 + 4 x y^2}

Could you answer for me?

$\endgroup$
3
$\begingroup$

This is my try that is something trick.

function[eq_] := CoefficientRules[eq /.
    Power[a_, b_?(# < 0 &)] -> Power[a, -10^10 b]] /.
  a_?(# > 10^9 &) -> -a/10^10

function[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1]

{{-2, 1} -> 3, {3, 0} -> 2, {1, 2} -> 4, {0, -3} -> -5, {0, 0} -> 1}

$\endgroup$
  • $\begingroup$ This trick is quite interesting and instructive for me. I sincerely thank you for your answer! $\endgroup$ – Seunghyeok Oct 13 '14 at 1:59
2
$\begingroup$

There is nice undocumented function

{c, v} = GroebnerBasis`DistributedTermsList[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1]
(* {{{{2, 0, 0, 1}, 3}, {{0, 3, 0, 0}, 2}, {{0, 1, 0, 2}, 
   4}, {{0, 0, 3, 0}, -5}, {{0, 0, 0, 0}, 1}}, {1/x, x, 1/y, y}} *)

Then one can simplify the result

Transpose@{Transpose[c[[All, 1]].Replace[v, {# -> 1, 1/# -> -1, _ -> 0}, 1] & /@ 
    Variables[v]], c[[All, 2]]}
(* {{{-2, 1}, 3}, {{3, 0}, 2}, {{1, 2}, 4}, {{0, -3}, -5}, {{0, 0}, 1}} *)
$\endgroup$
  • 1
    $\begingroup$ DistributedTermsList is getting a lot of playing time today. $\endgroup$ – Daniel Lichtblau Oct 13 '14 at 2:46
1
$\begingroup$

Nice to see how much one can do with Groebner bases. This a more elementary solution:

function[pol_] := Module[{vars, v, h, aux},
  vars = Variables[pol];
  v = Length[vars];
  h /: h[arg_]^p_ := h [p *arg];
  h /: h[arg1_] h[arg2_] := h[arg1 + arg2];
  (List @@ pol) /. 
    Table[vars[[n]] -> h[UnitVector[v, n]], {n, 1, v}] /.
       {c_. h[arg_] :> arg -> c, x_ /; NumericQ[x] && FreeQ[x, h] :> Table[0, {v}] -> x}
]

function[2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1]

(* {{0, 0} -> 1, {3, 0} -> 2, {0, -3} -> -5, {-2, 1} -> 3, {1, 2} -> 4} *)
$\endgroup$
  • $\begingroup$ DistributedTermsList lives in GroebnerBasis context but does not use GB in any way. It's actually a preprocessing function used by GB to put polynomials into a certain internal form. $\endgroup$ – Daniel Lichtblau Oct 13 '14 at 15:07
  • $\begingroup$ @Daniel Thank you for this remark. I did not look careful enough ... $\endgroup$ – Fred Simons Oct 13 '14 at 18:23
0
$\begingroup$
  fun[ex_] := Module[{v, p, m, mn, cp},
  v = Variables[ex];
  p = Cases[ex, Power[#, a_] :> a, Infinity] & /@ v;
  m = (Min /@ p);
  mn = (1 - Sign[#]) #/2 & /@ m;
  {If[Min[m] > 0, CoefficientRules[ex],
    cp = Times @@ MapThread[Power[#1, -#2] &, {v, mn}] ex;
    (#1 + mn -> #2) & @@@ CoefficientRules[Expand[cp], v]], v}
  ]

Testing:

exp = 2 x^3 + 3 x^(-2) y + 4 x y^2 - 5 y^(-3) + 1

then

fun[exp]

yields:

{{{3, 0} -> 2, {1, 2} -> 4, {0, 0} -> 1, {0, -3} -> -5, {-2, 1} -> 
   3}, {x, y}}

You can recover polynomial:

FromCoefficientRules@@fun[exp]

or if you wish to change variables:

FromCoefficientRules[First@fun[exp],{a,b}]

yielding: 1 + 2 a^3 - 5/b^3 + (3 b)/a^2 + 4 a b^2

Or

fun[3 + a^2 b^-3 + c^-3 d^3 + a^-2 b^2 d^3]

yields:

{{{2, -3, 0, 0} -> 1, {0, 0, 3, -3} -> 1, {0, 0, 0, 0} -> 
   3, {-2, 2, 3, 0} -> 1}, {a, b, d, c}}
$\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.