Sarti Dodecic

Author

Eric W. Weisstein
May 23, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Surfaces/SartiDodecic.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SartiDodecic.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Equation

(Subscript[Q, 12])=(x^2+y^2+z^2+w^2)^6;
(Subscript[S, 12])=33Sqrt[5]((Subscript[s, 23])[-1]+(Subscript[s, 34])[-1]+(Subscript[s, 42])[-1])+19((Subscript[s, 23])[+1]+(Subscript[s, 34])[+1]+(Subscript[s, 42])[+1])+10(Subscript[s, 234])-14(Subscript[s, 10])+2(Subscript[s, 11])-6(Subscript[s, 12])-352(Subscript[s, 51])+336(Subscript[l, 5])^2 (Subscript[l, 1])+48(Subscript[l, 2])(Subscript[l, 3])(Subscript[l, 4]);
(Subscript[l, 1])=x^4+y^4+z^4+w^4;
(Subscript[l, 2])=x^2y^2+z^2w^2;
(Subscript[l, 3])=x^2z^2+y^2w^2;
(Subscript[l, 4])=x^2w^2+y^2z^2;
(Subscript[l, 5])=x y z w;
(Subscript[s, 10])=(Subscript[l, 1])((Subscript[l, 2]) (Subscript[l, 3])+(Subscript[l, 2]) (Subscript[l, 4])+(Subscript[l, 3]) (Subscript[l, 4]));
(Subscript[s, 11])=(Subscript[l, 1])^2((Subscript[l, 2])+(Subscript[l, 3])+(Subscript[l, 4]));
(Subscript[s, 12])=(Subscript[l, 1])((Subscript[l, 2])^2+(Subscript[l, 3])^2+(Subscript[l, 4])^2);
(Subscript[s, 51])=(Subscript[l, 5])^2((Subscript[l, 2])+(Subscript[l, 3])+(Subscript[l, 4]));
(Subscript[s, 234])=(Subscript[l, 2])^3+(Subscript[l, 3])^3+(Subscript[l, 4])^3;
(Subscript[s, 23])[sgn_]:=(Subscript[l, 2])^2(Subscript[l, 3])+sgn  (Subscript[l, 2])(Subscript[l, 3])^2;
(Subscript[s, 34])[sgn_]:=(Subscript[l, 3])^2(Subscript[l, 4])+sgn  (Subscript[l, 3]) (Subscript[l, 4])^2;
(Subscript[s, 42])[sgn_]:=(Subscript[l, 4])^2(Subscript[l, 2])+sgn  (Subscript[l, 4]) (Subscript[l, 2])^2;
SartiW=243(Subscript[S, 12])-22(Subscript[Q, 12])

Sarti =SartiW/. w->1

Sarti=-22 (((1+(x^2)+(y^2)+(z^2)))^6)+243 (48 ((x^2) (y^2)+(z^2)) ((y^2)+(x^2) (z^2)) ((x^2)+(y^2) (z^2))-352 (x^2) (y^2) (z^2) ((x^2)+(y^2)+(x^2) (y^2)+(z^2)+(x^2) (z^2)+(y^2) (z^2))+336 (x^2) (y^2) (z^2) (1+(x^4)+(y^4)+(z^4))+2 ((x^2)+(y^2)+(x^2) (y^2)+(z^2)+(x^2) (z^2)+(y^2) (z^2)) (((1+(x^4)+(y^4)+(z^4)))^2)-14 (1+(x^4)+(y^4)+(z^4)) (((x^2) (y^2)+(z^2)) ((y^2)+(x^2) (z^2))+((x^2) (y^2)+(z^2)) ((x^2)+(y^2) (z^2))+((y^2)+(x^2) (z^2)) ((x^2)+(y^2) (z^2)))-6 (1+(x^4)+(y^4)+(z^4)) (((((x^2) (y^2)+(z^2)))^2)+((((y^2)+(x^2) (z^2)))^2)+((((x^2)+(y^2) (z^2)))^2))+33 (Sqrt[5]) (((((x^2) (y^2)+(z^2)))^2) ((y^2)+(x^2) (z^2))-((x^2) (y^2)+(z^2)) ((((y^2)+(x^2) (z^2)))^2)-((((x^2) (y^2)+(z^2)))^2) ((x^2)+(y^2) (z^2))+((((y^2)+(x^2) (z^2)))^2) ((x^2)+(y^2) (z^2))+((x^2) (y^2)+(z^2)) ((((x^2)+(y^2) (z^2)))^2)-((y^2)+(x^2) (z^2)) ((((x^2)+(y^2) (z^2)))^2))+19 (((((x^2) (y^2)+(z^2)))^2) ((y^2)+(x^2) (z^2))+((x^2) (y^2)+(z^2)) ((((y^2)+(x^2) (z^2)))^2)+((((x^2) (y^2)+(z^2)))^2) ((x^2)+(y^2) (z^2))+((((y^2)+(x^2) (z^2)))^2) ((x^2)+(y^2) (z^2))+((x^2) (y^2)+(z^2)) ((((x^2)+(y^2) (z^2)))^2)+((y^2)+(x^2) (z^2)) ((((x^2)+(y^2) (z^2)))^2))+10 (((((x^2) (y^2)+(z^2)))^3)+((((y^2)+(x^2) (z^2)))^3)+((((x^2)+(y^2) (z^2)))^3)));

AlgebraicDegree[Sarti,{x,y,z}]

POV

<<Utilities`PORay`

sarti=Simplify[POVCoefficients[Sarti//N,{x,y,z}]]

Plot

res=With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,Method->{"ShrinkWrap"->True}]];//Timing

res

res=With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,PlotPoints->10,MaxRecursion->1,Method->{"ShrinkWrap"->True}]];//Timing

res

res=With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,PlotPoints->5,MaxRecursion->2,Method->{"ShrinkWrap"->True}]];//Timing

res

res=With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,PlotPoints->10,MaxRecursion->2,Method->{"ShrinkWrap"->True}]];//Timing

res

With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,MaxRecursion->3,Method->{"ShrinkWrap"->True}]
];//Timing

res

res=With[{r=3},
ContourPlot3D[Sarti==0,{x,-r,r},{y,-r,r},{z,-r,r},
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,Mesh->None,MaxRecursion->4,Method->{"ShrinkWrap"->True}]
];//Timing

res

Singular Points

W-eqn

Length[nodes=SingularPoints[SartiW,{x,y,z,w},WorkingPrecision->200]]//Timing

Length[nodes=SingularPoints[SartiW,{x,y,z,w},WorkingPrecision->500]]//Timing

...ran overnight without returning...

Length[nodes=SingularPoints[SartiW,{x,y,z,w},WorkingPrecision->750]]//Timing

W==1

NSolve

Length[nodes=SingularPoints[Sarti,{x,y,z},WorkingPrecision->100]]//Timing

Length[nodes=SingularPoints[Sarti,{x,y,z},WorkingPrecision->200]]//Timing

Length[nodes=SingularPoints[Sarti,{x,y,z},WorkingPrecision->500]]//Timing

nodes

Select[nodes,Im[#]==0.{1,1,1}&]//Length

nodes

nodes[[200]]

RootApproximant[nodes//Chop]

GroebnerBasis Directly Attempt

eqns=Prepend[D[Sarti,#]&/@{x,y,z},Sarti];

GroebnerBasis[N[eqns,500],{x,y},z,MonomialOrder->EliminationOrder];//Timing

GroebnerBasis[N[eqns,750],{x,y},z,MonomialOrder->EliminationOrder];//Timing

GroebnerBasis[N[eqns,1000],{x,y},z,MonomialOrder->EliminationOrder]//Timing

GroebnerBasis[N[eqns,2000],{x,y},z,MonomialOrder->EliminationOrder]//Timing