Solution to wave equation via d'Alambert

i.e. with traveling waves

Traveling waves based on a function

You may change 
the function definition and
the right endpoint L of the interval [0, L].

Clear[f,L, numTerms, numPeriods];
f[x_] :=Piecewise[{{ (1/10)x , 0 <= x < 10},{ (1/20)(30-x),10 <= x <30}}]

L=30;
Plot[f[x],{x,0,L}, 
PlotStyle->{Red,Thickness[0.01]},AxesLabel->{" x ", "f[x] "}]

You may change 
the min and max values for x and for y for graphing windows,
the maximum number of periods to show, 
and the parameter a which is the velocity of the traveling wave (a > 0)

Clear[minY, maxY,minX, maxX, numPeriods];
minY= -1.5; maxY = 1.5;
numPeriods = 3;
maxX = numPeriods * 2*L; minX = -  2*(numPeriods-1) * L;

Clear[a];
a=2;

Clear[tMax,tInc];
tMax = numPeriods*L/a;
tInc = tMax/10.;


Manipulate[
Plot[{f[x], f[x - a*t],f[x + a*t]},{x,minX, maxX}, 
PlotStyle->{{Red,Thickness[0.01]},{Blue,Dashed },{Purple}},
PlotRange->{minY,maxY},AxesLabel->{" x "}, PlotLabel->"Original f is red; right-moving wave f[x + a*t] is blue and dashed"],
{{t,0,"t"},0,tMax,tInc}]

an approximation to the initial displacement of the string

i.e. the partial sum for the Fourier sine series of f(x) = y(x, t=0)

numTerms = 10;

Clear[b];
Table[b[n]=2/L NIntegrate[f[x]Sin[n π x/L],{x,0,L}],{n,1,numTerms}];

Clear[PartialSineSum,t,n,m]
Print["A partial sum for the Fourier sine series"]
PartialSineSum[x_]=  Sum[b[n] Sin[n π x/L],{n,1,numTerms}]
Plot[{PartialSineSum[x],f[x]},{x,0,L},PlotStyle->{Blue,{Red,Thickness[0.01]}},AxesLabel->{" x "},
 PlotLabel->"Original f is red; partial Fourier sum is blue"]

approximate solution to the wave equation

graphically verify that the original f on [0, L] matches the solution at t=0.

Clear[y];
Print["Some terms in the wave eqn solution y[x,t]"]
y[x_,t_] = Sum[b[n] Sin[n π x/L] Cos[n π a t /L],{n,1,numTerms}]


Print["approximation to the wave eqn solution at t=0"]
y[x,0]

Show[Plot[y[x,0],{x,minX,maxX},PlotStyle->{Blue,Dashed},AxesLabel->{" x "}, PlotLabel->"f red; wave eqn approx at t=0 blue and dashed"],
Plot[f[x],{x,0,L},PlotStyle->{Red,Thickness[0.01]}]]

graphically see how 
the waves that travel from the original f on [0, L] 
meet the solution at t=0.

Manipulate[
Plot[{f[x], f[x - a*t],f[x + a*t],y[x,0]},{x,minX, maxX}, 
PlotStyle->{{Red,Thickness[0.01]},{Purple,Thickness[0.005] },{Purple,Thickness[0.005]},
{Brown}},
PlotRange->{minY,maxY},AxesLabel->{" x "}, PlotLabel->"f red; traveling waves purple; wave eqn approx at t=0 brown"],
{{t,0,"t"},0,tMax,tInc}]

graphically see how the wave equation solution changes over  time.

Manipulate[
Plot[y[x,t],{x,minX, maxX}, PlotRange->{minY,maxY},AxesLabel->{" x "}, 
PlotLabel->"slices of wave eqn approx as t changes"],
{{t,0,"t"},0,10,.05}]

Manipulate[
Plot[y[x,t],{t,0, 10}, PlotRange->{minY,maxY},AxesLabel->{" t "}, 
PlotLabel->"slices of wave eqn approx as x changes"],
{{x,minX,"x"},minX,maxX,.05}]

Plot3D[y[x,t],{x,minX, maxX}, {t, 0, 10}]

Plot3D[y[x,t],{x,0, L}, {t, 0, 5},AxesLabel->{"x,","t","y"}]