Example: Hanging Chain

Example page 303 (Section 6.3)

g=9.8;
L=1;

f[x_]:=If[x<1/2,x/100,(1-x)/100];
v[x_]=0;

(Subscript[α, n_]):=BesselJZero[0,n]

(Subscript[A, n_]):=(1/(L ((BesselJ[1,(Subscript[α, n])])^2) ))(∫_0^L)f[x]BesselJ[0,(Subscript[α, n])(Sqrt[(x/L)])]\[DifferentialD]x
(Subscript[B, n_]):=(2/((Subscript[α, n]) ((BesselJ[1,(Subscript[α, n])])^2) ))(1/(Sqrt[g L]))(∫_0^L)v[x]BesselJ[0,(Subscript[α, n])(Sqrt[(x/L)])]\[DifferentialD]x

Let's have Mathematica do the integrals for us. We have to truncate the series.

sol[x_,t_,k_]:=(∑_(n=1)^k) BesselJ[0, (Subscript[α, n])(Sqrt[(x/L)])]((Subscript[A, n]) Cos[(Sqrt[(g/L)])(( (Subscript[α, n]))/2) t]+(Subscript[B, n]) Sin[(Sqrt[(g/L)])(( (Subscript[α, n]))/2) t])
solution[x_,t_]=sol[x,t,4]//N

Let's plot!

Manipulate[Plot[solution[x,t],{x,0,1},PlotRange->{{0,1},{-0.01,0.01}},ImageSize->{400,Automatic},PlotStyle->{RGBColor[0.8,0,0.8]}],{t,0,1,1/30}]

If we treat the plot as an implicit function, and flip x and u, we can get a plot that shows the chain hanging.

tfinal=3.0;
nsteps=45;
Manipulate[ContourPlot[solution[u,t]==x,{x,-0.02,0.02},{u,0,1},Axes->False,ImageSize->{400,Automatic},ContourStyle->{RGBColor[0.8,0,0.8]},AspectRatio->1],{t,0,tfinal,tfinal/nsteps}]

Example: Hanging Chain with Kicks

Check out this article.

g=1.0;
L=1.0;

f[x_]:=0;
v[x_]=If[x<0.025,1.0,0.0];

(Subscript[α, n_]):=BesselJZero[0,n]

(Subscript[A, n_]):=(1/(L ((BesselJ[1,(Subscript[α, n])])^2) ))(∫_0^L)f[x]BesselJ[0,(Subscript[α, n])(Sqrt[(x/L)])]\[DifferentialD]x
(Subscript[B, n_]):=(2/((Subscript[α, n]) ((BesselJ[1,(Subscript[α, n])])^2) ))(1/(Sqrt[g L]))(∫_0^L)v[x]BesselJ[0,(Subscript[α, n])(Sqrt[(x/L)])]\[DifferentialD]x

Let's have Mathematica do the integrals for us. We have to truncate the series.

sol[x_,t_,k_]:=(∑_(n=1)^k) BesselJ[0, (Subscript[α, n])(Sqrt[(x/L)])]((Subscript[A, n]) Cos[(Sqrt[(g/L)])(( (Subscript[α, n]))/2) t]+(Subscript[B, n]) Sin[(Sqrt[(g/L)])(( (Subscript[α, n]))/2) t])
solution[x_,t_]=sol[x,t,50]//N

Let's plot!

Here is a plot of what the displacement of the tip (x=0) is doing, and the kicks are very evident.

Plot[solution[0,t],{t,0,32},ImageSize->{400,Automatic},PlotRange->{Automatic,{-0.4,0.4}},PlotStyle->{Red},AspectRatio->1]

If we treat the plot as an implicit function, and flip x and u, we can get a plot that shows the chain hanging.

tfinal=10.0;
nsteps=50;
Manipulate[ContourPlot[solution[u,t]==x,{x,-0.4,0.4},{u,0,1},ImageSize->{400,Automatic},PlotStyle->{Red},AspectRatio->1],{t,0,tfinal,tfinal/nsteps}]