Pursuit Curve

Author

Eric W. Weisstein
March 16, 2008

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

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

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

Code

Pursuit[l_List,v_:1,{t_,t1_}]:=Module[
{s,a,vars,pairs,n=Length[l],soln,eqns},
vars=Map[#[t]&,Array[a,{n,2}],{2}];
pairs=Partition[vars,2,1,1];
eqns=Join[
Thread[D[Last[#],t]==v (s=Subtract@@#)/norm[s]]&/@pairs,
(Equal@@@Transpose[Flatten/@({Map[#[0]&,Array[a,{n,2}],{2}],l})])
];
soln=NDSolve[Evaluate[eqns],Flatten[vars],{t,0,t1}];
Partition[Map[Last,soln,{2}][[1]],2]
]

ClosedLine[l_List]:=Line[Append[l,First[l]]]

Old Code

Unit[l_]:=l/Sqrt[l.l]

PursuitCurve[a_,p0_,{t_,t0_,t1_,dt_},r_:1.,opts___]:=Module[
{
soln,curve,
x,y,f
},
soln=NDSolve[{
Unit[a-{x[t],y[t]}].{x'[t],y'[t]}==1,
x'[t]^2+y'[t]^2==1,
x[0]==p0[[1]],
y[0]==p0[[2]]
},{x[t],y[t]},{t,t0,t1}];
targetpath=ParametricPlot[a,{t,t0,t1},
DisplayFunction->Identity][[1]];
curve=ParametricPlot[Evaluate[{x[t],y[t]}/.soln],{t,t0,t1},
PlotRange->All,AspectRatio->Automatic,
DisplayFunction->Identity,
PlotStyle->Red][[1]];
d=D[a,t];
movie=Show/@Table[Graphics[{
Arrow[a,a+r d],
{Thickness[.02],targetpath},
{Dashing[{1,1}.02],Blue,
Line[{pt={x[t],y[t]}/.soln[[1]],a}]
},
{Red,curve},
{PointSize[.08],Point[a]},
{Blue,Arrow[pt,pt+r Unit[a-pt]]},
{Red,PointSize[.05],Point[pt]}
},
opts,
AspectRatio->Automatic],
{t,t0,t1,dt}]
]

Mice

p=With[{n=2},Pursuit[Through[{Cos,Sin}[2π #/n]]&/@Range[0,n-1],1,{t,1}]]

ListAnimate[Table[ParametricPlot[p,{t,0,t0},PlotStyle->{{Thickness[.02],Red}}],{t0,.1,1,.1}]]

Straight Line

Expand[(({0,t}-{x[t],y[t]}).{x'[t],y'[t]})^2-(x[t]^2+(t-y[t])^2)]//FullSimplify

D[x y'[x]-y[x],x]

DSolve[{x y''[x]-Sqrt[1+y'[x]^2]==0},y[x],x][[1,1]]

soln=FullSimplify[y[x]/.%]

PowerExpand[Together//@FullSimplify[x y''[x]-Sqrt[1+y'[x]^2]/.y->Function[x,(1/4) (E^(C[1])) (x^2)+C[2]-(1/2) (E^(-C[1])) Log[x]]]]

PowerExpand[FullSimplify[PowerExpand[Together//@FullSimplify[x y''[x]-Sqrt[1+y'[x]^2]/.y->Function[x,C[1] (x^2)+C[2]- Log[x]/(8C[1])]]]]]

Using DSolve

DSolve[{(1/(Sqrt[((x[t])^2)+(((t-y[t]))^2)])){-x[t],t-y[t]}.{x'[t],y'[t]}==1,x'[t]^2+y'[t]^2==1,x[0]==x0,y[0]==y0},{x[t],y[t]},t]

DSolve can't do it, so try plugging in equations derived by hand

FullSimplify[x0(Sqrt[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)]),t>0&&]

(expr=FullSimplify[With[{r0=(Sqrt[(x0^2)+(y0^2)]),χ=(((Sqrt[(x0^2)+(y0^2)])+y0)/((Sqrt[(x0^2)+(y0^2)])-y0))},((-x[t] x'[t]+(t-y[t]) y'[t])/(Sqrt[((x[t])^2)+(((t-y[t]))^2)]))/.{x->Function[t,x0(Sqrt[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)])],
y->Function[t,(1/4)(3y0-r0+(y0-r0)Log[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)]+(y0+r0)((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ))]}
]])//Timing

(expr=FullSimplify[With[{r0=(Sqrt[(x0^2)+(y0^2)]),χ=(((Sqrt[(x0^2)+(y0^2)])+y0)/((Sqrt[(x0^2)+(y0^2)])-y0))},((-x[t] x'[t]+(t-y[t]) y'[t])/(Sqrt[((x[t])^2)+(((t-y[t]))^2)]))/.{x->Function[t,x0(Sqrt[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)])],
y->Function[t,(1/4)(3y0-r0+(y0-r0)Log[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)]+(y0+r0)((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ))]}
],t>0&&(x0|y0)∈Reals])//Timing

Plot[Evaluate[expr/.{x0->1,y0->1.5}],{t,0,5},PlotStyle->Red]

speed=FullSimplify[With[{r0=(Sqrt[(x0^2)+(y0^2)]),χ=(((Sqrt[(x0^2)+(y0^2)])+y0)/((Sqrt[(x0^2)+(y0^2)])-y0))},x'[t]^2+y'[t]^2/.{x->Function[t,x0(Sqrt[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)])],
y->Function[t,(1/4)(3y0-r0+(y0-r0)Log[((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ)]+(y0+r0)((ProductLog[χ Exp[χ-4t/(r0-y0)]])/χ))]}
]]

Initial Conditions

y[x_]:=C[1] (x^2)+C[2]- Log[x]/(8C[1])

FullSimplify[Solve[{y[x0]==y0,y'[x0]==y0/x0},{C[1],C[2]}]]

FullSimplify[y[x]/.{C[2]->(1/4) (3 y0-2 y0 Log[x0]+(Sqrt[(x0^2)+(y0^2)]) (-1+2 Log[x0])),C[1]->((y0+(Sqrt[(x0^2)+(y0^2)]))/(4 (x0^2)))}]

y[x_,{x0_,y0_}]:=Module[{eta=(x/x0)^2,r0=Sqrt[x0^2+y0^2]},
((y0+r0)eta+(y0-r0)Log[eta]+3y0-r0)/4
]

y[x0,{x0,y0}]

Inflection Point

FullSimplify[D[y[x,{x0,y0}],x]]

Simplify[Factor[((x^2)+(x0^2)) y0+(x-x0) (x+x0)r0]]

Solve[r0 ((x^2)-(x0^2))+((x^2)+(x0^2)) y0==0,x]

Solve[((x^2)+(x0^2)) y0+(x^2-x0^2) r0==0,x]

xmin=x0 Sqrt[(r0-x0)/(r0+x0)]

FullSimplify[y[xmin,{x0,y0}]/.Sqrt[x0^2+y0^2]->r0]

Together[-1+((2 r0)/(r0+x0))]

ymin=-1/2(( (r0 x0-2 r0 y0-x0 y0))/(r0+x0))+1/4(y0-r0) Log[((r0-x0)/(r0+x0))]

Simplify[((y[xmin,{x0,y0}]/.Sqrt[x0^2+y0^2]->r0)-ymin)/.Log[x_]^2:>2Log[x]]

As a function of time

x(t)

FullSimplify[x D[y[x,{x0,y0}],x]-y[x,{x0,y0}]/.Sqrt[x0^2+y0^2]->r0]

Solve[((η-1)c1+c2 Log[η])/4==t,η]

FullSimplify[%/.{c1->(r0+y0),c2->(r0-y0)}]

xt[t_,{x0_,y0_}]:=Module[{r0=Sqrt[x0^2+y0^2],chi},
chi=(r0+y0)/(r0-y0);
x0 Sqrt[ProductLog[chi Exp[chi-4t/(r0-y0)]]/chi]
]

x0 Sqrt[ProductLog[chi Exp[chi-4t/(r0-y0)]]/chi]

x0 (Sqrt[((ProductLog[chi (E^(chi+((4 t)/(r0-y0))))])/chi)])/.t->0/.ProductLog[Exp[c_]c_]/c_:>1

y(t)

FullSimplify[y[x0 Sqrt[ProductLog[χ Exp[χ-4t/(r0-y0)]]/χ],{x0,y0}]/.(Sqrt[(x0^2)+(y0^2)])->r0]

FullSimplify[%/.t->0,χ>1]

Simplify[%/.ProductLog[(E^χ) χ]->χ]

yt[t_,{x0_,y0_}]:=Module[{r0=Sqrt[x0^2+y0^2],chi},
χ=(r0+y0)/(r0-y0);(1/4)*(-r0+3*y0+(-r0+y0)*Log[ProductLog[E^(-(4*t)/(r0-y0)+χ)χ]/χ]+((r0+y0)*ProductLog[E^(-(4*t)/(r0-y0)+χ)*χ])/χ)
]

xt[0,{1.,1.}]

Plots of numerical and analytic

soln=NDSolve[{
({0,t}-{x[t],y[t]}).{x'[t],y'[t]}==Sqrt[x[t]^2+(t-y[t])^2],
x'[t]^2+y'[t]^2==1,
x[0]==1,y[0]==1
},{x[t],y[t]},{t,0,3}]

With[{x0=1,y0=1},
rr0=Sqrt[x0^2+y0^2];
xmin=x0 Sqrt[(rr0-x0)/(rr0+x0)];
Show[{
Plot[y[x,{x0,y0}],{x,0,1},PlotStyle->{Dashing[{1,1}.05],Thickness[.02],Red},DisplayFunction->Identity],
ParametricPlot[{xt[t,{x0,y0}],yt[t,{x0,y0}]},{t,0,2},PlotStyle->{Dashing[{1,2}.02],Thickness[.02],Green},
DisplayFunction->Identity],
ParametricPlot[Evaluate[{x[t],y[t]}/.soln],{t,0,2},DisplayFunction->Identity],
Graphics[{Blue,PointSize[.07],Point[{xmin,y[xmin,{x0,y0}]}]}]
},DisplayFunction->$DisplayFunction,AspectRatio->Automatic,
Axes->True]
]

Animation

movie=PursuitCurve[{0,t},{1,1},{t,0,2,.05},.2,PlotRange->{{-.1,1.1},{-.1,2.1}}]

<<Utilities`GIF`

Export[gifs<>"pursuit.gif",movie]//Timing

PursuitCurve[{0,t},{1,-1},{t,0,2,.05},.2,PlotRange->{{-.1,1.1},{-1.1,2.1}}]

Circle

<<GIF`

Oscillating Collisional Path

Export[gifs<>"purscir1.gif",PursuitCurve[{Cos[t],Sin[t]},{5,5},{t,0,15,.3},1,PlotRange->{{-1.5,5.2},{-1.5,5.2}}]]//Timing

Oscillating Following Path

Export[gifs<>"purscir2.gif",PursuitCurve[{Cos[t],Sin[t]},{10,10},{t,0,20,.5},1.5,PlotRange->{{-1.5,10.3},{-1.5,10.3}}]]//Timing

Looping Following Path

Export[gifs<>"purscir3.gif",PursuitCurve[{Cos[t],Sin[t]},{2,2},{t,0,10,.2},1.,PlotRange->{{-1.5,2.5},{-1.5,2.5}}]]//Timing

Starting Inside Circle

PursuitCurve[{Cos[t],Sin[t]},{0,0},{t,0,2,.1},1.,PlotRange->{{-1.5,2.5},{-1.5,2.5}}]

Export[gifs<>"purscir4.gif",PursuitCurve[{Cos[t],Sin[t]},{0,-1},{t,0,6.2,.1},1.,PlotRange->{{-1.5,1.5},{-1.5,1.5}}]]//Timing

Ellipse

PursuitCurve[{1.5Cos[t],Sin[t]},{5,5},{t,0,20,.3},1,PlotRange->{{-1.5,5.2},{-1.5,5.2}}]

PursuitCurve[{1.5Cos[t],Sin[t]},{5,0},{t,0,20,.3},1,PlotRange->{{-1.5,5.2},{-1.5,5.2}}]