Bow Curve

Author

Eric W. Weisstein
February 2, 2018

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

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

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

Equation

eqn=x^4==a(x^2 y-y^3);

Expand[Subtract@@eqn]

AlgebraicDegree[eqn,{x,y}]

Plots

V5

<<Graphics`ImplicitPlot`

ImplicitPlot[x^4==x^2 y-y^3,{x,-.5,.5},
Ticks->None,
PlotStyle->Red,
PlotRange->{{-.5,.5},{-.3,.3}}]

V6

ContourPlot[eqn==0,{x,-.4,.4},{y,-.3,.27},ContourStyle->Red,AspectRatio->Automatic,MaxRecursion->4]

Plot3D[eqn,{x,-.5,.5},{y,-.3,.27},MeshFunctions->(#3&),Mesh->{{0.}},PlotPoints->75]

Properties

Curvature

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

ByteCount/@%

Inflection Points

InflectionPoints[eqn,{x,y}]

Singular Points

SingularPoints[eqn,{x,y}]

Slope

Slope[eqn,{x,y}]//FullSimplify//Union

Solve x(y)

ysoln=x/.Solve[x^4==x^2 y-y^3,x]

ParametricPlot[Evaluate[{#,y}&/@ysoln],{y,0,2/9(Sqrt[3])},PlotStyle->List/@{Red,Green,Blue,Purple},
AspectRatio->Automatic]

Solve y(x)

xsoln=y/.Solve[x^4==x^2 y-y^3,y]

Plot[Evaluate[xsoln],{x,0,2/(3(Sqrt[3]))},PlotStyle->List/@{Red,Green,Blue},AspectRatio->Automatic]

Tangents

Vertical

Last[Maximize[{x,x^4==x^2 y-y^3&&y>0},{x,y}]]

Horizontal

Last[Maximize[{y,x^4==x^2 y-y^3&&y>0},{x,y}]]

Area

<<Graphics`InequalityGraphics`

InequalityPlot[x^4<x^2 y-y^3&&y>0,{x,0,∞},{y,-∞,∞}]

N[8/105,10]

Numeric

2NIntegrate[Boole[x^4<x^2 y-y^3],{x,0,∞},{y,0,∞}]

2NIntegrate[xsoln[[1]]-xsoln[[-1]],{x,0,(2/(3(Sqrt[3])))}]//Chop

FullSimplify[xsoln[[1]]-xsoln[[-1]],0<x<(2/(3(Sqrt[3])))]

Boole

2Integrate[Boole[x^4<x^2 y-y^3],{x,0,∞},{y,0,∞}]

2NIntegrate[Boole[x^4<x^2 y-y^3],{x,0,∞},{y,0,∞}]

ToRadicals can't work when Root contains a symbolic parameter, so the following approach does not work:

expr2=ToRadicals[expr1=Root[(x^4)-(x^2) #1+((#1)^3)&,1]+2 Root[(x^4)-(x^2) #1+((#1)^3)&,3]]

2/(3(Sqrt[3]))//N

{expr1,expr2}/.x->.3

Direct Integration

v4.2

Integrate[((x (-3 I+3 (Sqrt[3])+(((-1))^(1/6)) (2^(1/3)) (3^(2/3)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(2/3))))/((2^(2/3)) (3^(5/6)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(1/3)))),{x,0,(2/(3(Sqrt[3])))}]//Timing

v5.1

Integrate[((x (-3 I+3 (Sqrt[3])+(((-1))^(1/6)) (2^(1/3)) (3^(2/3)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(2/3))))/((2^(2/3)) (3^(5/6)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(1/3)))),{x,0,(2/(3(Sqrt[3])))}]//Timing

v6.0

Integrate[((x (-3 I+3 (Sqrt[3])+(((-1))^(1/6)) (2^(1/3)) (3^(2/3)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(2/3))))/((2^(2/3)) (3^(5/6)) (((-9 x+(Sqrt[-12+81 (x^2)])))^(1/3)))),{x,0,(2/(3(Sqrt[3])))}]//Timing

Arc Length x(y)

ParametricPlot[Evaluate[{#,y}&/@ysoln[[{2,4}]]],{y,0,2/9(Sqrt[3])},PlotStyle->List/@{Red,Blue},
AspectRatio->Automatic,Epilog->{PointSize[.02],Point[{(Sqrt[2])/4,1/4}]},PlotRange->All]

dsy=Simplify[(Sqrt[1+((D[#,y])^2)])&/@ysoln[[{2,4}]]]

Numerical

2Plus@@(NIntegrate[#,{y,0,(1/4)}]&/@dsy)

l={Sqrt[1+(1+(y*(-1+6*y))/Sqrt[y^2-4*y^3])2/(8*(y-Sqrt[y^2-4*y^3]))],Sqrt[1-(y-6*y^2+Sqrt[y^2-4*y^3])2/(8*y^2*(-1+4*y)*(y+Sqrt[y^2-4*y^3]))]};

Plot[Evaluate[l],{y,0,1/4},PlotStyle->{Red,Blue}]

NIntegrate[l,{y,0,1/4},WorkingPrecision->150,MaxRecursion->20]//Timing

1st piece

res11=NIntegrate[dsy[[1]],{y,0,1/4},WorkingPrecision->500,PrecisionGoal->150,Method->{GlobalAdaptive,MaxRecursion->3000,MaxNumberOfErrorIncreases->100000}];//Timing

res12=NIntegrate[dsy[[1]],{y,0,1/4},WorkingPrecision->500,PrecisionGoal->200,Method->{GlobalAdaptive,MaxRecursion->3000,MaxNumberOfErrorIncreases->100000}];//Timing

N[Abs[res11-res12]]

Precision/@{res11,res12}

2nd piece

res1=NIntegrate[dsy[[2]],{y,0,1/4},WorkingPrecision->500,PrecisionGoal->150,Method->{GlobalAdaptive,MaxRecursion->3000,MaxNumberOfErrorIncreases->100000}];//Timing

res2=NIntegrate[dsy[[2]],{y,0,1/4},WorkingPrecision->500,PrecisionGoal->200,Method->{GlobalAdaptive,MaxRecursion->3000,MaxNumberOfErrorIncreases->100000}];//Timing

N[Abs[res1-res2]]

Together

res12+res2

Exact

2Plus@@(Integrate[#,{y,0,(1/4)}]&/@dsy)//Timing

Arc Length y(x)

Plot[Evaluate[xsoln[[{1,3}]]],{x,0,2/(3(Sqrt[3]))},PlotStyle->List/@{Red,Green,Blue},AspectRatio->Automatic,Epilog->{PointSize[.05],Point[{2/9(Sqrt[3]),2/9}]}]

dsx=Simplify[(Sqrt[1+((D[#,x])^2)])&/@xsoln[[{1,3}]]]

Numerical

2Plus@@(NIntegrate[#,{x,0,2/9(Sqrt[3])}]&/@dsx)

Exact

v5.1

2Plus@@(Integrate[#,{x,0,2/9(Sqrt[3])}]&/@dsx)//Timing

...hangs...

TimeConstrained[Integrate[dsx[[1]],{x,0,2/9(Sqrt[3])}],1800]//Timing

TimeConstrained[Integrate[dsx[[2]],{x,0,2/9(Sqrt[3])}],1800]//Timing

...hangs...

v6.0

2Plus@@(Integrate[#,{x,0,2/9(Sqrt[3])}]&/@dsx)//Timing

TimeConstrained[Integrate[dsx[[1]],{x,0,2/9(Sqrt[3])}],1800]//Timing

TimeConstrained[Integrate[dsx[[2]],{x,0,2/9(Sqrt[3])}],1800]//Timing

...hangs...