Viviani's Curve

Author

Eric W. Weisstein
April 23, 2013

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SpaceCurves/VivianisCurve.nb.

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

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

Graphic

V5

<<Graphics`Shapes`

Show[Graphics3D[{Sphere[2],TranslateShape[Cylinder[1,2.5,30],{1,0,0}]}],Boxed->False]

V6

Block[{a=1},Show[{
Graphics3D[{Opacity[.3],{Blue,Sphere[{0,0,0},2a]},{Green,Cylinder[{a,0,2#a}&/@{-1,1},a]}}],
ParametricPlot3D[viviani,{t,-2π,2π},Evaluated->True,PlotStyle->Directive[Thickness[.02],Red]]
}]]

Curve

<<Graphics`Colors`

ParametricPlot3D[{
{1+Cos[t],Sin[t],2Sin[t/2],{Thickness[.015],Red}},
{1+Cos[t],Sin[t],0,{Dashing[{.01}],Red}},
{2Cos[t/2],0,2Sin[t/2]},
{2Cos[t/2],2Sin[t/2],0},
{0,2Cos[t/2],2Sin[t/2]}
},{t,0,Pi},Boxed->False,Ticks->None,AxesEdge->{{-1,-1},{-1,-1},{-1,-1}},
PlotRange->{{0,2},{0,2},{0,2}},ViewPoint->{10,3,1},
ImageSize->200]

g=ParametricPlot3D[{
{1+Cos[t],Sin[t],2Sin[t/2],{Thickness[.015],Red}},
{1+Cos[t],Sin[t],0,{Dashing[{.01}],Red}},
{2Cos[t/2],0,2Sin[t/2]},
{2Cos[t/2],2Sin[t/2],0},
{0,2Cos[t/2],2Sin[t/2]}
},{t,-2Pi,2Pi},Boxed->False,Ticks->None,Axes->None,
ViewPoint->{10,3,1},
ImageSize->250]

LiveGraphics3D

<<Utilities`LiveGraphics3D`

WriteLiveForm["viviani.m",g]

Views

<<Graphics`ImplicitPlot`
<<Graphics`Colors`

Show[GraphicsArray[Block[{$DisplayFunction=Identity},
ParametricPlot3D[{
{1+Cos[t],Sin[t],2Sin[t/2],{Thickness[.015],Red}},
{1+Cos[t],Sin[t],0,{Dashing[{.01}],Red}},
{2Cos[t/2],0,2Sin[t/2]},
{2Cos[t/2],2Sin[t/2],0},
{0,2Cos[t/2],2Sin[t/2]}
},{t,-2Pi,2Pi},Boxed->False,Ticks->None,Axes->None,
ViewPoint->#2,PlotLabel->StyleForm[#1,FontFamily->"Times",FontSlant->"Italic"]]&@@@{
{"front view",{200,0,0}},
{"top view",{0,0,200}},
{"left view",{0,200,0}}}
]],ImageSize->450]

viviani={1+Cos[t],Sin[t],2Sin[t/2]};

ParametricPlot[Evaluate[Partition[viviani,2,1,1]],{t,-2π,2π},AspectRatio->Automatic,PlotStyle->Red]

Front

Eliminate[{x==2Sin[t/2]Cos[t/2],y==2Sin[t/2],Cos[t/2]^2+Sin[t/2]^2==1},{Cos[t/2],Sin[t/2]}]//Simplify

Expand[(y^2-2)^2+4(x^2-1)]

ImplicitPlot[4 (x^2)+(y^4)==4 (y^2),{x,-1,1},PlotStyle->Red]

Top

Eliminate[{x==1+Cos[t],y==Sin[t]},t]//Simplify

Expand[(x-1)^2+y^2-1]

ImplicitPlot[(x^2)+(y^2)==2 x,{x,0,2},PlotStyle->Red]

Left

{1+Cos[t],2Sin[t/2]}

TrigExpand[Cos[2t]]

Eliminate[{y==1+(Cos[t/2]^2-Sin[t/2]^2),x==2Sin[t/2],Sin[t/2]^2+Cos[t/2]^2==1},t]//Simplify

ImplicitPlot[(x^2)+2 y==4,{x,-2,2},PlotStyle->Red]

Solve[(x^2)+2 y==4,y]

Solution

FullSimplify[Solve[{(((x-a))^2)+(y^2)==a^2,(x^2)+(y^2)+(z^2)==4(a^2)},{x,y}]]

{(((x-a))^2)+(y^2)==a^2,(x^2)+(y^2)+(z^2)==4(a^2)}/.Thread[{x,y,z}->a{1+Cos[t],Sin[t],2Sin[t/2]}]//Simplify

Equations

Parametric

viviani=a{1+Cos[t],Sin[t],2Sin[t/2]};

Block[{a=1},ParametricPlot3D[viviani,{t,-2π,2π},Evaluated->True]]

Natural

Solve[2 Sqrt[2] a EllipticE[t/2,1/2]==s,t]

Implicit

Block[{a=1},Show[{
ParametricPlot3D[viviani,{t,-2π,2π},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],

ContourPlot3D[(((x-a))^2)+(y^2)==(a^2),{x,-2,2},{y,-2,2},{z,-2,2},ContourStyle->Directive[Blue,Opacity[0.5]],Mesh->None],
ContourPlot3D[(x^2)+(y^2)+(z^2)==(((2a))^2),{x,-2,2},{y,-2,2},{z,-2,2},ContourStyle->Directive[Green,Opacity[0.5]],Mesh->None]
},PlotRange->{{-2,2},{-2,2},{-2,2}}]]

viviani

eqns={x,y,z}-a{1+(Cos[s]^2-Sin[s]^2),2Sin[s]Cos[s],2Sin[s]}/.{Cos[s]->cos,Sin[s]->sin}

Factor/@GroebnerBasis[Append[eqns,cos^2+sin^2-1],{x,y,z},{cos,sin}]

{(z^4)==4(a^2)((z^2)-(y^2)),(z^2)+2a x==(((2a))^2),2a (y^2)==x (z^2),(x^2)+(y^2)+(z^2)==(((2a))^2)}

Block[{a=1,r=2.2,opac=.3},Show[{
ParametricPlot3D[viviani,{t,-2π,2π},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],

ContourPlot3D[(x^2)+(y^2)+(z^2)==4(a^2),{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Yellow,Opacity[opac]],Mesh->None],

ContourPlot3D[4 (a^2) (y^2)-4 (a^2) (z^2)+(z^4)==0,{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Blue,Opacity[opac]],Mesh->None],
ContourPlot3D[-4 (a^2)+2 a x+(z^2)==0,{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Green,Opacity[opac]],Mesh->None],
ContourPlot3D[-2 a (y^2)+x (z^2)==0,{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Red,Opacity[opac]],Mesh->None],
ContourPlot3D[(((x-a))^2)+(y^2)==(a^2),{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Orange,Opacity[opac]],Mesh->None]
},PlotRange->r]]

Subsets[Range[4],{2}]

eqns={(x^2)+(y^2)+(z^2)==(((2a))^2),(((x-a))^2)+(y^2)==(a^2),(z^4)==4(a^2)((z^2)-(y^2)),(z^2)==(((2a))^2)-2a x,2a (y^2)==x (z^2)};

Or@@(And@@@Subsets[eqns,{2}])

pairs=Show/@Subsets[Block[{a=1,r=2.2,opac=.3},ContourPlot3D[#,{x,-r,r},{y,-r,r},{z,-r,r},ContourStyle->Directive[Opacity[opac]],Mesh->None,Boxed->False,Axes->False]]&/@eqns,{2}]

GraphicsGrid[Partition[Show[{
#,
Block[{a=1,r=2.2},ParametricPlot3D[viviani,{t,-2π,2π},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]]]
},PlotRange->2.2]&/@pairs,4,4,{1,1},{}],Spacings->-30,ImageSize->400]

Properties

parm=a{1+Cos[t],Sin[t],2Sin[t/2]};
assum=a>0&&-2π<t<2π;
xform={Abs[x_]^(n_/;Mod[n,2]==0):>x^n,Sqrt[x_^(n_/;Mod[n,2]==0)]:>Abs[x]^(n/2)};

Block[{a=1},ParametricPlot3D[viviani,{t,-2π,2π}]]

ArcLength

(s=Assuming[a>0,ArcLength[viviani,{t,-2π,2π}]])//Timing

ArcLengthFunction

V5

ArcLength[viviani,t]

FullSimplify[%,a>0&&t>0]

V8

FullSimplify[Sqrt[#.#]&[D[viviani,t]]]

Integrate[((Sqrt[(a^2) (3+Cos[t])])/(Sqrt[2])),{t,0,t}]//Timing

Refine[Cos[t]>-3,t∈Reals]

(s=ArcLength[viviani,t])//Timing

Integrate[((Sqrt[(a^2) (3+Cos[t])])/(Sqrt[2])),{t,0,t},Assumptions->t>0]//Timing

Integrate[((Sqrt[(a^2) (3+Cos[t])])/(Sqrt[2])),{t,0,t},Assumptions->t∈Reals]//Timing

Plot[2 (Sqrt[2])  EllipticE[(t/2),(1/2)],{t,-2π,2π}]

(s=Integrate[((Sqrt[(a^2) (3+Cos[t])])/(Sqrt[2])),{t,0,t},Assumptions->a>0])//Timing

FullSimplify[s,t∈Reals&&-2Pi<t<2π]

(s=Assuming[a>0,ArcLength[viviani,t]])//Timing

FullSimplify[s,a>0&&t∈Reals]

Plot[2 (Sqrt[2]) (EllipticE[π FractionalPart[(t/(2 π))],(1/2)]+2 EllipticE[(1/2)] IntegerPart[(t/(2 π))]),{t,-2π,2π}]

BinormalVector

b=FullSimplify[BinormalVector[viviani,t],a>0&&-2π<t<2π]

FullSimplify[b.b]

Curvature

V8

κ=FullSimplify[Curvature[viviani,t],a>0]

NormalVector

n=FullSimplify[NormalVector[viviani,t],a>0&&-2π<t<2π]

FullSimplify[n.n]

TangentVector

tan=FullSimplify[TangentVector[viviani,t],a>0&&-2π<t<2π]

FullSimplify[tan.tan]

Torsion

τ=FullSimplify[Torsion[viviani,t],a>0]

TotalCurvature

FullSimplify[TotalCurvature[viviani,t],a>0&&-2π<t<2π]

VectorLength

Assuming[assum,FullSimplify[Norm[parm]/.xform]]