Assignment 6

Note:  I have not attempted to use different symbols for different problems.  Therefore, 
              it is probably a good idea to quit the kernel when you begin evaluations under 
              each problem heading.  This will clear all the variables.

Problem 1

Plot[Sum[4 Sin[(2 k+1) Pi x/2]/((2 k+1) Pi),{k,0,10}],{x,-1,3}]

Plot[Sum[-4 Sin[(2 k+1) Pi x]/((2 k+1) Pi),{k,0,10}],{x,-1,3}]

coeffodd[k_,t_]= 16 (1-E^(-(2 k+1)^2 Pi^2 t^2/4)) /((2 k+1)^3 Pi^3);
coeffevenodd[k_,t_]=- 4 E^(-(2 k+1)^2 Pi^2 t)/((2 k+1) Pi);

oddseries[x_,t_,ell_]:=Sum[coeffodd[k,t] Sin[(2 k+1) Pi x/2],{k,0,ell}];
evenoddseries[x_,t_,ell_]:=Sum[coeffevenodd[k,t] Sin[(2 k+1) Pi x],{k,0,ell}];

totalseries[x_,t_,ell_]:=oddseries[x,t,ell]+evenoddseries[x,t,ell]

plotseries[x_,t_]=totalseries[x,t,30];

Plot[plotseries[x,0],{x,0,2},PlotStyle->{Black,Black,Black}]

Animate[Plot[plotseries[x,t],{x,0,2},PlotRange->{-1.5,1.5},PlotStyle->{Black,Black,Black}],{t,0,0.01}]

Plot[{-1,1,plotseries[x,0.0001]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

Plot[{-1,1,plotseries[x,0.0001]},{x,0,2},PlotRange->{{0,0.2},{-1-0.1,-1+0.1}},AspectRatio->Automatic,PlotStyle->{Black,Black,Black}]

Plot[{-1,1,plotseries[x,0.0001]},{x,0,2},PlotRange->{{2-0.2,2},{1-0.1,1+0.1}},AspectRatio->Automatic,PlotStyle->{Black,Black,Black}]

Plot[{-1,1,plotseries[x,0.001]},{x,0,2},PlotStyle->{Black,Black,Black}]

Plot[{-1,1,plotseries[x,0.01]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

lateplotseries[x_,t_]=totalseries[x,t,10];

Plot[{-1,1,lateplotseries[x,0.015]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

Plot[{-1,1,lateplotseries[x,0.02]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

Plot[{-1,1,lateplotseries[x,0.025]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

Plot[{-1,1,lateplotseries[x,0.03]},{x,0,2},PlotStyle->{Black,Black,Black}]

Plot[{-1,1,lateplotseries[x,0.04]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}]

endplot[t_]:=Show[Plot[{-1,1,lateplotseries[x,t]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}],ListPlot[{{1/2,lateplotseries[1/2,t]},{1,lateplotseries[1,t]},{3/2,lateplotseries[3/2,t]}},PlotStyle->{AbsolutePointSize[6],Black}]]

endplot[0.05]

endplot[0.075]

endplot[0.1]

bendplot[t_]:=Show[Plot[{-0.5,0.5,lateplotseries[x,t]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}],ListPlot[{{1/2,lateplotseries[1/2,t]},{1,lateplotseries[1,t]},{3/2,lateplotseries[3/2,t]}},PlotStyle->{AbsolutePointSize[6],Black}],AspectRatio->Automatic]

bendplot[0.1]

bendplot[0.15]

bplotseries[x_,t_]=totalseries[x,t,5];

blendplot[t_]:=Show[Plot[{-0.5,0.5,bplotseries[x,t]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}],ListPlot[{{1/2,bplotseries[1/2,t]},{1,bplotseries[1,t]},{3/2,bplotseries[3/2,t]}},PlotStyle->{AbsolutePointSize[6],Black}],AspectRatio->Automatic]

blendplot[0.2]

blendplot[0.25]

blendplot[0.3]

blendplot[0.35]

Animate[blendplot[t],{t,0.02,0.5}]

Animate[blendplot[t],{t,0.4,0.58}]

Show[blendplot[0.58],Plot[t (2-t)/2,{t,0,2},PlotStyle->{Dashed,Black}]]

Show[blendplot[0.58],Plot[t (2-t)/2,{t,0,2},PlotStyle->{Dashed,Black}]]

cplotseries[x_,t_]=totalseries[x,t,4];

clendplot[t_]:=Show[Plot[{-0.5,0.5,cplotseries[x,t]},{x,0,2},PlotStyle->{{Black,Dashed},{Black,Dashed},Black}],ListPlot[{{1/2,cplotseries[1/2,t]},{1,cplotseries[1,t]},{3/2,cplotseries[3/2,t]}},PlotStyle->{AbsolutePointSize[6],Black}],Plot[x (2-x)/2,{x,0,2},PlotStyle->{Dashed,Black}],AspectRatio->Automatic]

clendplot[0.6]

clendplot[0.8]

clendplot[0.87]

Plot3D[cplotseries[x,t],{x,0,2},{t,0.001,0.9},ViewPoint->{1.3, 1.4, 2.}]

Problem 2

Part (d)

Decreasing and then increasing

N[Sqrt[2]/2-3/( (4 Sqrt[2])^(4/3) )]

v[x_,t_]=(1-E^(-Pi^2 t/4)) Sin[Pi x/2];
w[x_,t_]= - E^(-Pi^2 t) Sin[Pi x];
utwo[x_,t_]=v[x,t]+w[x,t];

Plot[{utwo[3/2,t],Sqrt[2]/2},{t,0,2},AxesOrigin->{0,0},PlotStyle->{Black,Dashed}]

utwot[x_,t_]=D[utwo[x,t],t]

utwo[3/2,t]

utwot[3/2,t]

Simplify[ Expand[4 Sqrt[2] E^(-Pi^2 t) utwot[3/2,t]]]

tmin=4 Log[4 Sqrt[2]]/(3 Pi^2)

N[utwo[3/2,tmin]]

N[Sqrt[2]/2]

utwott[x_,t_]=D[utwot[x,t],t]

utwott[3/2,t]

utwott[3/2,tmin]

Large Forcing

Plot[{Pi^2 Sin[Pi x],9 Pi^2 Sin[Pi x/2]/4},{x,0,2},PlotStyle->{Black,{Black,Dashed}}]

utwoalpha[x_,t_,alpha_]=alpha v[x,t]+w[x,t];

Animate[Plot[utwoalpha[x,t,9],{x,0,2},PlotRange->{{0,2},{-2,10}}],{t,0,1}]

Show[Plot[9 Sin[Pi x/2],{x,0,2},PlotStyle->{Black,Dashed}],Plot[{utwoalpha[x,0,9],utwoalpha[x,0.03,9],utwoalpha[x,0.06,9],utwoalpha[x,0.09,9],utwoalpha[x,0.12,9],utwoalpha[x,0.15,9],utwoalpha[x,0.3,9],utwoalpha[x,1,9]},{x,0,2},PlotStyle->{Black,{Black,Dashing[0.01]},{Black,Dashing[0.02]},{Black,Dashing[0.03]},{Black,Dashing[0.04]},{Black,Dashing[0.05]},{Black,Dashing[0.06]},{Black,Dashing[0.07]}}],PlotRange->All]

Part (e)

Animate[Plot[utwo[x,t],{x,0,2},PlotRange->{{0,2},{-2,2}}],{t,0,1}]

Show[Plot[Sin[Pi x/2],{x,0,2},PlotStyle->{Black,Dashed}],Plot[{utwoalpha[x,0,1],utwoalpha[x,0.03,1],utwoalpha[x,0.06,1],utwoalpha[x,0.09,1],utwoalpha[x,0.12,1],utwoalpha[x,0.15,1],utwoalpha[x,0.3,1],utwoalpha[x,1,1]},{x,0,2},PlotStyle->{Black,{Black,Dashing[0.01]},{Black,Dashing[0.02]},{Black,Dashing[0.03]},{Black,Dashing[0.04]},{Black,Dashing[0.05]},{Black,Dashing[0.06]},{Black,Dashing[0.07]}}],PlotRange->All]

Show[Plot[Sin[Pi x/2],{x,0,2},PlotStyle->{Black,Dashed}],Plot[{v[x,0],v[x,0.03],v[x,0.06],v[x,0.09],v[x,0.12],v[x,0.15],v[x,0.3],v[x,1]},{x,0,2},PlotStyle->{Black,{Black,Dashing[0.01]},{Black,Dashing[0.02]},{Black,Dashing[0.03]},{Black,Dashing[0.04]},{Black,Dashing[0.05]},{Black,Dashing[0.06]},{Black,Dashing[0.07]}}],PlotRange->All,AspectRatio->Automatic]

Show[Plot[Sin[Pi x/2],{x,0,2},PlotStyle->{Black,Dashed}],Plot[{w[x,0],w[x,0.03],w[x,0.06],w[x,0.09],w[x,0.12],w[x,0.15],w[x,0.3],w[x,1]},{x,0,2},PlotStyle->{Black,{Black,Dashing[0.01]},{Black,Dashing[0.02]},{Black,Dashing[0.03]},{Black,Dashing[0.04]},{Black,Dashing[0.05]},{Black,Dashing[0.06]},{Black,Dashing[0.07]}}],PlotRange->All,AspectRatio->Automatic]

Problem 3

Plot[{Sin[Pi x/2],Sin[3 Pi x/2]},{x,0,1}]

orthiplier[j_,k_]:=Integrate[Sin[(1+2 j) Pi x/2] Sin[(1+2 k) Pi x/2],{x,0,1}]

orthiplier[0,0]

orthiplier[0,1]

orthiplier[0,2]

orthiplier[1,1]

Plot[Sin[Pi x],{x,0,1}]

Integrate[Sin[(1+2 j) Pi x/2] Sin[Pi x],{x,0,1}]

athree[j_]=8 (-1)^(j+1)/((2 j-1) (2 j+3) Pi);

sthree[x_,k_]:=Sum[athree[j] Sin[(2 j+1) Pi x/2],{j,0,k}]

Plot[{sthree[x,4],Sin[Pi x]},{x,0,1}]

That’s not looking too bad for only four terms.

Plot[{sthree[x,10],Sin[Pi x]},{x,0,1}]

Plot[{sthree[x,100],Sin[Pi x]},{x,0,1}]

Looks like I’ve got it.

endvalue[t_,k_]:=1-Sum[8 Cos[(2 j+1) Pi t/2]/((2 j-1) (2 j+3) Pi),{j,0,k}]

Plot[endvalue[t,100],{t,0,10},PlotStyle->Black]

This is, of course, quite interesting.  It would be nice to see the endpoint moving in an 
animation to see if this makes sense.  (In fact it sort of does.)  But we have a bit of a problem.

wvalue[x_,t_,k_]:=x+Sum[8 (-1)^(j+1) Cos[(2 j+1) Pi t/2] Sin[(2 j+1) Pi x/2]/((2 j-1) (2j+3) Pi),{j,0,k}]

step[a_,b_,k_,j_]=a+j (b-a)/k;

Here is the initial deformation:

ListPlot[Table[{wvalue[step[0,1,20,indj],0,50],0},{indj,0,20}],PlotStyle->{Black,AbsolutePointSize[5]},PlotRange->{{-.01,1.6},{-0.1,0.1}}]

It looks like the admissibility w_x > 0 is violated.  We can confirm by plotting the deformation:

Plot[wvalue[x,0,50],{x,0,1},PlotStyle->Black]

We should be able to fix this by starting with a smaller initial deformation whose 
derivative does not exceed 1.

fixwvalue[x_,t_,k_]:=x+(1/8) Sum[8 (-1)^(j+1) Cos[(2 j+1) Pi t/2] Sin[(2 j+1) Pi x/2]/((2 j-1) (2j+3) Pi),{j,0,k}]

Plot[fixwvalue[x,0,50],{x,0,1},PlotStyle->Black]

Okay, so that problem is fixed.  We should check that the endpoint still has the interesting behavior:

fixendvalue[t_,k_]:=1-(1/8) Sum[8 Cos[(2 j+1) Pi t/2]/((2 j-1) (2 j+3) Pi),{j,0,k}]

Plot[fixendvalue[t,100],{t,0,10},PlotStyle->Black]

Indeed, it looks about the same, just with smaller magnitude.

ListPlot[Table[{fixwvalue[step[0,1,20,indj],0,50],0},{indj,0,20}],PlotStyle->{Black,AbsolutePointSize[5]}]

Animate[ListPlot[Table[{fixwvalue[step[0,1,20,indj],t,50],0},{indj,0,20}],PlotStyle->{Black,AbsolutePointSize[5]},PlotRange->{{-0.1,1.5},{-0.1,0.1}}],{t,0,10}]

Problem 4

Fundamental Mode

L = beta = 1:

omegaonesmall=Sqrt[Pi^2-1/4];
uonesmall[x_,t_]=E^(-t/2) Cos[omegaonesmall t] Sin[Pi x];

Animate[Plot[uonesmall[x,t],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,10}]

beta = 2 pi

uonecrit[x_,t_]=E^{-Pi t} (1+Pi t) Sin[Pi x];

Animate[Plot[uonecrit[x,t],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,10}]

Starting at the equilibrium position:

uonecritz[x_,t_]=t E^(-Pi t)  Sin[Pi x];

Here is a computation to find the maximum amplitude of this critically damped oscillation.

turn[t_]=D[uonecritz[1/2,t],t]

Plot[turn[t],{t,0,1}]

ttop=FindRoot[turn[tfind]==0,{tfind,0.3}][[1,2]]

topval=uonecritz[1/2,ttop];

Animate[Plot[uonecritz[x,t],{x,0,1},PlotRange->{{0,1},{0,topval}},PlotStyle->Black],{t,0,10}]

Challenge Problem

Animate[Plot[uonecritz[x,t],{x,0,1},PlotRange->{{0,1},{-1,topval}},PlotStyle->Black],{t,-0.3,2}]

Higher Modes

underdamped second mode 
I’m going to make beta smaller here, so we can see the oscillations.
beta = 1/5

omegatwosmall=Sqrt[4 Pi^2-1/100];
utwosmall[x_,t_]=E^(-t/10) Cos[omegatwosmall t] Sin[2 Pi x];

Animate[Plot[utwosmall[x,t],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,30}]

critically damped third mode
beta = 2 j pi/L = 6 pi
(Note: this animation also relates to a “question for further study” posed in the solutions)

uthreecrit[x_,t_]=E^{-3 Pi t} Sin[3 Pi x];

Animate[Plot[uthreecrit[x,t],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,1}]

for small time and negative time:

Animate[Plot[uthreecrit[x,t],{x,0,1},PlotRange->{{0,1},{-3,3}},PlotStyle->Black],{t,-0.1,0.1}]

Evidently this evolution starts with nonzero velocity in the direction of decay;  we know it does not start with zero velocity.  Conjecture:  This is the initial value problem starting from the position of “full extension” of the third wave form with maximum velocity in the direction of decay which does not pass (once) through equilibrium.

Mixing Modes

beta = 1/5

omegaonesmallz=Sqrt[Pi^2-1/100];
uonesmallz[x_,t_]=E^(-t/10) Cos[omegaonesmallz t] Sin[Pi x];

Animate[Plot[uonesmallz[x,t],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,10}]

utwosmallz[x_,t_,atwo_,btwo_]=E^(-t/10) (atwo Cos[omegatwosmall t]+btwo Sin[omegatwosmall t]) Sin[2 Pi x];

A small multiple of utwosmallz with atwo = 1 and btwo = 0:

Animate[Plot[utwosmallz[x,t,1,0],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,30}]

Animate[Plot[uonesmallz[x,t]+0.2 utwosmallz[x,t,1,0],{x,0,1},PlotRange->{{0,1},{-1,1}},PlotStyle->Black],{t,0,20}]

A larger multiple of utwosmallz same initial conditions:

Animate[Plot[uonesmallz[x,t]+utwosmallz[x,t,1,0],{x,0,1},PlotRange->{{0,1},{-2,2}},PlotStyle->Black],{t,0,20}]

small multiple with nonzero initial velocity in the second mode---changing the phase shift

Animate[Plot[uonesmallz[x,t]+0.2 utwosmallz[x,t,1/Sqrt[2],1/Sqrt[2]],{x,0,1},PlotRange->{{0,1},{-1,2}},PlotStyle->Black],{t,0,20}]

larger multiple

Animate[Plot[uonesmallz[x,t]+ utwosmallz[x,t,1/Sqrt[2],1/Sqrt[2]],{x,0,1},PlotRange->{{0,1},{-2,2}},PlotStyle->Black],{t,0,20}]

even larger multiple

Animate[Plot[uonesmallz[x,t]+ 2 utwosmallz[x,t,1/Sqrt[2],1/Sqrt[2]],{x,0,1},PlotRange->{{0,1},{-2.5,2.5}},PlotStyle->Black],{t,0,20}]

Okay, perhaps that is enough of this.  If we have greater damping, then the lower modes will damp out quickly while the higher (underdamped) modes continue to oscillate.

Underdamped Square Wave

Here we use CASE 1 with beta = 1/5
u_0 = 1 and v_0 = 0

acoeffsmall[j_]:=2 Integrate[Sin[j Pi xi],{xi,0,1}]
omega[j_]=Sqrt[j^2 Pi^2 - 1/100];
bcoeffsmall[j_]:=acoeffsmall[j]/(10 omega[j])

acoeffsmall[j]

squaresmall[x_,t_,k_]:=E^(-t/10) Sum[ (acoeffsmall[j] Cos[omega[j] t]+bcoeffsmall[j] Sin[omega[j] t]) Sin[j Pi x],{j,1,k}]

squaresmalltest[x_,t_]=squaresmall[x,t,50];

Plot[squaresmalltest[x,0],{x,0,1},AxesOrigin->{0,0},PlotRange->{0,1.2}]

squaresmalltest[0.1,0.1]

Plot[squaresmalltest[x,0.1],{x,0,1},AxesOrigin->{0,0},PlotRange->{0,2}]

Animate[Plot[squaresmalltest[x,t],{x,0,1},PlotRange->{{0,1},{-1.5,1.5}},PlotStyle->Black],{t,0,10}]

Animate[Plot[squaresmalltest[x,t],{x,0,1},PlotRange->{{0,1},{-1.5,1.5}},PlotStyle->Black],{t,0,20}]

Square Wave with critical damping in the first mode.

beta = 2 pi

squarecrit[x_,t_,k_]:=E^(-Pi t) acoeffsmall[1] (1 +Pi  t) Sin[Pi x]+E^(-Pi t) Sum[ (acoeffsmall[j] Cos[omega[j] t]+bcoeffsmall[j] Sin[omega[j] t]) Sin[j Pi x],{j,2,k}]

squarecrittest[x_,t_]=squarecrit[x,t,50];

Animate[Plot[squarecrittest[x,t],{x,0,1},PlotRange->{{0,1},{-1.5,1.5}},PlotStyle->Black],{t,0,1}]

Problem 5

This is sort of standard by now.  
I’ll use the function “step” and give the horizontal representation first:

wstar[x_]=- x^2/2 + 3 x/2;

step[a_,b_,k_,j_]=a+j (b-a)/k;

Here are the representative points in the parameter domain of the continuum without sagging:

ListPlot[Table[{step[0,1,20,j],0},{j,0,20}],PlotStyle->{Black,AbsolutePointSize[5]}]

ListPlot[Table[{wstar[step[0,1,20,j]],0},{j,0,20}],PlotStyle->{Black,AbsolutePointSize[5]}]

Here is the vertical view:

y[x_]=-wstar[x];

Show[ParametricPlot[{{t,0},{t,-1}},{t,-0.1,0.1},PlotStyle->{Black,Black},Ticks->False,Axes->None],ListPlot[Table[{0,y[step[0,1,20,j]]},{j,0,20}],PlotStyle->{Black,AbsolutePointSize[5]}]]

Plot[x (1-x)/2,{x,0,1},PlotStyle->Black,AspectRatio->Automatic]