Conchoid of de Sluze

Author

Eric W. Weisstein
June 6, 2014

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

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

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

Equation

GroebnerBasis[Join[Thread[{x,y}==(Sec[t]+a Cos[t]){Cos[t],Sin[t]}],{Sin[t]^2+Cos[t]^2==1,Cos[t]Sec[t]==1}],{x,y},{Cos[t],Sin[t],Sec[t]}]

eqns=Append[Append[Thread[{x,y}==(Sec[t]+a Cos[t]){Cos[t],Sin[t]}],Sin[t]^2+Cos[t]^2==1]/.{_Sec->sec,_Sin:>sin,_Cos:>cos},cos sec==1]

Factor[GroebnerBasis[eqns,{x,y},{cos,sin,sec}]]

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

eqn=(x-1)(x^2+y^2)-a x^2;

Expand[-eqn/.a->1]

AlgebraicDegree[(x-1)(x^2+y^2)==a x^2,{x,y}]

Plots

Contour

GraphicsGrid[{ContourPlot[(x-1)(x^2+y^2)==# x^2,{x,-4,7},{y,-5,5},
PlotRange->{{-2,5},{-5,5}},
PlotLabel->HoldForm[a==#],
Axes->True,
Frame->False,
Ticks->None,
ContourShading->False,
ContourStyle->Red]&/@{-2,-1,1,4}},ImageSize->500]

Parametric

GraphicsGrid[{ParametricPlot[(Sec[t]+# Cos[t]){Cos[t],Sin[t]},{t,-Pi/2+.01,Pi/2-.01},
Ticks->None,
PlotRange->{{-2,5},{-5,5}},
PlotLabel->HoldForm[a==#],
PlotStyle->Red]&/@{-2,-1,1,4}},ImageSize->500
]

GraphicsGrid[Partition[ParametricPlot[(Sec[t]+# Cos[t]){Cos[t],Sin[t]},{t,-Pi/2+.01,Pi/2-.01},
Ticks->None,
PlotRange->{{-2,5.1},{-4,4}},
PlotLabel->a==#,
Epilog->If[#<=-1,{},{Red,PointSize[.06],Point[{0,0}]}],
PlotStyle->Red]&/@{-3,-2,-1,-.5,0,1,2,4},4],ImageSize->400
]

Polar

GraphicsGrid[{PolarPlot[Sec[t]+# Cos[t],{t,-Pi/2+.01,Pi/2-.01},
Ticks->None,
PlotRange->{{-2,5},{-5,5}},
PlotLabel->HoldForm[a==#],
PlotStyle->Red]&/@{-2,-1,1,4}},ImageSize->500
]

Show[Block[{$DisplayFunction=Identity},
Table[
PolarPlot[Sec[t]+a Cos[t],{t,-Pi/2+.01,Pi/2-.01},
Ticks->None,PlotStyle->Hue[(a+2)/6],
PlotRange->{{-2,5},{-5,5}}],{a,-2,4,.5}]
]]

Parametric

sluze=(Sec[t]+a Cos[t]){Cos[t],Sin[t]};

FullSimplify[t/.Solve[(Sec[t]+a Cos[t])Sin[t]==0,t],a<-1]

ParametricPlot[Evaluate[sluze/.a->-2],{t,-1,1},PlotStyle->Red]

Block[{a=-3},ParametricPlot[sluze,{t,-ArcSec[(Sqrt[-a])],ArcSec[(Sqrt[-a])]},PlotStyle->Red]]

Properties

curve=(Sec[t]+a Cos[t]){Cos[t],Sin[t]};

Area of Loop Parametric

<<Graphics`InequalityGraphics`

Show[GraphicsArray[Table[InequalityPlot[(x-1)(x^2+y^2)>a x^2&&x<0,{x},{y}],{a,-3,-1,1/2}]]]

v5.2

Area[sluze,{t,-ArcSec[(Sqrt[-a])],ArcSec[(Sqrt[-a])]},Assumptions->a<-1]

v6

2Area[sluze,{t,0,ArcSec[(Sqrt[-a])]},Assumptions->a<-1]//Timing

ArcSec[(Sqrt[10.^6])]

(1/4) (-2 (Sqrt[-1-a]) (-2+a)+2 a (4+a) ArcSec[(Sqrt[-a])])/.a->-1.2

FullSimplify[(1/4) (-2 (Sqrt[-1-a]) (-2+a)+2 a (4+a) ArcSec[(Sqrt[-a])]),a<-1]

<<Utilities`Simplify

FullSimplify[Subtract@@{(1/2) (-(Sqrt[-1-a]) (-2+a)+a (4+a) ArcSec[(Sqrt[-a])]),(1/4) (-2 (Sqrt[-1-a]) (-2+a)-I a (4+a) Log[((((-I+(Sqrt[-1-a])))^2)/a)])},a<-1]

Plot[(1/4) a (4+a) (2 ArcSec[(Sqrt[-a])]+I Log[((((-I+(Sqrt[-1-a])))^2)/a)]),{a,-10,-1},PlotRange->All]

Area of Loop Cartesian

Integrate[Boole[(x-1)(x^2+y^2)>a x^2&&x<0],{x,-∞,∞},{y,-∞,∞}]//Timing

area=Assuming[{a<-1},Integrate[Boole[(x-1)(x^2+y^2)>a x^2&&x<0],{x,-∞,∞},{y,-∞,∞}]//FullSimplify]

area=(1/4) (-2 (Sqrt[-1-a]) (-2+a)-I a (4+a) (2 Log[1+I (Sqrt[-1-a])]+Log[-(1/a)]));

area/.a->-1.2

(1/4) (-2 (Sqrt[-1-a]) (-2+a)-I a (4+a) (Log[(((1+I (Sqrt[-1-a])))^2)(-(1/a))]))/.a->-1.2

FullSimplify[(1/4) (-2 (Sqrt[-1-a]) (-2+a)-I a (4+a) (Log[(((1+I (Sqrt[-1-a])))^2)(-(1/a))])),a<-1]

%/.a->-1.2

Arc Length Function

v6

Integrate[(Sqrt[a (4+a)-2 a ((Sec[t])^2)+((Sec[t])^4)]),{t,0,t}]

...crashes...

ArcLength[sluze,t]//Timing

...crashes on Mac...

Integrate[(Sqrt[a (4+a)-2 a ((Sec[t])^2)+((Sec[t])^4)]),t]

Simplify[%1,t>0&&a>-1]

Simplify[%1,t>0&&a<-1]

s=(1/2) √(((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))) Sin[2 t]+((-1-2 (Sqrt[-a])+a) (((-1+2 (Sqrt[-a])+a))^3) ((Cos[t])^2) (4 √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))+2 a √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))+4 Cos[2 t] √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))+a Cos[2 t] √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))-4 Cos[4 t] √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))-2 a Cos[4 t] √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t]))-4 √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t])) Cos[6 t]-a √((8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t])/(3+4 Cos[2 t]+Cos[4 t])) Cos[6 t]) ((Cot[t])^2) (((1+((Tan[t])^2)))^2) (Sqrt[1+2 a+(a^2)+2 ((Tan[t])^2)-2 a ((Tan[t])^2)+((Tan[t])^4)]) ((1/(Sqrt[(1/(1+2 (Sqrt[-a])-a))]))(I (-1+2 (Sqrt[-a])+a) (EllipticE[I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))]-EllipticF[I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))]) (Sqrt[1+(((Tan[t])^2)/(1+2 (Sqrt[-a])-a))]) (Sqrt[1-(((Tan[t])^2)/(-1+2 (Sqrt[-a])+a))]))-(1/(Sqrt[(1/(1+2 (Sqrt[-a])-a))]))I EllipticF[I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))] (Sqrt[1+(((Tan[t])^2)/(1+2 (Sqrt[-a])-a))]) (Sqrt[1-(((Tan[t])^2)/(-1+2 (Sqrt[-a])+a))])+(1/(Sqrt[(1/(1+2 (Sqrt[-a])-a))]))2 I a EllipticF[I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))] (Sqrt[1+(((Tan[t])^2)/(1+2 (Sqrt[-a])-a))]) (Sqrt[1-(((Tan[t])^2)/(-1+2 (Sqrt[-a])+a))])-(1/(Sqrt[(1/(1+2 (Sqrt[-a])-a))]))4 I a EllipticPi[1+2 (Sqrt[-a])-a,I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))] (Sqrt[1+(((Tan[t])^2)/(1+2 (Sqrt[-a])-a))]) (Sqrt[1-(((Tan[t])^2)/(-1+2 (Sqrt[-a])+a))])-(1/(Sqrt[(1/(1+2 (Sqrt[-a])-a))]))I (a^2) EllipticPi[1+2 (Sqrt[-a])-a,I ArcSinh[(Sqrt[(1/(1+2 (Sqrt[-a])-a))]) Tan[t]],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))] (Sqrt[1+(((Tan[t])^2)/(1+2 (Sqrt[-a])-a))]) (Sqrt[1-(((Tan[t])^2)/(-1+2 (Sqrt[-a])+a))])-((Tan[t] ((a^2)-2 a (-1+((Tan[t])^2))+(((1+((Tan[t])^2)))^2)))/(1+((Tan[t])^2)))))/(4 (((1+a))^2) (1-4 (Sqrt[-a])-6 a+4 (Sqrt[-a]) a+(a^2)) (8+4 a+3 (a^2)+8 a Cos[2 t]+4 (a^2) Cos[2 t]+4 a Cos[4 t]+(a^2) Cos[4 t]) (3+a-((Tan[t])^2)) (Sqrt[(a^2)-2 a (-1+((Tan[t])^2))+(((1+((Tan[t])^2)))^2)]));

Block[{a=1},Limit[s,t->0]]

Block[{a=2},Plot[Evaluate[Through[{Re,Im}[s]]],{t,0,π/2},PlotStyle->{Red,Blue},PlotRange->{0,10}]]

V6.1

(s=ArcLength[sluze,t,Assumptions->a∈Reals&&t>0])//Timing

FullSimplify[√((((-(a Cos[t]+Sec[t]) Sin[t]+Cos[t] (-a Sin[t]+Sec[t] Tan[t])))^2)+(((Cos[t] (a Cos[t]+Sec[t])+Sin[t] (-a Sin[t]+Sec[t] Tan[t])))^2)),t>0&&a>0]

General

Integrate[(Sqrt[a (4+a)-2 a ((Sec[t])^2)+((Sec[t])^4)]),{t,0,t},Assumptions->-π/2<t<π/2&&a∈Reals]

FullSimplify[%,a∈Reals&&-π/2<t<π/2]

s[t_,a_]:=(1/(Sqrt[((a (4+a)-2 a ((Sec[t])^2)+((Sec[t])^4))/(1+2 (Sqrt[-a])-a))]))I ((-1+2 (Sqrt[-a])+a) EllipticE[I (Sqrt[(1/(1+2 (Sqrt[-a])-a))]) (Sqrt[1+2 (Sqrt[-a])-a]) ArcSinh[((Tan[t])/(Sqrt[1+2 (Sqrt[-a])-a]))],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))]+(-2 (Sqrt[-a])+a) EllipticF[I (Sqrt[(1/(1+2 (Sqrt[-a])-a))]) (Sqrt[1+2 (Sqrt[-a])-a]) ArcSinh[((Tan[t])/(Sqrt[1+2 (Sqrt[-a])-a]))],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))]-a (4+a) EllipticPi[1+2 (Sqrt[-a])-a,I (Sqrt[(1/(1+2 (Sqrt[-a])-a))]) (Sqrt[1+2 (Sqrt[-a])-a]) ArcSinh[((Tan[t])/(Sqrt[1+2 (Sqrt[-a])-a]))],((-1-2 (Sqrt[-a])+a)/(-1+2 (Sqrt[-a])+a))]) (Sqrt[((2 (Sqrt[-a])+a-((Sec[t])^2))/(-1+2 (Sqrt[-a])+a))]) (Sqrt[((2 (Sqrt[-a])-a+((Sec[t])^2))/(1+2 (Sqrt[-a])-a))])

Plot[Evaluate[s[t,#]&/@{-2,-1.5,1,2}],{t,-π/2,π/2},Exclusions->None]

Curvature

Show[GraphicsArray[Block[{$DisplayFunction=Identity},Block[{a=#},Plot[((2 a (4+a-3 ((Sec[t])^2)))/(((a (4+a)-2 a ((Sec[t])^2)+((Sec[t])^4)))^(3/2))),{t,0,20},PlotStyle->Red]]&/@{-2,-1,0,1,2}]]]

v6

FullSimplify[Curvature[sluze,t]]

SortBy[FullSimplify[Curvature[eqn,{x,y}],a>0&&(x|y)∈Reals],ByteCount]

ByteCount/@%

Polar

FullSimplify[Curvature[Sec[q]+a Cos[q],q],a>0&&-π/2<q<π/2]

Singular Points

SingularPoints[eqn,{x,y}]

Slope

Slope[(Sec[t]+a Cos[t]){Cos[t],Sin[t]},t]//FullSimplify

Slope[Sec[q]+a Cos[q],q]//FullSimplify

Slope[(x-1) (x^2+y^2)==a x^2,{x,y}]//FullSimplify

Slope[(x-1) (x^2+y^2)==a x^2,{x,y}]//FullSimplify

SpecialAffineCurvature

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&-π/2<t<π/2]

Tangential Angle

TangentialAngle[sluze,t,Assumptions->a∈Reals]

Plot[2 t-ArcTan[((2 Sin[2 t])/(a+(2+a) Cos[2 t]))]/.a->1,{t,0,4π}]

Vector Properties

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

VectorLength

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

NormalVector

Assuming[assum,FullSimplify[NormalVector[parm,t]/.xform]]

TangentVector

Assuming[assum,FullSimplify[TangentVector[parm,t]/.xform]]