Goat Problem

Author

Eric W. Weisstein
April 17, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/GoatProblem.nb.

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

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

Code

A[R_,r_,d_]:=r^2 ArcCos[(d^2+r^2-R^2)/(2d r)]+R^2 ArcCos[(d^2+R^2-r^2)/(2d R)]-Sqrt[(-d+r+R)(d+r-R)(d-r+R)(d+r+R)]/2

Interior

Solve[A[1,r,1]==Pi/2,r]

exp=TrigToExp[-(1/2) (Sqrt[(2-r) (r^2) (2+r)])+(r^2) ArcCos[(r/2)]+ArcCos[(1/2) (2-(r^2))]]

FullSimplify[exp,0<r<2,ExcludedForms->{ArcCos}]

Plot[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)],{r,0,2},PlotStyle->Red,Epilog->{Blue,Dashing[{.02}],Line[{{0,π/2},{1.15872847301812151,π/2},{1.15872847301812151,0}}]},
AxesLabel->{r,A[r]}]

Simplify[exp,0<r<2]

FindRoot[%==Pi/2,{r,.1,1}]

rr=r/.FindRoot[A[1,r,1]==Pi/2,{r,.1,1},AccuracyGoal->100,WorkingPrecision->120]

cf=ContinuedFraction[rr,10]

FromContinuedFraction/@Reverse[NestList[Most,cf,9]]

A[1,rr,1]

N[Pi/2,30]

Integrate[Boole[x^2+y^2<1&&(x-1)^2+y^2<rr^2],{x,-Infinity,Infinity},{y,-Infinity,Infinity}]

V5

Show[Graphics[{
InequalityPlot[{x^2+y^2<1,(x-1)^2+y^2<r^2},{x,-2,2},{y,-2,2},Axes->False,DisplayFunction->Identity][[1]],
InequalityPlot[{x^2+y^2<1,(x-1)^2+y^2>r^2},{x,-2,2},{y,-2,2},Axes->False,DisplayFunction->Identity][[1]]/.Hue[x_]:>RGBColor[0,1,0],
PointSize[.05],Point[{1,0}],Line[{{1,0},{r Cos[#]+1,r Sin[#]}&[160Degree]}]
},AspectRatio->Automatic],DisplayFunction->$DisplayFunction]

V6

With[{r=1.15872847301812151782823350993350914968829226649209651182069588482066980255919609319932161073086043817593483082603184879195683415774134`120.},Graphics[{
RegionPlot[And@@{x^2+y^2<1,(x-1)^2+y^2<r^2},{x,-2,2},{y,-2,2},Axes->False,PlotStyle->Hue[.5]][[1]],
RegionPlot[And@@{x^2+y^2<1,(x-1)^2+y^2>r^2},{x,-2,2},{y,-2,2},Axes->False,PlotStyle->Green][[1]],
PointSize[.05],Point[{1,0}],Line[{{1,0},{r Cos[#]+1,r Sin[#]}&[160Degree]}]
}]]

Transcendental Root

FindRoot[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)]==(π/2),{r,1.1},WorkingPrecision->20]

Reduce[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)]==(π/2)&&r>0,r]

Reduce[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)]==(π/2)&&1<r<3/2,r]//Timing

TimeConstrained[Reduce[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)]==(π/2)&&1<r<2,r],60]//Timing

Reduce[-(1/2) r (Sqrt[4-(r^2)])+(r^2) ArcCos[(r/2)]+ArcCos[1-((r^2)/2)]==(π/2)&&0<r<2,r]//Timing

Exterior

Derivation

x[t_]:=a(Cos[t]+t Sin[t])
y[t_]:=a(Sin[t]-t Cos[t])

Simplify[x[t]^2+y[t]^2]

Simplify[x[t]y'[t]-y[t]x'[t]]

Solve[a^2 (1+t^2)==L^2+a^2,t]

p=Simplify[{x[t],y[t]}/.t->x/a/.a->1]

Simplify[Sqrt[p.p]]

Integrate[a^2 t^2,{t,0,L/a}]/2

π L^2/2+2%

%/.L->a π

area=((5 (a^2) (π^3))/6)

area/.a->L/π

Figure

TetheredBull[x_]:=Module[{p},
{
{Red,
p=ParametricPlot[{Cos[t]+t Sin[t],Sin[t]-t Cos[t]},
{t,0,x},AspectRatio->Automatic,
DisplayFunction->Identity,Axes->False][[1,1,1]],
Line[First/@(Reflection[Point[#],Line[{{0,0},{Cos[x],Sin[x]}}]]&/@p[[1]])]
},
{Thickness[.01],Circle[{0,0},1]},
PointSize[.05],
{Red,Point[{Cos[x]+x Sin[x],-x Cos[x]+Sin[x]}]},
Blue,
Point[{Cos[#],Sin[#]}&[x]],
Line[{Cos[x]+ x Cos[x+#Pi/2],
Sin[x]+x Sin[x+#Pi/2]}&/@{-1,1}],
Circle[{Cos[#],Sin[#]}&[x],x,{x-Pi/2,x+Pi/2}]
}
]

Show[GraphicsArray[Graphics[TetheredBull[#],
PlotLabel->TraditionalForm["\!\(\*
StyleBox[\"L\",\nFontSlant->\"Italic\"]\)/\!\(\*
StyleBox[\"R\",\nFontSlant->\"Italic\"]\) ="<>ToString[#]],
AspectRatio->Automatic,
PlotRange->All]&/@{.5,1.,2.1,Pi}],GraphicsSpacing->-.1]

Arc Tan Identity

FullSimplify[ArcTan[x]+ArcTan[((-x+Tan[x])/(1+x Tan[x]))]-x,0<x<2]

Plot[ArcTan[x]+ArcTan[((-x+Tan[x])/(1+x Tan[x]))]-x,{x,0,2.7}]

Plot[ArcTan[x]+ArcTan[((-x+Tan[x])/(1+x Tan[x]))]-x,{x,0,3}]