Nordstrand's Weird Surface

Author

Eric W. Weisstein
August 24, 2016

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

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

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

Equation

eqn=25(x^3 (y+z)+y^3 (x+z)+z^3 (x+y))+50(x^2 y^2+x^2 z^2+y^2 z^2)-125(x^2 y z+y^2 x z+z^2 x y)+60 x y z-4(x y+x z+y z);

Expand[eqn]

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

Graphic

V5

<<Graphics`ContourPlot3D`

With[{r=5},
ContourPlot3D[eqn,{x,-r,r},{y,-r,r},{z,-r,r},PlotPoints->6]
]//Timing

V6

With[{r=1},ContourPlot3D[eqn==0,{x,-r,r},{y,-r,r},{z,-r,r},RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,MaxRecursion->5,PlotPoints->40,Mesh->False]]

With[{r=4},ContourPlot3D[eqn==0,{x,-r,r},{y,-r,r},{z,-r,r},Boxed->False,
RegionFunction->(#1^2+#2^2+#3^2<r^2&),Axes->False,
MaxRecursion->5,
PlotPoints->40,
Mesh->False,
ViewPoint->{3,0,10},
ViewVertical->{0,1,0},
ContourStyle->Directive[Blue,Specularity[White,30]],
RegionBoundaryStyle->None
]]

Nodes

Length[pts=SingularPoints[eqn,{x,y,z},WorkingPrecision->200]]

RootApproximant[pts]

POVRay

<<Utilities`POVray`

POVCoefficients[25(x^3 (y+z)+y^3 (x+z)+z^3 (x+y))+50(x^2 y^2+x^2 z^2+y^2 z^2)-125(x^2 y z+y^2 x z+z^2 x y)+60 x y z-4(x y+x z+y z),{x,y,z}]