0
$\begingroup$

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.

$\endgroup$
5
  • $\begingroup$ 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. $\endgroup$ – MarcoB Nov 21 '19 at 22:07
  • $\begingroup$ @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. $\endgroup$ – azerbajdzan Nov 21 '19 at 22:11
  • $\begingroup$ 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. $\endgroup$ – MarcoB Nov 21 '19 at 22:16
  • $\begingroup$ 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. $\endgroup$ – azerbajdzan Nov 21 '19 at 22:23
  • 1
    $\begingroup$ What I got down votes for? $\endgroup$ – azerbajdzan Nov 21 '19 at 22:53
1
$\begingroup$

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  *)
$\endgroup$
3
  • $\begingroup$ 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. $\endgroup$ – azerbajdzan Nov 22 '19 at 1:01
  • $\begingroup$ @azerbajdzan Thanks. I had an extra DeleteCases[] from tweaking the code that I just got rid of. $\endgroup$ – Michael E2 Nov 22 '19 at 1:12
  • $\begingroup$ I found your method very clever. $\endgroup$ – azerbajdzan Nov 22 '19 at 1:25
1
$\begingroup$

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
$\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.