Message Boards Message Boards

GROUPS:

Order of the variables in a polynomial?

Posted 1 year ago
1468 Views
|
14 Replies
|
0 Total Likes
|

Hello! I have this code

K[Q_, n_Integer] := 
 Module[{z, x}, 
  SymmetricReduction[
    SeriesCoefficient[
     Product[ComposeSeries[Series[Q[z], {z, 0, n}], 
       Series[x[i] z, {z, 0, n}]], {i, 1, n}], n], 
    Table[x[i], {i, 1, n}], Table[Subscript[c, i], {i, 1, n}]][[1]]]

primeFactorForm[n_] := 
  If[Length@# == 1, First@#, CenterDot @@ #] &[
   Superscript @@@ FactorInteger[n]];

string = StringJoin[
  Riffle[Table[poly = K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p; 
    gcd = GCD @@ List @@ poly /. Rational[n_, d_]*c_ :> d;
    ToString[
     Inactive[Set][Subscript[L, i], 
      1/primeFactorForm[gcd]*Plus @@ List @@ Distribute[gcd*poly] /. 
        Times[Rational[n_, d_], e__] :> 
         RowBox[{primeFactorForm[n]/primeFactorForm[d], e}] /. 
       x_ :> TraditionalForm@
         DisplayForm@
          RowBox[{1/Denominator[x], "(", Numerator[x], ")"}]], 
     TeXForm], {i, 3, 7}], "\\\\"]]
CopyToClipboard[string]

which gives an output like this: $L_3=\frac{1}{3^3\cdot 5^1\cdot 7^1}(2 p_1^3-13 p_2 p_1+62 p_3)\\L_4=\frac{1}{3^3\cdot 5^2\cdot 7^1}(-p_1^4+\frac{-1^1\cdot 19^1}{3^1}p_2^2+\frac{-1^1\cdot 71^1}{3^1}p_1p_3+\frac{2^1\cdot 11^1}{3^1}p_1^2p_2+127 p_4)\\L_5=\frac{1}{3^4\cdot 5^1\cdot 11^1}(\frac{2^1}{3^1\cdot 7^1}p_1^5+\frac{2^1\cdot 73^1}{3^1}p_5+\frac{-1^1\cdot 83^1}{3^1\cdot 5^1\cdot 7^1}p_1^3p_2+\frac{-1^1\cdot 919^1}{3^1\cdot 5^1\cdot 7^1}p_1p_4+\frac{-1^1\cdot 2^4}{5^1}p_2p_3+\frac{79^1}{5^1\cdot 7^1}p_1^2p_3+\frac{127^1}{3^1\cdot 5^1\cdot 7^1}p_1p_2^2)\\L_6=\frac{1}{3^5\cdot 5^2\cdot 7^2\cdot 11^1\cdot 13^1}(\frac{-1^1\cdot 2^1\cdot 691^1}{3^1\cdot 5^1}p_1^6+\frac{-1^1\cdot 167^1\cdot 241^1}{3^1\cdot 5^1}p_3^2+\frac{2^1\cdot 23^1\cdot 89^1\cdot 691^1}{3^1\cdot 5^1}p_6+\frac{2^1\cdot 1453^1}{5^1}p_2^3+\frac{-1^1\cdot 33863^1}{3^1\cdot 5^1}p_1^3p_3+\frac{-1^1\cdot 159287^1}{3^1\cdot 5^1}p_2p_4+\frac{2^1\cdot 6421^1}{3^1\cdot 5^1}p_1^4p_2+\frac{-1^1\cdot 5527^1}{3^1}p_1^2p_2^2+\frac{-1^1\cdot 2^5\cdot 29^1\cdot 181^1}{5^1}p_1p_5+\frac{40841^1}{5^1}p_1^2p_4+\frac{83^1\cdot 349^1}{5^1}p_1p_2p_3)\\L_7=\frac{1}{3^2\cdot 5^1\cdot 7^1\cdot 13^1}(\frac{2^2\cdot 8191^1}{3^4\cdot 5^1\cdot 11^1}p_7+\frac{2^2}{3^4\cdot 5^1\cdot 11^1}p_1^7+\frac{-1^1\cdot 2^1\cdot 23^2}{3^5\cdot 11^1}p_2p_5+\frac{-1^1\cdot 2^1\cdot 113^1}{3^4\cdot 5^1\cdot 7^1}p_1^3p_4+\frac{2^4\cdot 277^1}{3^4\cdot 5^2\cdot 7^1}p_1^2p_5+\frac{-1^1\cdot 2^1\cdot 97^1\cdot 107^1}{3^4\cdot 5^2\cdot 7^1\cdot 11^1}p_3p_4+\frac{2^3\cdot 2087^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_2^2p_3+\frac{-1^1\cdot 2^1\cdot 2161^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_1^5p_2+\frac{-1^1\cdot 2^1\cdot 3989^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_1p_2^3+\frac{-1^1\cdot 2^1\cdot 305633^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_1p_6+\frac{2^2}{5^2\cdot 7^1}p_1^4p_3+\frac{2^3}{3^2\cdot 5^1\cdot 7^1}p_1^3p_2^2+\frac{22027^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_1p_3^2+\frac{-1^1\cdot 39341^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}p_1^2p_2p_3+\frac{1399^1}{3^3\cdot 5^2\cdot 11^1}p_1p_2p_4)$ $

Is there a way to organize the variables in a more intuitive way? For example in the $L_7$ the term $p_7$ comes before $p_1$ and stuff like this happens more often the more terms I have. In general the order is not consistent. I tried some basic grouping/factorizing commands, but they don't seem to work (or I don't place them in the right place). Can someone help me with this? Thank you!

14 Replies

You can give your ordering to the polynomials by using MonomialList instead of List@@:

poly = MonomialList[K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p, 
  Table[Subscript[p, i], {i, 1, 7}], "NegativeLexicographic"];
gcd = GCD @@ poly /. Rational[n_, d_]*c_ :> d;

For example here I have inserted the "NegativeLexicographic" ordering, but there are many others. There is a tutorial on PolynomialOrderings in the documentation.

Thank you for your reply. I tried this (and different parameters instead of "NegativeLexicographic") but it doesn't change anything in the order. I replaced this

poly = K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p; 
gcd = GCD @@ List @@ poly /. Rational[n_, d_]*c_ :> d;

by this

poly = MonomialList[K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p, 
  Table[Subscript[p, i], {i, 1, 7}], "NegativeLexicographic"];
gcd = GCD @@ poly /. Rational[n_, d_]*c_ :> d;

Is there anything else I should do for the change in ordering to take place?

Just to make it clear, what you said does what I want when I apply it to one polynomial at a time, but it fails when I use it (as mentioned above) in the for loop.

Just to make it clear, what you said does what I want when I apply it to one polynomial at a time, but it fails when I use it (as mentioned above) in the for loop.

There was a Plus that rearranged everything. Try this:

Manipulate[
 Table[
  poly = MonomialList[K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p, 
    Table[Subscript[p, k], {k, 1, 7}], order]; 
  gcd = GCD @@ poly /. Rational[n_, d_]*c_ :> d;
  DisplayForm@
   RowBox[{1/primeFactorForm[gcd], "(", 
     RowBox[(List @@ 
          Distribute[gcd*poly]) /. {Times[Rational[n_, d_], e__] :> 
          RowBox[{If[n/d > 0, "+", "-"], 
            primeFactorForm[Abs@n]/primeFactorForm[Abs@d], e}],
         Times[n_Integer, e__] :> 
          RowBox[{If[n > 0, "+", "-"], primeFactorForm[Abs@n], 
            e}]} /. {"+", a___} :> {a}], ")"}], {i, 3, 7}],
 {order, {"Lexicographic", "DegreeLexicographic", 
   "DegreeReverseLexicographic", "NegativeLexicographic", 
   "NegativeDegreeLexicographic", 
   "NegativeDegreeReverseLexicographic"}}]

Thank you for this! It looks perfect, but I am not sure how to bring it back to Latex form (and add the $L_6 = $ part). The output is directed latex formatted, but I need it to be Latex code...

With[{order = "Lexicographic"}, 
 StringJoin[
  Riffle[Table[
    poly = MonomialList[K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p, 
      Table[Subscript[p, k], {k, 1, 7}], order]; 
    gcd = GCD @@ poly /. Rational[n_, d_]*c_ :> d;
    ToString[
     Inactive[Set][Subscript[L, i], 
      DisplayForm@
       RowBox[{1/primeFactorForm[gcd], "(", 
         RowBox[(List @@ 
              Distribute[gcd*poly]) /. {Times[Rational[n_, d_], 
               e__] :> 
              RowBox[{If[n/d > 0, "+", "-"], 
                primeFactorForm[Abs@n]/primeFactorForm[Abs@d], e}], 
             Times[n_Integer, e__] :> 
              RowBox[{If[n > 0, "+", "-"], primeFactorForm[Abs@n], 
                e}]} /. {"+", a___} :> {a}], ")"}]], TeXForm], {i, 3, 
     7}], "\\\\"]]]

Thank you so so much! You are amazing! Out of curiosity, did you figure it out based on experience, or is there a place where I can learn these "formatting" things? It seems that you changed the structure of the code (keeping most of the elements there) quite a lot, in a non-trivial way and I was wondering if I would have had any chance to do it (or for the future) in a reasonable amount of time on my own.

Perhaps there was too much nesting. Try this variation with fo:

With[{order = "Lexicographic"}, 
 StringJoin[
  Riffle[Table[
    poly = MonomialList[K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p, 
      Table[Subscript[p, k], {k, 1, 7}], order];
    gcd = GCD @@ poly /. Rational[n_, d_]*c_ :> d;
    ToString[
     Inactive[Set][Subscript[L, i], 
      DisplayForm@
       RowBox[{1/primeFactorForm[gcd], "(", 
         RowBox[Flatten[(List @@ 
               Distribute[gcd*poly]) /. {Times[Rational[n_, d_], 
                e__] :> {If[n/d > 0, "+", "-"], 
                primeFactorForm[Abs@n]/primeFactorForm[Abs@d], e}, 
              Times[n_Integer, e__] :> {If[n > 0, "+", "-"], 
                primeFactorForm[Abs@n], e}}] /. {"+", a___} :> {a}], 
         ")"}]], TeXForm],
    {i, 3, 7}],
   "\\\\"]]]

Over my 25+ years of usage I have learned a fair number of tricks. Unfortunately, the precise formatting of expressions is not easy in Mathematica. As a gateway into the subject, I would suggest the documentation on RowBox. Don't forget to wrap everything into DisplayForm. An occasional peek into CellExpression may give clues on low-level box structures.

One more thing... would it be possible to remove the powers of 1 (stuff like $3^1$ to be just $3$)? Or if not, at least to remove $1^1$ completely? Thank you!

I have a small issue with the code, if I have a term that should look like: $p_1^2+p_2$ the output is $p_1^2p_2$. And for all the cases where I should have something of the form $a+1b$ it becomes $ab$. If I have a minus sign, or the factor before b is not 1, it works fine. Do you know how can I fix this?

One more thing... would it be possible to remove the powers of 1 (stuff like $3^1$ to be just $3$)? Or if not, at least to remove $1^1$ completely? Thank you!

You can remove the powers with exponent 1 with a change in primeFactorFor:

primeFactorForm[n_] := 
  If[Length@# == 1, First@#, CenterDot @@ #] &[
   Superscript @@@ FactorInteger[n] /. Superscript[a_, 1] :> a];

Order of the variables in a polynomial?

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract