Klein Quartic

Author

Eric W. Weisstein
February 20, 2012

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneCurves/KleinQuartic.nb.

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

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

Additional Authors

Hyperbolic tiling code by
Oyvind Tafjord

Initialization

Definition

eqn=x^3y+y^3z+z^3x;

eqn/.z->a

AlgebraicDegree[eqn/.z->a,{x,y}]

2-D Graphic

V5

<<Graphics`ImplicitPlot`
<<Utilities`Typesetting`

Show[
Block[{$DisplayFunction=Identity},
Table[
ImplicitPlot[
x^3y+y^3z+z^3x==0,{x,-4,4},
PlotStyle->Hue[(z+2)/4]
],
{z,-2,2,.25}]
],
PlotRange->{{-2,2},{-2,2}},
AspectRatio->Automatic,
PlotLabel->TraditionalForm[x^3y+y^3z+z^3x==0],
AxesLabel->TraditionalForm/@{x,y}]

V6

Show[Table[
ContourPlot[
eqn==0,{x,-4,4},{y,-4,4},
ContourStyle->Hue[(z+2)/4]
],
{z,-2,2,.25}],
PlotRange->{{-2,2},{-2,2}},
AspectRatio->Automatic,
Axes->True,
PlotLabel->eqn==0,
AxesLabel->{x,y}]

Curve

ContourPlot[x^3y+y^3+x==0,{x,-5,5},{y,-5,5},AxesLabel->{x,y},ContourStyle->Red,Frame->False,Axes->True]

Curvature

FullSimplify[ImplicitCurvature[eqn/.z->a,{x,y}],a∈Reals]

Slope

Slope[a^3 x+x^3 y+a y^3==0,{x,y}]//FullSimplify

Surface

Implicit

Function[r,ContourPlot3D[x^3y+y^3z+z^3x==0,{x,-3,3},{y,-3,3},{z,-3,3},RegionFunction->(#1^2+#2^2+#3^2<r^2&),Axes->False,Boxed->False]]/@{2,3}

POV-Ray

<<Utilities`POVRay`

POVCoefficients[x^3y+y^3z+z^3x,{x,y,z}]

Properties

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

Hyperbolic Tiling

Graphics[{Circle[],HyperbolicTiling[7,7]}]

Graphics[{Circle[],HyperbolicTiling[8,6]}]

Toroid

Coor={197/367,85/137,4061/6081,765/1096,363/448,121/128,969/734,2135/1101,29/12,8207/2027,72/17,36/7,291/4054,1};

Vert={{5,6,-12},{-5,6,12},{-5,-6,-12},{12,-5,6},{12,5,-6},{-12,5,6},{-12,-5,-6},{6,-12,5},{6,12,-5},{-6,12,5},{-6,-12,-5},{11,-11,11},{11,11,-11},{-11,11,11},{-11,-11,-11},{3,13,10},{3,-13,-10},{-3,-13,10},{-3,13,-10},{10,3,13},{10,-3,-13},{-10,-3,13},{-10,3,-13},{13,10,3},{13,-10,-3},{-13,-10,3},{-13,10,-3},{4,2,9},{4,-2,-9},{-4,-2,9},{-4,2,-9},{9,4,2},{9,-4,-2},{-9,-4,2},{-9,4,-2},{2,9,4},{2,-9,-4},{-2,-9,4},{-2,9,-4},{7,1,8},{7,-1,-8},{-7,-1,8},{-7,1,-8},{8,7,1},{8,-7,-1},{-8,-7,1},{-8,7,-1},{1,8,7},{1,-8,-7},{-1,-8,7},{-1,8,-7},{14,-14,14},{14,14,-14},{-14,14,14},{-14,-14,-14},{5,-6,12}};

Face={{12,16,42,30,11,8,26},{12,26,49,37,5,4,21},{12,21,44,32,2,56,16},{13,17,43,31,10,9,27},{13,27,48,36,4,5,20},{13,20,45,33,3,1,17},{14,18,40,28,9,10,24},{14,24,51,39,7,6,23},{14,23,46,34,56,2,18},{15,19,41,29,8,11,25},{15,25,50,38,6,7,22},{15,22,47,35,1,3,19},{52,40,18,2,32,33,45},{52,45,20,5,37,38,50},{52,50,25,11,30,28,40},{53,41,19,3,33,32,44},{53,44,21,4,36,39,51},{53,51,24,10,31,29,41},{54,42,16,56,34,35,47},{54,47,22,7,39,36,48},{54,48,27,9,28,30,42},{55,43,17,1,35,34,46},{55,46,23,6,38,37,49},{55,49,26,8,29,31,43}};

Graphics3D[{Opacity[.8],Table[Polygon[Map[Sign[#]Coor[[Abs[#]]]&,(Sign[#]Vert[[Abs[#]]]&/@Face[[n]]),{2}]],{n,1,24}]},Boxed->False,SphericalRegion->True,ViewAngle->Pi/8]