13
$\begingroup$

Bug fixed in 10.0.0


In Mathematica 9.0.1, it appears that ToNumberField will not always recognize a Root object as an explicit algebraic number.

ToNumberField[
    Root[{ 1 - #1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6 &, 
           #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 - #1^3 #2^3 + #1^4 #2^3 
          - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &},  {6, 6}] ]
ToNumberField::nalg: 
"Root[{1 -#1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6&, 
        #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 -#1^3 #2^3 + #1^4 #2^3
       - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &}, {6,6}]
  is not an explicit algebraic number. >>"

A different root of the same polynomial works just fine:

ToNumberField[
    Root[{1 - #1 + #1^2 - #1^3 + #1^4 - #1^5 + #1^6 &, 
          #1^5 + #1^3 #2 + #1 #2^2 + #2^3 - #1 #2^3 + #1^2 #2^3 - #1^3 #2^3 + #1^4 #2^3 
          - #1^5 #2^3 - #1^4 #2^4 - #1^2 #2^5 - #2^6 &},  {6, 1}] ]
AlgebraicNumber[Root[1 + #1 + #1^2 + #1^3 + #1^4 + #1^5 + #1^6 &, 2], {0, 1, 0, 0, 0, 0}]

Is this a bug, and is there any way I can work around it?

Edit: In case it matters, that first Root expression will FullSimplify to 1.

$\endgroup$
1

1 Answer 1

17
$\begingroup$

This is caused by a bug in RootReduce for Root objects representing last coordinates of solutions of triangular systems. The bug affects cases where the last coordinate of the solution is real, but some of the other coordinates are not real. Thanks for pointing it out.

The problem can be fixed with the following patch (you can put it in your init.m file).

rootReduceFix[r:Root[fs_List, ks_List]] :=
   Module[{X, vars, polys, rts, nr, prec=20},
      vars = X /@ Range[ Length[fs]];
      polys = # @@ vars& /@ fs;
      res = Last[polys];
      Do[ res = Resultant[ res, polys[[i]], vars[[i]]];
          res = Times @@ (First /@ FactorSquareFreeList[res]),
          {i, Length[polys] - 1, 1, -1}];
      rts = Last[vars]/.Solve[ res==0, Last[vars]];
      While[ Length[rts] != 1,
             nr = N[r, prec];
             rts = Select[ rts, # - nr == 0&];
             prec*=2];
      First[rts]]

problemRootQ[r_] := Head[r] === Root && Length[r] == 2 && ListQ[r[[1]]] &&
   (Head[#] === Complex && Im[#] == 0 &[N[r]])

rootReduceFixFlag = True;

Unprotect /@ { RootReduce, ToNumberField};

RootReduce[e_] /; rootReduceFixFlag :=
   Block[{ rootReduceFixFlag=False},
      RootReduce[ e/.(r_?problemRootQ) :> rootReduceFix[r]]]

ToNumberField[args__] /; rootReduceFixFlag :=
   Block[{ rootReduceFixFlag = False},
      ToNumberField @@ ( {args}/.(r_?problemRootQ) :> rootReduceFix[r])]

Protect /@ { RootReduce, ToNumberField};
$\endgroup$
3
  • 1
    $\begingroup$ Thanks! I couldn't ask for a more helpful answer. $\endgroup$ Apr 25, 2013 at 1:36
  • $\begingroup$ For anyone else using this patch, getting it to work on parallel kernels requires this extra step. $\endgroup$ Apr 27, 2013 at 2:31
  • 1
    $\begingroup$ Maybe it would be better to surround this with If[$Version == 9, ...] to avoid trouble after any future upgrades (since users will likely keep their init.m but might forget about modifications). $\endgroup$
    – Szabolcs
    Dec 6, 2013 at 18:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.