One-Seventh Ellipse

Author

Eric W. Weisstein
April 29, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/One-SeventhEllipse.nb.

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

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

Additional Authors

Eric W. Weisstein
November 7, 2005

Code

StandardEllipse[eqn_,{x_,y_}]:=Module[{a,b,c,d,f,g},
coefs=Flatten[Normal[CoefficientArrays[eqn,{x,y},Symmetric->True]]];
{a,b,c,d,f,g}=coefs[[{4,5,7,2,3,1}]]{1,1,1,1/2,1/2,1};
Ellipse[{(c*d-b*f)/(b^2-a*c),(-(b*d)+a*f)/(b^2-a*c)},{Sqrt[2]*Sqrt[(c*d^2-2*b*d*f+a*f^2+b^2*g-a*c*g)/((b^2-a*c)*(-a-c+Sqrt[1+(4*b^2)/(a-c)^2]*(-a+c)))],Sqrt[2]*Sqrt[(c*d^2-2*b*d*f+a*f^2+b^2*g-a*c*g)/((-a+Sqrt[1+(4*b^2)/(a-c)^2]*(a-c)-c)*(b^2-a*c))]},ArcCot[(-a+c)/(2*b)]/2]
]

Graphics

One-Seventh by Digits

N[1/7,20]

pts=Take[Partition[N[1/7,10]//RealDigits//First,2,1],6]

Det[Map[{#[[1]]^2, #[[1]] #[[2]], #[[2]]^2,#[[1]],#[[2]],1}&,Prepend[Take[pts,5],{x,y}]]]/102//Expand

Seventh[x_,y_] := 1638-333 x+19 (x^2)-531 y+36 x y+41 (y^2)

{x,y}/.{ToRules[Reduce[Seventh[x,y]==0,{x,y},Integers]]}

StandardEllipse[Seventh[x,y],{x,y}]

ContourPlot[Seventh[x,y],{x,-1,10},{y,-0,9},Contours->{0},ContourStyle->{{Thickness[0.01]}},ContourShading->False,Epilog->{{Text["("<>ToString@First[#]<>","<>ToString@Last[#]<>")",#+{.5,.35},TextStyle->TraditionalForm]&/@pts,Hue[0],PointSize[0.03],Point/@pts,
Blue,Point[{9/2,9/2}]}}]

One-Seventh by Digit Pairs

pts=Transpose[Partition[Map[FromDigits[#,10]&,Partition[N[1/7,20]//RealDigits//First,2,1]],8]]

Det[Map[{#[[1]]^2, #[[1]] #[[2]], #[[2]]^2,#[[1]],#[[2]],1}&,Prepend[Take[pts,5],{x,y}]]]/19901/2//Expand

Seventh2[x_,y_] := -7999600+8385498 x-165104 (x^2)-3836349 y+160804 x y-41651 (y^2)

{x,y}/.{ToRules[Reduce[Seventh2[x,y]==0,{x,y},Integers]]}

StandardEllipse[Seventh2[x,y],{x,y}]

ContourPlot[Seventh2[x,y],{x,-70,160},{y,-180,280},Contours->{0},ContourStyle->{{Thickness[0.01]}},ContourShading->False,PlotPoints->60,Epilog->{{Text["("<>ToString@First[#]<>","<>ToString@Last[#]<>")",#+If[#[[1]]<50,{-30,0},{30,0}],TextStyle->TraditionalForm]&/@pts,Hue[0],PointSize[0.03],Point/@pts}}]