Cranioid

Author

Eric W. Weisstein
June 27, 2013

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

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

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

Additional Authors

Original version by Margherita Barile
2002-06-18

Definition

eqn[a_,b_,c_,p_,q_][t_]:=a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]

Plot

ParametricPlot[eqn[1,1,1,.998,.125][t]{Cos[t],Sin[t]},{t,0,2 Pi},PlotStyle->Red,Ticks->None,ImageSize->Small]

PolarPlot[eqn[1,1,1,.998,.125][t],{t,0,2 Pi},PlotStyle->Red,Ticks->None,ImageSize->Small]

With[{a=1,b=1,c=1,p=.998,q=.125},
Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
Show[{PolarPlot[a Sin[t]+b Sqrt[1-c Cos[t]^2]+c Sqrt[1-q Cos[t]^2],Evaluate[{t,Sequence@@#}],PlotStyle->Red,Ticks->None],
PolarPlot[a Sin[t]+b Sqrt[1-c Cos[t]^2]+c Sqrt[1-q Cos[t]^2],Evaluate[{t,0,2π}],PlotStyle->{Dashing[{.04}],Red},Ticks->None]
}]&/@{{0, Pi},{Pi,2π}}
]]]]

Equation

((((x/(Cos[t]))-a Sin[t]))^2)==((((b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]))^2)//Expand)

(((x Sec[t]-a Sin[t]))^2)==(b^2)+(c^2)-(b^2) p ((Cos[t])^2)-(c^2) q ((Cos[t])^2)+2 b c (Sqrt[1-p ((Cos[t])^2)]) (Sqrt[1-q ((Cos[t])^2)])

expr={((((x Sec[t]-a Sin[t]))^2)-((b^2)+(c^2)-(b^2) p ((Cos[t])^2)-(c^2) q ((Cos[t])^2)))^2-4b c(1-p Cos[t]^2)(1-q Cos[t])^2,
((((x Csc[t]-a Sin[t]))^2)-((b^2)+(c^2)-(b^2) p ((Cos[t])^2)-(c^2) q ((Cos[t])^2)))^2-4b c(1-p Cos[t]^2)(1-q Cos[t])^2}/.{Sec[t]->1/cos,Csc[t]->1/sin,Cos[t]->cos,Sin[t]->sin}//Together

Factor/@GroebnerBasis[Append[Numerator[expr],cos^2+sin^2-1],{x,y},{cos,sin},MonomialOrder->EliminationOrder]

Properties

polar=(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]);
curve={Cos[t],Sin[t]}polar;

Arc Length

Parametric

FullSimplify[2 π (Sqrt[(((b (Sqrt[1-c ((Cos[t])^2)])+c (Sqrt[1-q ((Cos[t])^2)])+a Sin[t]))^2)]),0<t<2π]

Simplify[Sqrt[(b*Sqrt[1-c*Cos[t]^2]+c*Sqrt[1-q*Cos[t]^2]+a*Sin[t])^2+(a*Cos[t]+(b*c*Cos[t]*Sin[t])/Sqrt[1-c*Cos[t]^2]+(c*q*Cos[t]*Sin[t])/Sqrt[1-q*Cos[t]^2])^2]]

Simplify[%,a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&0<t<2π]

v5

ArcLength[a Sin[t]+b Sqrt[1-c Cos[t]^2]+c Sqrt[1-q Cos[t]^2],{t,0,2π}]//Timing

Integrate[√((1/81) (((3 b (Sqrt[9-8 (Sqrt[3]) ((Cos[t])^2)])+8 (Sqrt[3-3 q ((Cos[t])^2)])+9 a Sin[t]))^2)+(1/81) ((Cos[t])^2) (((9 a+8 (Sqrt[3]) (((3 b)/(Sqrt[9-8 (Sqrt[3]) ((Cos[t])^2)]))+(q/(Sqrt[1-q ((Cos[t])^2)]))) Sin[t]))^2)),{t,0,2Pi},Assumptions->a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1]//Timing

v6

ArcLength[a Sin[t]+b Sqrt[1-c Cos[t]^2]+c Sqrt[1-q Cos[t]^2],{t,0,2π}]//Timing

...crash...

ArcLength[a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2],{t,0,2π}]//Timing

Polar

ArcLength[a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2],{t,0,π},a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1]//Timing

Area

Parametric

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Area[curve,{t,0,2π}]]//Timing

expr=Expand[Sin[t] (b (Sqrt[1-p ((Cos[t])^2)])+c (Sqrt[1-q ((Cos[t])^2)])+a Sin[t]) (-Sin[t] (b (Sqrt[1-p ((Cos[t])^2)])+c (Sqrt[1-q ((Cos[t])^2)])+a Sin[t])+Cos[t] (a Cos[t]+((b p Cos[t] Sin[t])/(Sqrt[1-p ((Cos[t])^2)]))+((c q Cos[t] Sin[t])/(Sqrt[1-q ((Cos[t])^2)]))))]

(i=Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Integrate[#,{t,0,2π}]]&/@expr)//Timing

Polar

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,(1/2)Integrate[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2,{t,0,2π}]]//Timing

exp=Expand[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2]

(i=(1/2)Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Integrate[#,{t,0,2π}]]&/@exp)//Timing

FullSimplify[(((a^2) π)/2)+(b^2) π+(c^2) π-(1/2) (b^2) p π-(1/2) (c^2) π q]

Factor[%38]

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,b c Integrate[(Sqrt[(1-p ((Cos[t])^2))(1-q ((Cos[t])^2))]),{t,0,2π}]]//Timing

This integral courtesy of Sasha Pavlyk, Oct 28, 2012:

FullSimplify[(1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q))+b c 2 Pi AppellF1[1/2,-(1/2),-(1/2),1,p,q]]

area=(1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q]);

With[{a=1,b=1,c=1,p=.98,q=.125},
{
NArea[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
NArea[{Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
(1/2)NIntegrate[(((b (Sqrt[1-p ((Cos[t])^2)])+c (Sqrt[1-q ((Cos[t])^2)])+a Sin[t]))^2),{t,0,2π}],
(1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])
}]

With[{a=1,b=1.1,c=1.2,p=.3,q=.1},
{
NArea[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
NArea[{Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
(1/2)NIntegrate[(((b (Sqrt[1-p ((Cos[t])^2)])+c (Sqrt[1-q ((Cos[t])^2)])+a Sin[t]))^2),{t,0,2π}],
(1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])
}]

Centroid

Polar

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Centroid[polar,{t,0,2π}]]//Timing

Integrate[r^2 {Cos[q],Sin[q]},{q,q0,q1},{r,0,rho}]

x

Integrate[Cos[t](a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2,{r,0,(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])}]

is=Expand[%]

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Integrate[#,{t,0,2π}]]&/@is

y

Integrate[Sin[t](a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2,{r,0,(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])}]

is=Expand[%]

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Integrate[#,{t,0,2π}]]&/@Most[is]

Assuming[a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q,Integrate[#,{t,0,2π}]]&/@is

Closed from from Sasha Pavlyk, 2012-10-30

FullSimplify[((3 (a^3) π)/4)+3 a (b^2) π+3 a (c^2) π-(3/4) a (b^2) p π-(3/4) a (c^2) π q+6*a*b*c Pi AppellF1[1/2,-1/2,-1/2,2,p,q]]

With[{a=1,b=1,c=1,p=.98,q=.125},
{
NCentroid[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
NCentroid[{Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
(1/((1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])))NIntegrate[Sin[t](a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2,{t,0,2π},{r,0,(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])}],
(((3/4) a π ((a^2)-(b^2) (-4+p)-(c^2) (-4+q)+8 b c AppellF1[(1/2),-(1/2),-(1/2),2,p,q]))/((1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])))
}]

3 1.1331503569733152`

With[{a=1,b=1,c=1.3,p=.9,q=.2},
{
NCentroid[(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
NCentroid[{Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),{t,0,2π}],
(1/((1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])))NIntegrate[Sin[t](a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])^2,{t,0,2π},{r,0,(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2])}],
(((3/4) a π ((a^2)-(b^2) (-4+p)-(c^2) (-4+q)+8 b c AppellF1[(1/2),-(1/2),-(1/2),2,p,q]))/((1/2) π ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])))
}]

3 1.1184957235835236`

Manipulate[PolarPlot[a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2],{t,0,2π},Epilog->{PointSize[.02],Red,Point[{0,((a ((a^2)-(b^2) (-4+p)-(c^2) (-4+q)+8 b c AppellF1[(1/2),-(1/2),-(1/2),2,p,q]))/(2 ((a^2)-(b^2) (-2+p)-(c^2) (-2+q)+4 b c AppellF1[(1/2),-(1/2),-(1/2),1,p,q])))}]}],
{{a,.5},0,b+c},{{b,.5},0,1},{{c,.5},0,1},{{p,.5},0,1},{{q,.5},0,1}]

Curvature

Parametric

FullSimplify[Curvature[eqn[a,b,c,p,q][t],t],a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&0<t<2π]

Polar

FullSimplify[Curvature[a Sin[q]+b Sqrt[1-p Cos[q]^2]+c Sqrt[1-q1 Cos[q]^2],q],a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q1<1&&0<q<2π]

...either crashes or runs out of memory...

Slope

Slope[{Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]),t]//FullSimplify

Slope[a Sin[q]+b Sqrt[1-p Cos[q]^2]+c Sqrt[1-q1 Cos[q]^2],q]//FullSimplify

SpecialAffineCurvature

SpecialAffineCurvature[curve,t]

Simplify[SpecialAffineCurvature[curve,t],a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q&&0<t<2π]//Timing

FullSimplify[SpecialAffineCurvature[curve,t],a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&p≠q&&0<t<2π]//Timing

Tangential Angle

Simplify[TangentialAngle[eqn[a,b,c,p,q][t],t],a>0&&b>0&&c>0&&a<b+c&&0<p<1&&0<q<1&&0<t<2π]

Vector Properties

parm={Cos[t],Sin[t]}(a Sin[t]+b Sqrt[1-p Cos[t]^2]+c Sqrt[1-q Cos[t]^2]);
assum=a>0&&b>0&&p>0&&q>0&&00<t<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]]//Timing

TangentVector

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