Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
add comment

1 Answer

up vote 15 down vote accepted

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};
share|improve this answer
1  
Thanks! I couldn't ask for a more helpful answer. –  Tobias Hagge Apr 25 '13 at 1:36
    
For anyone else using this patch, getting it to work on parallel kernels requires this extra step. –  Tobias Hagge Apr 27 '13 at 2:31
    
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). –  Szabolcs Dec 6 '13 at 18:51
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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