5
$\begingroup$

I have several polynomials in 2 variables with integer coefficients, e.g.,

poly= -10 x - 10240 y^3 - 1520 x y^4;

I'd like to convert all such polynomials into a form in which the coefficients have been factored into prime factors. So the above example would become

polyf= -2 5 x - 2^11 5 y^3 - 2^4 5 19 x y^4;

I can do this case by case, by using

FactorInteger

but it is inefficient for a large collection of polynomials. So I did some searching and found that a possible solution is to use

cpoly = FactorInteger[GroebnerBasis`DistributedTermsList[poly, , {x, y}][[1, All, -1]]];

The output is

{{{-1, 1}, {2, 4}, {5, 1}, {19, 1}}, {{-1, 1}, {2, 1}, {5, 1}}, {{-1, 1}, {2, 11}, {5, 1}}}

But I can't work out how to thread this back to give me the answer I wanted. Ideas like

poly x^Range[0, Exponent[poly, x]] y^Range[0, Exponent[poly, y]]

don't give the results I wanted. Instead they lead to

(-10 x - 10240 y^3 - 1520 x y^4) {1, x} {1, y, y^2, y^3, y^4}

What am I doing wrong?

$\endgroup$
  • $\begingroup$ I have developed an better alternative code you may be interested in. I added it to my original answer. $\endgroup$ – Somos Mar 25 at 15:52
6
$\begingroup$

You could create a factoredForm wrapper that formats integers as desired:

MakeBoxes[factoredForm[e_], StandardForm] := Block[{$Factored=True},
    MakeBoxes[e]
]

Unprotect[Integer];

MakeBoxes[i_Integer, form_] /; $Factored := Block[{$Factored},
    TemplateBox[
        {RowBox[tosuperscript /@ FactorInteger[i]], MakeBoxes[i]},
        "FactoredInteger",
        DisplayFunction->(#1&),
        InterpretationFunction->(#2&)
    ]
]

tosuperscript[{-1, 1}] := "-"
tosuperscript[{a_, 1}] := MakeBoxes[a]
tosuperscript[{a_, b_}] := MakeBoxes[a^b]

Unprotect[Power];

MakeBoxes[Power[a_, i_Integer], StandardForm] /; $Factored := With[
    {exp = Block[{$Factored}, RawBoxes @ MakeBoxes[i]]},
    MakeBoxes[Power[a, exp]]
]

Protect[Integer, Power];

Some examples:

-10 x - 10240 y^3 - 1520 x y^4 //factoredForm

-25 x-2^11 5 y^3-2^4 519 x y^4

 (21 x^10 + 35 x^4 y^12)(-10 x - 10240 y^3 - 1520 x y^4) //factoredForm

(-25 x-2^11 5 y^3-2^4 519 x y^4) (37 x^10+57 x^4 y^12)

25 y (20 + 160 x^4 y^4 + 5 x^6 y^5) //factoredForm

enter image description here

$\endgroup$
  • $\begingroup$ Wow. This is wonderful. It overcomes the problem in the second example I provided above. And, most wonderfully, it also works for 3 variable polynomials: (-25 y + 16 z)(-10 x - 10240 y^3 - 1520 x y^4) gives the desired answer (which I can't seem to cut and paste here). Thank you so much! $\endgroup$ – S. Kowalevsky Mar 23 at 21:37
  • $\begingroup$ Although I've used Mathematica for a long time, it's clear to me that I'm a very naive user of it. Can you recommend references that progresses to a level of technical knowledge on how to write such wrappers? $\endgroup$ – S. Kowalevsky Mar 23 at 23:35
3
$\begingroup$

Another simple solution is to use pattern matching to find all the integer coefficients, FactorInteger them, and then reassemble the number but using an Inactive version of Power which doesn't evaluate.

InactiveFactorization[i_] := Inactive[Times] @@ (Inactive[Power] @@@ FactorInteger[i])
factorpolycoeffs = {
  i_Integer?Positive (e : x_Symbol^y_Integer | x_Symbol) :> InactiveFactorization[i] e,
  i_Integer?Negative (e : x_Symbol^y_Integer | x_Symbol) :> -InactiveFactorization[-i] e
}
cleanupprimepowers = {Inactive[Power][x_Integer, 1] -> x}

Here we explicitly address the positive and negative case to avoid an uglier factorization of negative coefficients and zeros by FactorInteger. Now we can use these rules to factor our

poly = -10 x - 10240 y^3 - 1520 x y^4;

(poly /. factorpolycoeffs)
% /. cleanupprimepowers

-x 2^1 5^1-y^3 2^11 5^1-x y^4 2^4 5^1 19^1

-x (2*5)-y^3 (2^11*5)-x y^4 (2^4*5*19)

We can Activate the Power and Times terms in the expression to let the kernel resolve the expression to the original poly

Activate[%]

-10 x-10240 y^3-1520 x y^4

Edit I added a second rule to simplify prime powers of one to make the result more readable which also required to Inactiveate Times, too.

$\endgroup$
  • $\begingroup$ Unfortunately, the answer is not quite what I needed. For example, the first term should be -2*5 x rather than -10 x. But thank you. $\endgroup$ – S. Kowalevsky Mar 23 at 21:54
  • $\begingroup$ Oh, true! Thanks for pointing that out. Didn't think about the case where there are prime powers of one. I edited my answer and fixed that case! $\endgroup$ – Thies Heidecke Mar 23 at 23:22
  • $\begingroup$ Thanks for the fast response... Unfortunately, I think I prefer the factored coefficients to come before the variables, so that I can easily convert to LaTeX output, but this is useful. $\endgroup$ – S. Kowalevsky Mar 23 at 23:33
  • $\begingroup$ I understand, no worries! I just thought this method isn't covered by the other answers and simple enough that it might be the easiest solution in some situations. $\endgroup$ – Thies Heidecke Mar 23 at 23:42
2
$\begingroup$

The following functions using Rule[] and Interpretation[]:

fi[n_] := Times @@ (FactorInteger[n] /. {
  List[-1, 1] -> -1, 
  List[p_Integer, 1] :> Interpretation[ToString[p], p], 
  List[p_Integer, q_Integer] :> 
    Interpretation[ToString[p]^q, p^q]});
do[e_] := e /. {x_. n_Integer :> x fi[n],
             x_^y_. n_Integer :> x^y fi[n]};

used in an example code

 do[ (21 x^10 +35 x^4 y^12)(-10 x -10240 y^3 -1520 x y^4) ]

returns something very close to what you want.

The downside is that the numerical factored coefficients come after the powered variables and not before.There may be a way to fix that but I don't see it now. The advantage of using Interpretation[] is that you can copy/paste the resulting output and it evaluates the same as the original polynomial.

NEW:

I developed an alternate approach which does a much better job.

fi[n_Integer] := Sign[n] With[{fl = FactorInteger@Abs@n}, fl /.
   {List[1, 1] -> 1, List[p_Integer, 1] :> ToString[p], 
   List[p_Integer, q_Integer] :> (ToString[p])^q} /.
   {List[x_] :> x, List[x__] :> Inactive@Times@x}];
do[ex_] := Activate //@ (x_^n_Integer :> x^n, 
   n_Integer :> fi[n], n_Integer* x_. :> fi[n] x});

For example:

do[(21 x^10 +35 x^4 y^12) (-10 x -10240 y^3 -1520 x y^4)] // TeXForm

returns the result

\left(-19 2^4 5 x y^4+2^{11} (-5) y^3-2 5 x\right) \left(3 7 x^{10}+5 7 x^4 y^{12}\right)

which exposes a "misfeature" of TeXForm[]. For exmaple: TeXForm[-1-x^2 z] returns "x^2 (-z)-1".

The new code only requires Activate[], Inactive[] and a tweaked fi[]. It avoids the downside in the original method. It avoids the need to add rules to system objects Power and Integer which has global scope.

$\endgroup$
  • $\begingroup$ This is a fantastic start. Thank you $\endgroup$ – S. Kowalevsky Mar 23 at 4:46
  • $\begingroup$ Unfortunately, this solution doesn't seem to work when poly is a factored polynomial containing only one variable. E.g., 25 y (20 + 160 x^4 y^4 + 5 x^6 y^5) is transformed to y (20 + 160 x^4 y^4 + 5 x^6 y^5) 5^2. So the coefficient of the first factor is expressed in terms of its prime factors but the next factor is not. $\endgroup$ – S. Kowalevsky Mar 23 at 5:06
  • $\begingroup$ Thank you for responding to my comment. I agree it works now and it also extends to more variables. (I tried (-25 y + 16 z)*(-10 x - 10240 y^3 - 1520 x y^4).) I think I prefer the factored coefficients to come before the variables, so that I can easily convert to LaTeX output, but thank you anyway. $\endgroup$ – S. Kowalevsky Mar 23 at 21:50
1
$\begingroup$

If you are willing to use GroebnerBasis`DistributedTermsList[] even if it's undocumented, there's a way to get what you want:

poly = -2 5 x - 2^11 5 y^3 - 2^4 5 19 x y^4; vars = {x, y};

tl = GroebnerBasis`DistributedTermsList[poly, vars]
   {{{{1, 4}, -1520}, {{1, 0}, -10}, {{0, 3}, -10240}}, {x, y}}

The first list is a list of pairs, corresponding to the powers of your variables and their corresponding coefficients. That's what you want.

tl = MapAt[FactorInteger, First[tl], {All, 2}];

Now that you have factored the coefficients, we need a little helper:

myPower[a_, b_] := 
  Which[a === -1, a, b === 0, 1, b === 1, HoldForm[a], True, Power[HoldForm[a], HoldForm[b]]]

after which,

expr = Total[(Times @@ (myPower @@@ Last[#])) Inner[myPower, vars, First[#], Times] & /@ tl]

should yield something like what you want. To turn it back to normal, just evaluate ReleaseHold[expr] and you can check that it's the same as poly.

$\endgroup$
  • $\begingroup$ Instead of the undocumented GroebnerBasis`DistributedTermsList you can use CoefficientRules which gives the same information. $\endgroup$ – Roman Mar 23 at 14:25
  • $\begingroup$ @J. M. is slightly pensive♦ Your last command leads to Total::normal: Nonatomic expression expected at position 1 in Total[alist]. How should I overcome this? $\endgroup$ – S. Kowalevsky Mar 23 at 22:04
  • $\begingroup$ @S.Kowalevsky sorry, I forgot to change variable names; try now $\endgroup$ – J. M. is away Mar 24 at 1:27
1
$\begingroup$

If it's just for display purposes, you could define something like

fi[z_Integer /; z > 0] := Times @@ Subscript @@@ FactorInteger[z]
fi[z_Integer /; z < 0] := -fi[-z]
fi[1] = 1;

Inert mechanisms other than Subscript could be used for this purpose. The last definition fi[1] = 1 is a matter of taste, to make terms like x^3 become $x^3$ instead of $1_1x^3$.

Apply it to the coefficients of a polynomial poly in variables vars

poly = -10 x - 10240 y^3 - 1520 x y^4;
vars = {x, y};

with

polyf = Total[CoefficientRules[poly, vars] /. (p_ -> z_) :> fi[z] Times @@ (vars^p)]

$$ -x 2_1 \times 5_1-y^3 2_{11} \times 5_1-x y^4 2_4 \times 5_1 \times 19_1 $$

You turn polyf back into the original polynomial with

polyf /. Subscript -> Power
(* -10 x - 10240 y^3 - 1520 x y^4 *)

This method can be used with @Somos's fi function as well if it suits you better.


You can also go straight to $\LaTeX$ output and bypass the Mathematica typesetting step:

stringify1[{x_, 0}] = Nothing;
stringify1[{x_, 1}] := ToString[x];
stringify1[{x_, n_}] := ToString[x] <> "^{" <> ToString[n] <> "}";
stringify[L_] := StringRiffle[stringify1 /@ L, sep]

texints[n_Integer /; n > 0] := "+" <> stringify[FactorInteger[n]]
texints[n_Integer /; n < 0] := "-" <> stringify[FactorInteger[-n]]

texpowers[p_] := stringify[Transpose[{vars, p}]]

texterm[p_, c_] /; DeleteDuplicates[p] == {0} = texints[c];
texterm[p_, 1] := "+" <> texpowers[p];
texterm[p_, c_] := texints[c] <> sep <> texpowers[p];

maketex[poly_, vars1_, sep1_: " \\, "] := 
  Block[{vars = vars1, sep = sep1}, 
    StringTrim[StringJoin[CoefficientRules[poly] /. Rule -> texterm], "+"]]

Try it out with your test polynomial:

maketex[-10 x - 10240 y^3 - 1520 x y^4, {x, y}]

-2^{4} \, 5 \, 19 \, x \, y^{4}-2 \, 5 \, x-2^{11} \, 5 \, y^{3}

$$ -2^{4} \, 5 \, 19 \, x \, y^{4}-2 \, 5 \, x-2^{11} \, 5 \, y^{3} $$

Same with a dot between all terms:

maketex[-10 x - 10240 y^3 - 1520 x y^4, {x, y}, " \\cdot "]

-2^{4} \cdot 5 \cdot 19 \cdot x \cdot y^{4}-2 \cdot 5 \cdot x-2^{11} \cdot 5 \cdot y^{3}

$$ -2^{4} \cdot 5 \cdot 19 \cdot x \cdot y^{4}-2 \cdot 5 \cdot x-2^{11} \cdot 5 \cdot y^{3} $$

A three-variable polynomial as a demo:

maketex[(a + 2 b + 3 c - 1)^3, {a, b, c}, " \\cdot "]

a^{3}+2 \cdot 3 \cdot a^{2} \cdot b+3^{2} \cdot a^{2} \cdot c-3 \cdot a^{2}+2^{2} \cdot 3 \cdot a \cdot b^{2}+2^{2} \cdot 3^{2} \cdot a \cdot b \cdot c-2^{2} \cdot 3 \cdot a \cdot b+3^{3} \cdot a \cdot c^{2}-2 \cdot 3^{2} \cdot a \cdot c+3 \cdot a+2^{3} \cdot b^{3}+2^{2} \cdot 3^{2} \cdot b^{2} \cdot c-2^{2} \cdot 3 \cdot b^{2}+2 \cdot 3^{3} \cdot b \cdot c^{2}-2^{2} \cdot 3^{2} \cdot b \cdot c+2 \cdot 3 \cdot b+3^{3} \cdot c^{3}-3^{3} \cdot c^{2}+3^{2} \cdot c-1

$$ a^{3}+2 \cdot 3 \cdot a^{2} \cdot b+3^{2} \cdot a^{2} \cdot c-3 \cdot a^{2}+2^{2} \cdot 3 \cdot a \cdot b^{2}+2^{2} \cdot 3^{2} \cdot a \cdot b \cdot c-2^{2} \cdot 3 \cdot a \cdot b+3^{3} \cdot a \cdot c^{2}-2 \cdot 3^{2} \cdot a \cdot c+3 \cdot a+2^{3} \cdot b^{3}+2^{2} \cdot 3^{2} \cdot b^{2} \cdot c-2^{2} \cdot 3 \cdot b^{2}+2 \cdot 3^{3} \cdot b \cdot c^{2}-2^{2} \cdot 3^{2} \cdot b \cdot c+2 \cdot 3 \cdot b+3^{3} \cdot c^{3}-3^{3} \cdot c^{2}+3^{2} \cdot c-1 $$

$\endgroup$
  • $\begingroup$ Thank you for your answer. As I said in a comment on @Somos' answer, I would like output that I can convert easily to LaTeX form and two issues arise with the output form in your answer: (i) the subscripts have to be converted to superscripts (ii) the coefficients come after the monomials. $\endgroup$ – S. Kowalevsky Mar 23 at 22:42
  • $\begingroup$ If you want to convert to LaTeX at the end, then maybe you'd be better off writing a function that generates LaTeX code directly, instead of generating Mathematica output and using TeXForm on it. $\endgroup$ – Roman Mar 24 at 10:50
  • $\begingroup$ True. But I like eyeballing it first. $\endgroup$ – S. Kowalevsky Mar 24 at 22:31

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.