Steinmetz Curve

Author

Eric W. Weisstein
September 17, 2018

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

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

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

Inititalization

Curve

SteinmetzCurve[a_,b_,c_][t_]:={a Cos[t],a Sin[t],c Sqrt[b^2-a^2 Sin[t]^2]}

ParametricPlot3D[{SteinmetzCurve[1,1.2,1][t],SteinmetzCurve[1,1.2,-1][t]}//Evaluate,{t,0,2Pi},Ticks->None]

WriteLiveForm["steincur.m",%]

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

Manipulate[Show[{
Graphics3D[{Opacity[.5],Cylinder[{{-2,0,0},{2,0,0}},b],Cylinder[{{0,0,-2},{0,0,2}},a]}],
ParametricPlot3D[{SteinmetzCurve[a,b,1][t],SteinmetzCurve[a,b,-1][t]}//Evaluate,{t,0,2Pi},PlotStyle->{Red,Blue}]
}],{{a,1},.1,2},{{b,1.5},.1,2}]

curve=SteinmetzCurve[a,b,1][t]

RefineSimplify[expr_,assum_]:=FullSimplify[Refine[expr,assum],assum]

top=Block[{a=#1,b=#2},ParametricPlot3D[{a Cos[t],a Sin[t],(Sqrt[(b^2)-(a^2) ((Sin[t])^2)])},{t,0,2π}]]&@@@{{1,1.2},{1,1.15},{1,1},{1,2},{2,1}}

bot=Block[{a=#1,b=#2},ParametricPlot3D[{a Cos[t],a Sin[t],-(Sqrt[(b^2)-(a^2) ((Sin[t])^2)])},{t,0,2π}]]&@@@{{1,1.2},{1,1.15},{1,1},{1,2},{2,1}}

Show[#,PlotRange->All]&/@Transpose[{top,bot}]

Equation

Solve[x^2+y^2==a^2&&y^2+z^2==b^2,{x,z}]

FullSimplify[{(Sqrt[(a^2)-(y^2)]),y,(Sqrt[(b^2)-(y^2)])}/.y->a Sin[t],a>0&&b>0&&0<t<π/2]

Block[{a=1,b=1},Show[{
Graphics3D[{
Opacity[.5],,
Cylinder[{{0,0,-1.5},{0,0,1.5}},a],
Cylinder[{{1,0,0},{-1,0,0}},b]
}],
ParametricPlot3D[Table[{(((-1))^i)(Sqrt[(a^2)-(y^2)]),y,(((-1))^j)(Sqrt[(b^2)-(y^2)])},{i,2},{j,2}],{y,-2,2},PlotStyle->Directive[Thick,Red]]
},Boxed->False]]

Block[{a=.5,b=1},Show[{
Graphics3D[{
Opacity[.5],,
Cylinder[{{0,0,-1.5},{0,0,1.5}},a],
Cylinder[{{1,0,0},{-1,0,0}},b]
}],
ParametricPlot3D[Table[{(((-1))^i)(Sqrt[(a^2)-(y^2)]),y,(((-1))^j)(Sqrt[(b^2)-(y^2)])},{i,2},{j,2}],{y,-2,2},PlotStyle->Directive[Thick,Red]]
},Boxed->False]]

Block[{a=1,b=.5},Show[{
Graphics3D[{
Opacity[.5],,
Cylinder[{{0,0,-1.5},{0,0,1.5}},a],
Cylinder[{{1.5,0,0},{-1.5,0,0}},b]
}],
ParametricPlot3D[Table[{(((-1))^i)(Sqrt[(a^2)-(y^2)]),y,(((-1))^j)(Sqrt[(b^2)-(y^2)])},{i,2},{j,2}],{y,-2,2},PlotStyle->Directive[Thick,Red]]
},Boxed->False]]

Parametric

curve={a Cos[t],a Sin[t],(Sqrt[(b^2)-(a^2) ((Sin[t])^2)])};

Block[{a=.5,b=1},ParametricPlot3D[curve,{t,0,2π}]]

Block[{a=1,b=.5},ParametricPlot3D[curve,{t,0,2π}]]

Implicit

Eliminate[Thread[{x,y,z}==curve],t]

Block[{a=1,b=1.2},Show[{
ParametricPlot3D[curve,{t,0,10},Evaluated->True,PlotStyle->Directive[Red,Thickness[.02]]],
ContourPlot3D[(x^2)-(z^2)==(a^2)-(b^2),{x,-1,1},{y,-1,1},{z,.5,1.4},ContourStyle->Opacity[0.5],Mesh->None],
ContourPlot3D[(y^2)+(z^2)==(b^2),{x,-1,1},{y,-1,1},{z,.5,1.4},ContourStyle->Opacity[0.5],Mesh->None]
},PlotRange->{{-1,1},{-1,1},{.5,1.4}}]]

Properties

ArcLengthFunction

ArcLength[curve,t]

FullSimplify[(a^2) ((Cos[t])^2)+(a^2) ((Sin[t])^2)+(((a^4) ((Cos[t])^2) ((Sin[t])^2))/((b^2)-(a^2) ((Sin[t])^2))),a>0&&b>0&&0<t<2π]

(a^2) Integrate[(Sqrt[((Sin[t])^2)+(1/(((Sec[t])^2)-(((a^2) ((Tan[t])^2))/(b^2))))]),{t,0,t},Assumptions->0<t<2π&&a>0&&b>0]//Timing

(a^2) Integrate[(Sqrt[((Sin[t])^2)+(1/(((Sec[t])^2)-(((a^2) ((Tan[t])^2))/(b^2))))]),t]//Timing

BinormalVector

b=.

binorm=Simplify[Refine[BinormalVector[curve,t],a>0&&b>0],a>0&&b>0&&0<t<2π]

FullSimplify[binorm/.Abs[x_]^2:>x^2,a>0&&b>0&&0<t<2π]

Curvature

FullSimplify[Curvature[curve,t],a>0&&b>0&&0<t<2π]

NormalVector

n=Simplify[Refine[NormalVector[curve,t],a>0&&b>0],a>0&&b>0]

FullSimplify[n,a>0&&b>0&&0<t<2π]

...hangs...

n/.Abs[x_]^2:>x^2

FullSimplify[n/.Abs[x_]^2:>x^2,a>0&&b>0&&t∈Reals]

FullSimplify[n.n,a>0&&b>0&&t∈Reals]

...hangs...

FullSimplify[n.n/.Abs[x_]^2:>x^2,a>0&&b>0&&t∈Reals]

TangentVector

tan=FullSimplify[TangentVector[curve,t],a>0&&b>0]

tan=RefineSimplify[TangentVector[curve,t],a>0&&b>0&&0<t<2π]

tan=FullSimplify[tan/.Abs[x_]^2:>x^2,a>0&&b>0&&0<t<2π]

norm=RefineSimplify[tan.tan,a>0&&b>0&&0<t<2π]

FullSimplify[norm/.{a->1,b->2},0<t<2π]

FullSimplify[norm/.{a->2,b->3},0<t<2π]

Torsion

FullSimplify[Torsion[curve,t],a>0&&b>0&&0<t<2π]

TotalCurvature

FullSimplify[TotalCurvature[curve,t],a>0&&b>0&&0<t<2π]

VectorLength

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