# Simplifying polynomial in one variable by substitution

I want to simplify a polynomial in variable $$x$$ with integer coefficients by substitution $$x\to{x}/d$$ so that the coefficients become smallest possible integers.

Input:

pol = 80 - 96 x - 432 x^2;
co = Abs[CoefficientList[pol, x][[2 ;; -1]]]
d = Sqrt[GCD[co[[1]]^2,Times @@ (Power @@@ Select[FactorInteger[co[[2]]], #[[2]] > 1 &])]]
pol /. x -> x/d
Clear[pol, d]


Output:

12
80 - 8 x - 3 x^2


In the case above the biggest divisor is $$d=12$$ and by substitution $$x\to{x}/12$$ we get $$80 - 8 x - 3 x^2$$ from original $$80 - 96 x - 432 x^2$$.

I think my code is quite cumbersome. Can you come up with a better/simpler/shorter/more transparent code?

PS: My code works only for quadratic polynomial, but I know how to amend it to work for any polynomial, so do not concentrate on the fact that it works only for quadratic polynomial at the moment.

EDIT: I have just noticed that it does not work properly even for all quadratic polynomials.

• This is quite unclear to me. Can you describe how you arrived at the conclusion that the biggest divisor is 12 in your example above? Wouldn't division of the whole polynomial by the GCD of its coefficients make more sense? For instance, here pol/GCD @@ CoefficientList[pol, x] // Simplify returns 5 - 6 x - 27 x^2. Commented Nov 21, 2019 at 22:07
• @MarcoB: And what is your substitution then? You did not use any substitution, you simply divided all coefficients by GCD, but such a substitution does not exist that would produce your polynomial. Commented Nov 21, 2019 at 22:11
• Yes, I realize that mine is not a substitution, but I do not understand your process, which is why I am asking for you to clarify your needs. Commented Nov 21, 2019 at 22:16
• You get from $80 - 96 x - 432 x^2$ to $80 - 8 x - 3 x^2$ with substitution $x\to{x}/12$. Can you find any different number other than $12$ that would make the integer coefficients even smaller? No you cannot. - And this is what you have to find - the best possible number $d$ used in substitution. Commented Nov 21, 2019 at 22:23
• What I got down votes for? Commented Nov 21, 2019 at 22:53

Another approach:

sub[poly_, x_] := Module[{cc, reduced, d},
cc = Abs@Rest@CoefficientList[poly, x];
reduced =
DeleteCases[Except[_Integer]] /@ (cc^(1/Range[Length@cc]));
d = GCD @@ reduced;
x -> x/d
];


Examples:

pol /. sub[pol, x]
(*  80 - 8 x - 3 x^2  *)

pol2 = 145 + 5556600 x + 28991671632 x^2 +
57456600591796875000000 x^3 + 12155062500000000 x^4;
pol2 /. sub[pol2, x]
(*  145 + 66150 x + 4108797 x^2 + 96939788818359375 x^3 + 244140625 x^4  *)

• I vote up. Looks simpler than mine and does not even need FactorInteger. The task seems to be simple and I hoped for simple one-line code. But it turns out it is not so simple. I will test your code and if it is OK and I get no other simpler answers I will accept yours answer. Commented Nov 22, 2019 at 1:01
• @azerbajdzan Thanks. I had an extra DeleteCases[] from tweaking the code that I just got rid of. Commented Nov 22, 2019 at 1:12
• I found your method very clever. Commented Nov 22, 2019 at 1:25

This seems to work correctly:

subsimp[pol_] := Module[{co, pr, ex, d},
co = Abs[CoefficientList[pol, x][[2 ;; -1]]];
pr = Intersection @@ (FactorInteger[#][[All, 1]] & /@ co);
ex = Min /@
Transpose[
Quotient[IntegerExponent[Coefficient[pol, x, #], pr], #] & /@
Range[Length[co]]];
d = Times @@ (Power @@@ Transpose[{pr, ex}]);
{pol, x -> x/d, pol /. x -> x/d}
]


Input:

subsimp[80 - 96 x - 432 x^2]
(%[[1]] /. %[[2]]) == %[[3]]
subsimp[1 + 12000 x + 378000 x^2]
(%[[1]] /. %[[2]]) == %[[3]]
subsimp[145 + 5556600 x + 28991671632 x^2 + 57456600591796875000000 x^3 + 12155062500000000 x^4]
(%[[1]] /. %[[2]]) == %[[3]]


Output:

{80 - 96 x - 432 x^2, x -> x/12, 80 - 8 x - 3 x^2}
True
{1 + 12000 x + 378000 x^2, x -> x/60, 1 + 200 x + 105 x^2}
True
{145 + 5556600 x + 28991671632 x^2 + 57456600591796875000000 x^3 + 12155062500000000 x^4, x -> x/84,
145 + 66150 x + 4108797 x^2 + 96939788818359375 x^3 + 244140625 x^4}
True