Waves For High Schoolers

A Fourier into Mathematica

Vaishnavi Giridaran, Karolina Kalbarczyk, Nish Nookala, Kareem Sayegh

Outline

We wanted to gain an in-depth understanding of differential equations to ultimately detect defects in 3-Dimensional solids through the analysis of wave reflections.

Derive the Wave Equation for a String

Model it using Mathematica

Derive the Two-String Equation

Model it using Mathematica

... and create Presentation...

Done!

The Single String Problem

We initially pluck a string that is anchored, under tension, at both ends and investigate its motion over time.

Definition of Problem

Newton' s Second Law:Fnet =ma
T1cosθ1 =T2cosθ2 =T

ΣFy =my''->-T1sinθ1 -T2sinθ2 =(ρΔx=mass)y''

((-T1sinθ1)/T) - ((T2sinθ2)/T)  =((ρΔxy'')/T)
=((-T1sinθ1)/(T1cosθ1))-((T2sinθ2)/(T2cosθ2 )) =((ρΔxy'')/T)
=-tan(θ1)-tan(θ2)=((ρΔxy'')/T)=((-dy)/dx) 
=(lim_(Δx->0))(1/(Δx))(((d^2)y)/(dx^2)) =((ρy'')/T)

The Single String Problem

The initial problem invesigates the motion of an anchored string from the moment that it is plucked based on the properties of that string. 

(c^2)(((∂^2)u(x,t))/(∂(x^2)))=(((∂^2)u(x,t))/(∂(t^2)))

u(x,t) has the following conditions.
Boundary Conditions
	u(0,t)=0
	u(L,t)=0

Initial Conditions:
u(x,0)=W(x)
	((∂u(x,0))/(∂t))=0

Product Decomposition

Now we make the assumption that u(x,t) is the product of two functions F(x) and G(t), thus:
	u(x,t)=F(x)G(t)
We double differentiate with respect to x, and get:
		(((∂^2)u(x,t))/(∂(x^2)))= F''(x)G(t)
and now with respect to t:
		(((∂^2)u(x,t))/(∂(t^2)))= F(x)G''(t)

Substitution

If we substitute these into our initial PDE we get:
	(c^2)F''(x)G(t)=G''(t)F(x)
and dividing both sides by F(x)G(t) we get:
		(c^2)((F''(x))/(F(x)))=((G''(t))/(G(t)))
If we analyze this equation, we find that it is equal to a constant.  To verify this, differentiate both sides with respect to x, obtaining:
		(d/dx)[(c^2)((F''(x))/(F(x)))]= 0

The Constant

If we then integrate both sides with respect to x, we obtain:
(c^2)((F''(x))/(F(x)))= a constant 
Thus,
	(c^2)((F''(x))/(F(x)))=((G''(t))/(G(t)))=a constant 
We choose a constant, -((γ^2)) for reasons which will become evident later.

Solving the Ordinary Differential Equations (ODE)

(c^2) ((F'' (x))/(F(x))) = ((G'' (t))/(G(t)))=-(λ^2)

Two Ordinary Differential Equations (ODE)
({{(c^2)((F''(x))/(F(x))), ((G''(t))/(G(t)))}, {Guess a solution of this form, Guess a solution of this form }, {F(x) = (Ae^rx)
F(x) ≠0
A≠0
F''(x) =(r^2)(Ae^rx), G(t)=(Ae^mt)
G(t)≠0
A≠0
G''(t)=(m^2)(Ae^mt)}, {(c^2)((((r^2)(Ae^rx)))/(Ae^rx))=(c^2)(r^2)=-(λ^2), ((((m^2)(Ae^mx)))/(Ae^me))=(m^2)=-(λ^2)}, {r=((±iλ)/c), m=±iλ}, {F(x)=(Ae^(((iλ)/c)x))+(Be^(((-iλ)/c)x)), G(t)=(Ce^(iλt))+(De^(-iλt))}})

Solving the PDE with the ODE

Now we substitute our solution in and see if it satisfies out parameters. We obtain
	F(x)= ((Ae)^(((iγ)/c)x))+ ((Be)^(((-iγ)/c)x))
	G(t)= ((Ce)^(iγt))+ ((De)^(-iγt))
Now perform a DeMoivre Trigonometric expansion of our new functions. We obtain
	F(x)= ((Ae)^(((iγ)/c)x))+ ((Be)^(((-iγ)/c)x))=A Cos[((x γ)/c)]+B Cos[((x γ)/c)]+i (A Sin[((x γ)/c)]-B Sin[((x γ)/c)])
	G(t)= ((Ce)^(iγt))+ ((De)^(-iγt))= D Cos[t γ]+C Cos[t γ]+i (-D Sin[t γ]+C Sin[t γ])
So,
	u(x,t)=F(x)G(t)=(ACos[((xγ)/c)]+BCos[((xγ)/c)]+i(ASin[((xγ)/c)]-BSin[((xγ)/c)]))(DCos[tγ]+CCos[tγ]+i(-DSin[tγ]+CSin[tγ]))
or, alternatively
	({{u(x,t)=F(x)G(t)=(((Ae)^(((iγ)/c)x))+ ((Be)^(((-iγ)/c)x)))(((Ce)^(iγt))+ ((De)^(-iγt)))}})
But we still have 4 undefined variables, as well as an elusive, "γ"

Substitute in Boundary Conditions

Defined  (u(x,t)); we can use the previously defined boundary conditions to eliminate variables
	u(0,t)=0
	u(0,t)=(((Ae)^(((iγ)/c)(0)))+ ((Be)^(((-iγ)/c)(0))))(((Ce)^(iγt))+ ((De)^(-iγt)) )= (A+B)(((Ce)^(iγt))+ ((De)^(-iγt)) ) = 0
The expression (((Ce)^(iγt))+ ((De)^(-iγt)) ) cannot be equal to zero because it would yield a trivial solution. Therefore (A+B) must be equal to 0.
	B=-A
So our new function becomes:
	u(x,t)=F(x)G(t)=(A Cos[((x γ)/c)]-A Cos[((x γ)/c)]+i (A Sin[((x γ)/c)]+A Sin[((x γ)/c)]))(D Cos[t γ]+C Cos[t γ]+i (-D Sin[t γ]+C Sin[t γ]))
					=(2 i A Sin[((x γ)/c)])(D Cos[t γ]+C Cos[t γ]+i (-D Sin[t γ]+C Sin[t γ]))
or, alternatively
		u(x,t)=F(x)G(t)=(((Ae)^(((iγ)/c)x))-((Ae)^(((-iγ)/c)x)))(((Ce)^(iγt))+ ((De)^(-iγt)))

Substitute into Initial Conditions

We begin with:((∂u(x,0))/(∂t))=0
Which is:
	(d/dt)(x,0)(2iASin[((xγ)/c)])(DCos[tγ]+CCos[tγ]+i(-DSin[tγ]+CSin[tγ]))
	= 2 i A (i (C γ Cos[t γ]-D γ Cos[t γ])-C γ Sin[t γ]-D γ Sin[t γ]) Sin[((x γ)/c)] at t=0
		= 2 i A (i (C γ Cos[0]-D γ Cos[0])-C γ Sin[0]-D γ Sin[0]) Sin[((x γ)/c)]
			=-2 Aγ (C -D ) Sin[((x γ)/c)]=0
Sin[((x γ)/c)] and A cannot equal zero, because it gives us a trivial solution so
	(C-D)=0
and by extension
	C=D
So, our new function becomes 
u(x,t)= ASin[((xγ)/c)]Cos[γt] ,
 Where "A" is a new undetermined constant.

Solve for Gamma

Satisfying our second boundary condition,
u (L, t) = 0, we obtain
u(L,t)=0
	u(L,t)=ASin[((Lγ)/c)]Cos[γt]= 0
The expression A*Cos[γt]  cannot be equal to zero because it would yield a trivial solution. Therefore Sin[((Lγ)/c)] must be equal to 0.
	So ((γL)/c)=nπ  or γ=((nπc)/L)
So our new function becomes:
	({{u(x,t)=(∑_(n=1)^∞)(Subscript[A, n])Sin[((nπx)/L)]Cos[((nπct)/L)]}})

Initial Conditions on String Displacement

u(x,0)=(∑_(n=1)^∞)(Subscript[A, n])Sin[((nπx)/L)]*1=W(x)

(Subscript[A, n])=(2/L)(∫_0^L)Sin[((nπx)/L)]*W(x)\[DifferentialD]x

Our Fourier into Mathematica

L=1;
c=20;
m=.;
x=.;
maxN=20;
a=.3;
F[x_]:=(E^(-100(((x-a))^2)));
i=.;
A={};
For[i=1,i≤ maxN,i++,
A=Append[A,(2/L)Integrate[(Sin[(i*π*x)])*F[x],{x, 0, L}]] ];
G[x_,m_,t_]:=Sum[A[[n]]*Sin[(n*π*x/L)]*(Cos[(n*π*c*t)/L]), {n,1, m}]

Manipulate[Plot[G[x,m,t], {x,0,L}, PlotRange->{1, -1}], {m,1,maxN},{t,0,.4}]

Solve the Two-String Wave Equation

To solve the wave propagation problem for two strings of different densities/cross-sectional areas connected at point (Subscript[L, α]) we must solve the equation for each string. The PDE for one string is applied to each as follows 
	((Subscript[c, 1])^2)(((∂^2)(Subscript[u, 1])(x,t))/(∂(x^2)))=(((∂^2)(Subscript[u, 1])(x,t))/(∂(t^2)))
	((Subscript[c, 2])^2)(((∂^2)(Subscript[u, 2])(x,t))/(∂(x^2)))=(((∂^2)(Subscript[u, 2])(x,t))/(∂(t^2)))
(Subscript[u, 1])(x,t) has the following conditions.
Boundary Conditions:
	(Subscript[u, 1])(0,t)=0
	Initial Conditions:
	(Subscript[u, 1])(x,0)=W(x)
		((∂(Subscript[u, 1])(x,0))/(∂t))=0

(Subscript[u, 2])(x,t) has the following conditions.
Boundary Conditions:
	(Subscript[u, 2])(L,t)=0
	Initial Conditions:
	(Subscript[u, 2])(x,0)=W(x)
		((∂(Subscript[u, 2])(x,0))/(∂t))=0

Further Conditions

Both (Subscript[u, 1]) & (Subscript[u, 2]) share the following continuity conditions:
(Subscript[u, 1])((Subscript[L, α]),t)=(Subscript[u, 2])((Subscript[L, α]),t)
	((∂(Subscript[u, 1])((Subscript[L, α]),t))/(∂t))=((∂(Subscript[u, 2])((Subscript[L, α]),t))/(∂t))
Where α is the point on the string where the two parts of the string are connected.
Now we make the assumption that (Subscript[u, 1])(x,t) is the product of two functions F(x) and G(t), thus:
(Subscript[u, 1])(x,t)=F(x)G(t)
and the equations are evaluated as before.

Simplification of Process

We use the same process as we did with the one-string equation and obtain similar formulae
	(Subscript[u, 1])(x,t)= ASin[((xγ)/(Subscript[c, 1]))]Cos[γt]	(Subscript[u, 2])(x,t)= ASin[((xγ)/(Subscript[c, 2]))]Cos[γt]
Plugging in the continuity conditions we obtain:
Sin[((αγ)/(Subscript[c, 1]))]=Sin[(((L-α)γ)/(Subscript[c, 2]))]
and 
(1/(Subscript[c, 2]))Sin[((λα)/(Subscript[c, 1]))]Cos[(((1-α)λ)/(Subscript[c, 2]))]=((-1)/(Subscript[c, 1]))Sin[(((1-α)λ)/(Subscript[c, 2]))]Cos[((λα)/(Subscript[c, 1]))]

Finding the Eigen Values in Mathematica

(Subscript[c, 1])=20;
(Subscript[c, 2])=20;
α=.5;
L=1;
min=0;
max=1000;
inc=1;
F[λ_]:=(1/(Subscript[c, 2]))*Sin[((λ *α)/(Subscript[c, 1]))]*Cos[((λ *(L-α))/(Subscript[c, 2]))]+(1/(Subscript[c, 1]))* Cos[((λ *α)/(Subscript[c, 1]))]*Sin[((λ *(L-α))/(Subscript[c, 2]))];
λn={};
For[ i=min,i < max, i+=inc, 
        If[F[i]*F[i+inc]≤0,roots=FindRoot[F[λ],{λ,i}]; λn=Append[λn,roots[[1,2]]],False]];

Fourier (Part II)

g[x_,α_,L_]:=Sin[π*x];
w[c1_,c2_,α_]:=Piecewise[  {  {(1/c1)*(1/c1),0≤ x≤ α},{(1/c2)*(1/c2),α≤ x≤ L}  }  ];
A=Range[Length[λn]];
For[i=1,i≤ Length[λn],i++,
        A[[i]]=(∫_0^L)u[x,0,λn[[i]],α,L]*u[x,0,λn[[i]],α,L]*w[(Subscript[c, 1]),(Subscript[c, 2]),α]\[DifferentialD]x ];
A
ListLogPlot[A,PlotRange-> {10^(-10),10^(-2)},Filling->Axis]
       
b=Range[Length[λn]];
For[i=1,i≤ Length[λn],i++,
        b[[i]]=(∫_0^L)u[x,0,λn[[i]],α,L]*g[x,α,L]*w[(Subscript[c, 1]),(Subscript[c, 2]),α]\[DifferentialD]x ];
b
ListLogPlot[A,PlotRange-> {10^(-10),10^(-2)},Filling->Axis];

An=b/A;
ListLogPlot[Abs[An],PlotRange-> {10^(-32),10},Filling->Axis];            

U[x_,t_]:=(∑_(p=1)^(Length[λn]))An[[p]]*u[x,t,λn[[p]],α,L]

New Slide

Plot[U[x, 0], {x, 0, L}, Filling -> Axis, PlotRange -> All ]

New Slide

Manipulate[
 Plot[{g[x, α, L], U[x, T]}, {x, 0, L}, Filling -> Axis, 
  PlotRange -> {-1.1, 1.1}, Frame -> True ], {T, 0.000, 1.0, 0.001}]

Plot3D[U[x,T],{x,0,L},{T,0,0.1},
              PlotRange -> {-1.5,1.5},Background->Black,Mesh->None,PlotPoints->40,AxesStyle->White,Boxed->False ]

New Slide