Toglatti Surface

Author

Eric W. Weisstein
June 9, 2008

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

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

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

Equation

eqn[w_]:=64(x-w)(x^4-4x^3w-10x^2y^2-4x^2w^2+16x w^3-20x y^2w+5y^4+16w^4-20y^2w^2)-5Sqrt[5-Sqrt[5]](2z-Sqrt[5-Sqrt[5]]w)(4(x^2+y^2-z^2)+(1+3Sqrt[5])w^2)^2

eqn[1]

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

Plot

With[{r=6},
ContourPlot3D[eqn[1]==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->40,MaxRecursion->3]
]

With[{r=15},
ContourPlot3D[eqn[1]==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->30,MaxRecursion->3]]

Ordinary Double Points

(pts=SingularPoints[eqn[w],{x,y,z,w},WorkingPrecision->200])//N//Timing

Length[pts]

(pts=SingularPoints[eqn[1],{x,y,z},WorkingPrecision->200])//N//Timing

Length[pts]

RootApproximant[pts]