Super glued strings

Not a solution

Plot[1+Sin[x],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{Red,Thickness[0.01],Line[{{-1,0},{0,1}}],Line[{{Pi,1},{Pi+1,0}}]},{PointSize[0.012],Point[{-1,0}],Point[{Pi+1,0}]}},PlotRange->{{-1.1,Pi+1.1},{-2.4,2.4}},AspectRatio->1/5,Frame->True, Axes->False,ImageSize->600]

Manipulate[Plot[(1+Sin[x])Cos[t],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{Red,Thickness[0.01],Line[{{-1,0},{0,Cos[t]}}],Line[{{Pi,Cos[t]},{Pi+1,0}}]},{PointSize[0.012],Point[{-1,0}],Point[{Pi+1,0}]}},PlotRange->{{-1.1,Pi+1.1},{-2.4,2.4}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize->600],{t,0,2Pi,N[Pi/64]}]

Solution 1

We want to solve

(∂_tt)u[x,t]=(∂_xx)u[x,t], 0≤x≤π, t≥0, u[0,t]-(∂_x)u[0,t]=0, u[π,t]=0, u[x,0]=ff1[x], (∂_t)u[x,0]=0.

So we need to solve the Sturm-Liouville eigenvalue problem

-y(x)''= λ y(x),  0≤x≤π,  
   y(0)-y'(0) =0,   
    y(π)=0 .

No negative eigenvalues

We look for negative eigenvalues λ = -(μ^2)

-y(x)''= -(μ^2) y(x),  0≤x≤π,  
   y(0)-y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->0})-((D[(E^(x μ)) C[1]+(E^(-x μ)) C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

(1-μ) C[1]+(1+μ) C[2] = 0 

(e^(π μ)) C[1]+(e^(-π μ)) C[2] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{(1-μ) ,(1+μ) },{(E^(π μ)) ,(E^(-π μ)) }}]

The above function is the function whose zeros give as -(μ^2) the negative eigenvalues

Since the above function has no positive zeros there are no negative evs.  Below is a graphical verification of this claim.

Plot[(E^(-π μ))-(E^(π μ))-(E^(-π μ)) μ-(E^(π μ)) μ,{μ,0,5},PlotRange->Automatic]

Zero is not an eigenvalue

Is zero an eigenvalue?

-y(x)''= 0 ,  0≤x≤π,  
   y(0)-y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==0,y[x],x]

Substitute into the boundary conditions

Collect[((C[1]+x C[2])/.{x->0})-((D[C[1]+x C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1]+x C[2])/.{x->Pi}),{C[1],C[2]}]

We need a nontrivial solution for C[1] and C[2] of the system

C[1]-C[2] = 0 

C[1]+π C[2] = 0

Since the determinant

Det[{{1,-1},{1,Pi}}]

is nonzero, the system has no nontrivial solutions, thus zero is not an eigenvalue.

Find positive eigenvalues

We look for positive eigenvalues λ = (μ^2)

-y(x)''= (μ^2) y(x),  0≤x≤π,  
   y(0)-y'(0) =0,   
    y(π)=0 .

DSolve[-y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->0})-((D[C[1] Cos[x μ]+C[2] Sin[x μ],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

C[1]-μ C[2] = 0 

C[1] Cos[π μ]+C[2] Sin[π μ] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{1 ,-μ },{Cos[π μ],Sin[π μ]}}]

The above function is the function whose zeros give as (μ^2) the negative eigenvalues

Getting solutions for μ “visually”

Plot[μ Cos[π μ]+Sin[π μ],{μ,0,13},Ticks->{Range[0,20,1],Automatic}]

Mathematica has a command to find approximate solutions:

FindRoot[μ Cos[π μ]+Sin[π μ]==0,{μ,.7}]

In the command above we need to give an initial guess. Then Mathematica finds a much better approximation which is nearby. Mathematica’s approximate value above is given as a substitution rule. To get just the numeric value do

μ/.FindRoot[μ Cos[π μ]+Sin[π μ]==0,{μ,.7}]

However, we need many solutions.  To do that I make the above command as a pure function

(μ/.FindRoot[μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&[0.7]

Next I make a list of initial guesses:

Join[{.9,1.7},Range[2.6,20,1]]

Next I verify that my initial guesses are close to the actual zeros of the function

Plot[μ Cos[π μ]+Sin[π μ],{μ,0,13},Epilog->{{Red,Point[{#,0}]&/@Join[{.9,1.7},Range[2.6,20,1]]}},Ticks->{Range[0,20,1],Automatic}]

Then I “map” my “zero finding function” to this list

Map[(μ/.FindRoot[μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&,Join[{.9,1.7},Range[2.6,20,1]]]

Next I name these approximate eigenvalues. The named list of  many μ-s will be essential in what follows.

Clear[eves1];
eves1=Map[(μ/.FindRoot[μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&,Join[{.9,1.7},Range[2.6,20,1]]]

Length[eves1]

Thus we found twenty eigenvalues.

I visually inspect that there are no repetitions.

Now I can check graphically that I got the right solutions

Plot[μ Cos[π μ]+Sin[π μ],{μ,0,13},Epilog->{{Red,PointSize[0.015],Point[{#,0}]&/@eves1}},Ticks->{Range[0,20,1],Automatic}]

Looks good.

Let us apply the original function to these approximations:

(# Cos[π #]+Sin[π #])&/@eves1

Chop[(# Cos[π #]+Sin[π #])&/@eves1]

Quite good!

Based on the matrix that determined the eigenvalues we can now define the eigenfunctions:  With μ being the solution of  μ Cos[π μ]+Sin[π μ] =0, a corresponding eigenfunction is found be solving for (Subscript[C, 1]) and (Subscript[C, 2]) the following system

MatrixForm[{{1 ,-μ },{Cos[π μ],Sin[π μ]}}]

(({{1, -μ}, {Cos[π μ], Sin[π μ]}}))(({{(Subscript[C, 1])}, {(Subscript[C, 2])}}))=(({{0}, {0}}))

Since the determinant of this system is zero, the system has many solutions.  A simple solution is  (Subscript[C, 1])=μ, (Subscript[C, 2])=1.  Below are twenty eigenfunctions corresponding to the eigenvalues that we found.

Clear[efs1];

efs1[x_]=(#Cos[# x]+Sin[# x])&/@eves1

Here is, for example, the third eigenfunction

efs1[x][[3]]

Let us verify it the eigenfunctions are mutually orthogonal:

MatrixForm[Chop[Table[NIntegrate[efs1[x][[j]]efs1[x][[k]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves1]},{k,1,Length[eves1]}]]]

For later use we need the squares of the norms of the eigenfunctions

Clear[efns1];

efns1=Chop[Table[NIntegrate[efs1[x][[j]]efs1[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves1]}]]

Give initial conditions

Next we give our initial condition, the initial shape of the string.  Notice that the initial velocity is 0, so we do not need to work with sine part of the time components.

Clear[ff1];

ff1[x_]=(1/3)(x-(π/(-1-2 π)))(x-1)(x-Pi)

I chose this function so that it satisfies the BCs.

Simplify[((ff1'[0])/(ff1[0]))]==1

Plot[ff1[x],{x,0,Pi}]

Here are the coefficients in the Fourier expansion for ff1

Clear[coefs1];coefs1=Chop[Table[NIntegrate[(ff1[x])efs1[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves1]}]]

I like to keep the above coefficients and the squares of the norms separate. In fact in the expansion we need to divide the above coefficients with the squares of the norms. Here is how we do it (somewhat weird, a list divided by a list, but it works)

(coefs1/efns1)

Next we define our approximation of the solution.  Remember, our few solutions in x are in the table efs1[x][[k]], k=1,...,20, the corresponding time components are Cos[eves1[[k]] t], where eves1 is the list of twenty μ-s.  To get the solution these few functions need to be scaled by the coefficients in  ((coefs1[[k]])/(efns1[[k]])). So, our approximation of the solution is

Sum[((coefs1[[k]])/(efns1[[k]]))efs1[x][[k]]*Cos[eves1[[k]] t],{k,1,Length[eves1]}]

There is much more compact way of delivering the same result without using summation. In fact that sum is written as  a dot product.

(efs1[x]*((Cos[# t])&/@eves1)).((coefs1/efns1))

Next we define our approximation of the solution as a function with a name:

Clear[uu1];uu1[x_,t_]=(efs1[x]*((Cos[# t])&/@eves1)).((coefs1/efns1))

Does it evaluate properly?

uu1[1,0.]

Does it approximate the function ff1 well?

Plot[Evaluate[{(ff1[x]),uu1[x,0]}],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue},{Thickness[0.005],Yellow}},Epilog->{{Red,Thickness[0.01],Line[{{-1,0},{0,uu1[0,0]}}]}},PlotRange->{{-1.1,Pi+0.1},{-1.2,1.2}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize->600]

Ready to oscillate?

Manipulate[Plot[Evaluate[uu1[x,t]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},
Epilog->{
{Red,Thickness[0.01],Line[{{-1,0},{0,Evaluate[uu1[0,t]]}}]},{PointSize[0.012],Point[#]&/@{{-1,0},{Pi,0}}}
},
PlotRange->{{-1.1,Pi+0.1},{-1.4,1.4}},AspectRatio->1/5,Frame->True,FrameTicks->{Prepend[Range[0,Pi,Pi/4],-1/2],{},{},{}},Axes->False,ImageSize->600],{t,0,7.3,0.05}]

And finally here are the normal modes of vibrations. Those are the few solutions that we found before

Clear[nmv1];nmv1[x_,t_]:=(efs1[x]*(((1/(Sqrt[((#)^2)+4]))Cos[# t])&/@eves1))

Manipulate[Plot[Evaluate[nmv1[x,t][[k]]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},
Epilog->{
{Red,Thickness[0.01],Line[{{-1,0},{0,Evaluate[nmv1[0,t][[k]]]}}]},
{PointSize[0.012],Point[#]&/@{{-1,0},{Pi,0}}}
},PlotRange->{{-1.1,Pi+.1},{-1.4,1.4}},AspectRatio->1/5,Frame->True,FrameTicks->{Prepend[Range[0,Pi,Pi/4],-1/2],{},{},{}},Axes->False,ImageSize->600],{t,0,4Pi,N[Pi/64]},{{k,1},Range[10],ControlType->Setter}]

Solution 2

We want to solve

(∂_tt)u[x,t]=(∂_xx)u[x,t], 0≤x≤π, t≥0, u[0,t]+(∂_x)u[0,t]=0, u[π,t]=0, u[x,0]=ff1[x], (∂_t)u[x,0]=0.

So we need to solve the Sturm-Liouville eigenvalue problem

-y(x)''= λ x y(x),  0≤x≤π,  
   y(0)+y'(0) =0,   
    y(π)=0 .

Look for negative eigenvalues

We look for negative eigenvalues λ = -(μ^2)

-y(x)''= -(μ^2) y(x),  0≤x≤π,  
   y(0)+y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->0})+((D[(E^(x μ)) C[1]+(E^(-x μ)) C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

(1+μ) C[1]+(1-μ) C[2] = 0 

(e^(π μ)) C[1]+(e^(-π μ)) C[2] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{(1+μ) ,(1-μ) },{(E^(π μ)) ,(E^(-π μ)) }}]

The above function is the function whose zeros give as -(μ^2) the negative eigenvalues

Since the above function has no positive zeros there are no negative evs.  Below is a graphical verification of this claim.

Plot[(E^(-π μ))-(E^(π μ))+(E^(-π μ)) μ+(E^(π μ)) μ,{μ,0,3},PlotRange->{-3,3}]

The equation for the eigenvalue can be rewritten as Tanh[π μ] = μ

Plot[{Tanh[π μ],μ},{μ,0,3}]

evn2=μ/.FindRoot[-μ Cosh[π μ]+Sinh[π μ]==0,{μ,1}]

The corresponding eigenfunction is

efn2[x_]=evn2 Cosh[evn2 x]-Sinh[evn2 x]

Zero is not an eigenvalues

Is zero an eigenvalue?

-y(x)''= 0 ,  0≤x≤π,  
   y(0)+y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==0,y[x],x]

Substitute into the boundary conditions

Collect[((C[1]+x C[2])/.{x->0})+((D[C[1]+x C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1]+x C[2])/.{x->Pi}),{C[1],C[2]}]

We need a nontrivial solution for C[1] and C[2] of the system

C[1]+C[2] = 0 

C[1]+π C[2] = 0

Since the determinant

Det[{{1,1},{1,Pi}}]

is nonzero, the system has no nontrivial solutions, thus zero is not an eigenvalue.

Look for positive eigenvalues

We look for positive eigenvalues λ = (μ^2)

-y(x)''= (μ^2) y(x),  0≤x≤π,  
   y(0)+y'(0) =0,   
    y(π)=0 .

DSolve[-y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->0})+((D[C[1] Cos[x μ]+C[2] Sin[x μ],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

C[1]+μ C[2] = 0 

C[1] Cos[π μ]+C[2] Sin[π μ] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{1 ,μ },{Cos[π μ],Sin[π μ]}}]

The above function is the function whose zeros give as (μ^2) the negative eigenvalues

Getting solutions for μ “visually”

Plot[-μ Cos[π μ]+Sin[π μ],{μ,0,13},Ticks->{Range[0,20,1],Automatic}]

Mathematica has a command to find approximate solutions:

FindRoot[-μ Cos[π μ]+Sin[π μ]==0,{μ,1.2}]

In the command above we need to give an initial guess. Then Mathematica finds a much better approximation which is nearby. Mathematica’s approximate value above is given as a substitution rule. To get just the numeric value do

μ/.FindRoot[-μ Cos[π μ]+Sin[π μ]==0,{μ,1.2}]

However, we need many solutions.  To do that I make the above command as a pure function

(μ/.FindRoot[-μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&[1.2]

Next I make a list of initial guesses:

Join[{1.3},Range[2.4,20,1]]

Next I verify that my initial guesses are close to the actual zeros of the function

Plot[-μ Cos[π μ]+Sin[π μ],{μ,0,13},Epilog->{{Red,Point[{#,0}]&/@Join[{1.3},Range[2.4,20,1]]}},Ticks->{Range[0,20,1],Automatic}]

Then I “map” my “zero finding function” to this list

Map[(μ/.FindRoot[-μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&,Join[{1.3},Range[2.4,20,1]]]

Next I name these approximate eigenvalues. The named list of  many μ-s will be essential in what follows.

Clear[eves2];
eves2=(μ/.FindRoot[- μ Cos[π μ]+ Sin[π μ]==0,{μ,#}])&/@Join[{1.3},Range[2.4,20,1]]

Length[eves2]

Thus we found nineteen eigenvalues.

I visually inspect that there are no repetitions.

Now I can check graphically that I got the right solutions

Plot[-μ Cos[π μ]+Sin[π μ],{μ,0,20},Epilog->{{Red,PointSize[0.015],Point[{#,0}]&/@eves2}},Ticks->{Range[0,20,1],Automatic}]

Looks good.

Let us apply the original function to these approximations:

Chop[(-# Cos[π #]+Sin[π #])&/@eves2]

Quite good!

Based on the matrix that determined the eigenvalues we can now define the eigenfunctions:  With μ being the solution of  μ Cos[π μ]+Sin[π μ] =0, a corresponding eigenfunction is found be solving for (Subscript[C, 1]) and (Subscript[C, 2]) the following system

MatrixForm[{{1 ,μ },{Cos[π μ],Sin[π μ]}}]

(({{1, μ}, {Cos[π μ], Sin[π μ]}}))(({{(Subscript[C, 1])}, {(Subscript[C, 2])}}))=(({{0}, {0}}))

Since the determinant of this system is zero, the system has many solutions.  A simple solution is  (Subscript[C, 1])=μ, (Subscript[C, 2])=-1.  Below are twenty eigenfunctions corresponding to the eigenvalues that we found.

Clear[efs2];

efs2[x_]=(#Cos[# x]-Sin[# x])&/@eves2

Here is, for example, the third eigenfunction

efs2[x][[3]]

Chop[Table[NIntegrate[efs2[x][[j]]efs2[x][[k]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves2]},{k,1,Length[eves2]}]]

efns2=Chop[Table[NIntegrate[efs2[x][[j]]efs2[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves2]}]]

Initial condition

ff2[x_]=(.2869 #^3+((-1+π-.2869 (π^3))/(π^2)) #^2-1 #+1)&[x]

Plot[ff2[x],{x,0,Pi}]

coefs2=Chop[Table[NIntegrate[(ff2[x])efs2[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves2]}]]

(coefs2/efns2)

(efs2[x]*((Cos[# t])&/@eves2)).((coefs2/efns2))

Clear[uu2]; uu2[x_,t_]=(NIntegrate[(ff2[x])efn2[x],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10]/NIntegrate[(efn2[x])efn2[x],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10])efn2[x]*(Cosh[evn2 t])+(efs2[x]*((Cos[# t])&/@eves2)).((coefs2/efns2))

uu2[1,0.]

Plot[Evaluate[{(ff2[x]),uu2[x,0]}],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue},{Thickness[0.005],Yellow}},Epilog->{{Red,Thickness[0.005],Line[{{1,0},{0,uu2[0,0]}}]}},PlotRange->{{-0.1,Pi+.1},{-2.2,2.2}},AspectRatio->1/4,Frame->True,Axes->False,ImageSize->600]

Manipulate[Plot[Evaluate[uu2[x,t]],{x,0,Pi},
PlotStyle->{{Thickness[0.01],Blue}},
Epilog->{{Red,Thickness[0.005],Line[{{1,0},{0,uu2[0,t]}}]},
{PointSize[0.012],Point[#]&/@{{1,0},{Pi,0}}}
},PlotRange->{{-0.1,Pi+.1},{-2.2,2.2}},AspectRatio->1/5,Frame->True,FrameTicks->{Join[{1},Range[0,Pi,Pi/4]],{},{},{}},Axes->False,ImageSize->600],{t,0,11.5,0.1}]

Because of the negative eigenvalue, this string brakes.

Solution 3

ff3[x_]=((0.2869636751862268`) #^3+((-1+π-(0.2869636751862268`) (π^3))/(π^2)) #^2-1 #+1)&[x]

Plot[ff3[x],{x,0,Pi}]

Chop[NIntegrate[(ff3[x])efn2[x],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10]]

coefs3=Chop[Table[NIntegrate[(ff3[x])efs2[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves2]}]]

(coefs3/efns2)

(efs2[x]*((Cos[# t])&/@eves2)).((coefs3/efns2))

Clear[uu3];uu3[x_,t_]=(efs2[x]*((Cos[# t])&/@eves2)).((coefs3/efns2))

uu3[1,0.]

Plot[Evaluate[{(ff3[x]),uu3[x,0]}],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue},{Thickness[0.005],Yellow}},Epilog->{{Red,Thickness[0.006],Line[{{1,0},{0,uu3[0,0]}}]}},PlotRange->{{-0.1,Pi+.1},{-2.2,2.2}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize->600]

Manipulate[Plot[Evaluate[uu3[x,t]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{Red,Thickness[0.005],Line[{{1,0},{0,uu3[0,t]}}]},{PointSize[0.012],Point[#]&/@{{1,0},{Pi,0}}}},
PlotRange->{{-0.1,Pi+.1},{-2.2,2.2}},AspectRatio->1/5,Frame->True,FrameTicks->{Join[{1},Range[0,Pi,Pi/4]],{},{},{}},Axes->False,ImageSize->600],{t,0,19.5,0.1}]

Clear[nmv2];nmv2[x_,t_]:=(efs2[x]*(((1/(Sqrt[((#)^2)+1]))Cos[# t])&/@eves2))

Manipulate[Plot[Evaluate[nmv2[x,t][[k]]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{Red,Thickness[0.005],Line[{{1,0},{0,Evaluate[nmv2[0,t][[k]]]}}]},{PointSize[0.012],Point[#]&/@{{1,0},{Pi,0}}}},PlotRange->{{-0.1,Pi+0.1},{-1.5,1.5}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize->600],{t,0,4Pi,N[Pi/64]},{{k,1},Range[10],ControlType->Setter}]

In this example I carefully selected the initial shape, so that the string does not break. I selected a shape that is orthogonal to the eigenfunction corresponding to the negative eigenvalue.

Solution 4

We want to solve

(∂_tt)u[x,t]=(∂_xx)u[x,t], 0≤x≤π, t≥0, 
u[0,t]+4 (∂_x)u[0,t]=0, 
u[π,t]=0, 
u[x,0]=ff1[x], 
(∂_t)u[x,0]=0.

So we need to solve the Sturm-Liouville eigenvalue problem

-y(x)''= λ x y(x),  0≤x≤π,  
   y(0)+4y'(0) =0,   
    y(π)=0 .

Look for negative eigenvalues

We look for negative eigenvalues λ = -(μ^2)

-y(x)''= -(μ^2) y(x),  0≤x≤π,  
   y(0)+ 4y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->0})+4((D[(E^(x μ)) C[1]+(E^(-x μ)) C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[(((E^(x μ)) C[1]+(E^(-x μ)) C[2])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

(1+4μ) C[1]+(1-4μ) C[2] = 0 

(e^(π μ)) C[1]+(e^(-π μ)) C[2] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{(1+4μ) ,(1-4μ) },{(E^(π μ)) ,(E^(-π μ)) }}]

The above function is the function whose zeros give as -(μ^2) the negative eigenvalues

Since the above function has no positive zeros there are no negative evs.  Below is a graphical verification of this claim.

Plot[(E^(-π μ))-(E^(π μ))+4(E^(-π μ)) μ+4(E^(π μ)) μ,{μ,0,3},PlotRange->{-3,3}]

The equation for the eigenvalue can be rewritten as Tanh[π μ] =4 μ

Plot[{Tanh[π μ],4μ},{μ,0,3}]

Thus there are no negative eigenvalues in this case.

Zero is not an eigenvalues

Is zero an eigenvalue?

-y(x)''= 0 ,  0≤x≤π,  
   y(0)+4y'(0) =0,   
    y(π)=0 .

DSolve[y''[x]==0,y[x],x]

Substitute into the boundary conditions

Collect[((C[1]+x C[2])/.{x->0})+4((D[C[1]+x C[2],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1]+x C[2])/.{x->Pi}),{C[1],C[2]}]

We need a nontrivial solution for C[1] and C[2] of the system

C[1]+4C[2] = 0 

C[1]+π C[2] = 0

Since the determinant

Det[{{1,4},{1,Pi}}]

is nonzero, the system has no nontrivial solutions, thus zero is not an eigenvalue.

Look for positive eigenvalues

We look for positive eigenvalues λ = (μ^2)

-y(x)''= (μ^2) y(x),  0≤x≤π,  
   y(0)+4y'(0) =0,   
    y(π)=0 .

DSolve[-y''[x]==(μ^2)y[x],y[x],x]

Substitute into the boundary conditions

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->0})+4((D[C[1] Cos[x μ]+C[2] Sin[x μ],x])/.{x->0}),{C[1],C[2]}]

Collect[((C[1] Cos[x μ]+C[2] Sin[x μ])/.{x->Pi}),{C[1],C[2]}]

We want nontrivial solutions for C[1] and C[2] of the system

C[1]+4μ C[2] = 0 

C[1] Cos[π μ]+C[2] Sin[π μ] = 0

For a nontrivial solution to exists we need the determinant to be equal to 0

Det[{{1 ,4μ },{Cos[π μ],Sin[π μ]}}]

The above function is the function whose zeros give as (μ^2) the negative eigenvalues

Getting solutions for μ “visually”

Plot[-4μ Cos[π μ]+Sin[π μ],{μ,0,13},Ticks->{Range[0,20,1],Automatic}]

Next I make a list of initial guesses:

Join[{.3,1.3},Range[2.4,20,1]]

Next I verify that my initial guesses are close to the actual zeros of the function

Plot[-4μ Cos[π μ]+Sin[π μ],{μ,0,13},Epilog->{{Red,Point[{#,0}]&/@Join[{.3,1.3},Range[2.4,20,1]]}},Ticks->{Range[0,20,1],Automatic}]

Then I “map” my “zero finding function” to this list

Map[(μ/.FindRoot[-4μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&,Join[{.3,1.3},Range[2.4,20,1]]]

Next I name these approximate eigenvalues. The named list of  many μ-s will be essential in what follows.

Clear[eves4];
eves4=(μ/.FindRoot[- 4μ Cos[π μ]+ Sin[π μ]==0,{μ,#}])&/@Join[{.3,1.3},Range[2.4,20,1]]

Length[eves4]

Thus we found twenty eigenvalues.

I visually inspect that there are no repetitions.

Now I can check graphically that I got the right solutions

Plot[-4μ Cos[π μ]+Sin[π μ],{μ,0,20},Epilog->{{Red,PointSize[0.015],Point[{#,0}]&/@eves4}},Ticks->{Range[0,20,1],Automatic}]

Looks good.

Let us apply the original function to these approximations:

Chop[(-4# Cos[π #]+Sin[π #])&/@eves4]

Quite good!

Based on the matrix that determined the eigenvalues we can now define the eigenfunctions:  With μ being the solution of  μ Cos[π μ]+Sin[π μ] =0, a corresponding eigenfunction is found be solving for (Subscript[C, 1]) and (Subscript[C, 2]) the following system

MatrixForm[{{1 ,4μ },{Cos[π μ],Sin[π μ]}}]

(({{1, 4μ}, {Cos[π μ], Sin[π μ]}}))(({{(Subscript[C, 1])}, {(Subscript[C, 2])}}))=(({{0}, {0}}))

Since the determinant of this system is zero, the system has many solutions.  A simple solution is  (Subscript[C, 1])=4μ, (Subscript[C, 2])=-1.  Below are twenty eigenfunctions corresponding to the eigenvalues that we found.

Clear[efs4];

efs4[x_]=(4#Cos[# x]-Sin[# x])&/@eves4

efs4[x][[3]]

Chop[Table[NIntegrate[efs4[x][[j]]efs4[x][[k]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves4]},{k,1,Length[eves4]}]]

efns4=Chop[Table[NIntegrate[efs4[x][[j]]efs4[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves4]}]]

ff4[x_]=(x Sin[x]/2)

Plot[ff4[x],{x,0,Pi}]

coefs4=Chop[Table[NIntegrate[(ff4[x])efs4[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[eves4]}]]

(coefs4/efns4)

(efs4[x]*((Cos[# t])&/@eves4)).((coefs4/efns4))

Clear[uu4]; 

uu4[x_,t_]=(efs4[x]*((Cos[# t])&/@eves4)).((coefs4/efns4))

uu4[1,0.]

Plot[Evaluate[{(ff4[x]),uu4[x,0]}],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue},{Thickness[0.005],Yellow}},Epilog->{{Red,Thickness[0.005],Line[{{4,0},{0,uu4[0,0]}}]}},PlotRange->{{-0.1,4+.1},{-1.2,1.2}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize-> 600]

Manipulate[Plot[Evaluate[uu4[x,t]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{PointSize[0.012],Point[#]&/@{{Pi,0}}},{Red,Thickness[0.005],Line[{{4,0},{0,uu4[0,t]}}]},{Point[{Pi,0}]},
{PointSize[0.012],Point[#]&/@{{4,0}}}},PlotRange->{{-0.1,4+.1},{-1.4,1.4}},AspectRatio->1/5,Frame->True,Axes->False,FrameTicks->{Join[{4},Range[0,Pi,Pi/4]],{},{},{}},ImageSize->600],{t,0,26.11,0.1}]

N[2Pi/eves4[[1]]]

Clear[nmv4];nmv4[x_,t_]:=(efs4[x]*(((1/(Sqrt[16((#)^2)+1]))Cos[# t])&/@eves4))

Manipulate[Plot[Evaluate[nmv4[x,t][[k]]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},Epilog->{{PointSize[0.012],Point[{Pi,0}]},{Red,Thickness[0.005],Line[{{4,0},{0,Evaluate[nmv4[0,t][[k]]]}}]},
{PointSize[0.012],Point[{4,0}]}
},PlotRange->{{-0.1,4+0.1},{-1.5,1.5}},AspectRatio->1/5,Frame->True,Axes->False,ImageSize->600],{t,0,N[2Pi/eves4[[1]]],0.05},{{k,1},Range[10],ControlType->Setter}]

Back to Solution 1, but with different sizes of a super-glued part

Manipulate[Module[{meves1,mefs1,mff1,mcoefs1,mefns1,muu1},meves1=Map[(μ/.FindRoot[ h μ Cos[π μ]+Sin[π μ]==0,{μ,#}])&,Join[{.9,1.7},Range[2.6,20,1]]];
mefs1[x_]=(h #Cos[# x]+Sin[# x])&/@meves1;
mefns1=Chop[Table[NIntegrate[mefs1[x][[j]]mefs1[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[meves1]}]];
mff1[x_,h_]=((h^(3/4))/12) (-1+x) (-π+x) ((π/(1+π))+x) (1+(x/h));
mcoefs1=Chop[Table[NIntegrate[(mff1[x,h])mefs1[x][[j]],{x,0,Pi},MaxRecursion->200,AccuracyGoal->10,PrecisionGoal->10],{j,1,Length[meves1]}]];muu1[x_,t_]=(mefs1[x]*((Cos[# t])&/@meves1)).((mcoefs1/mefns1));
Plot[Evaluate[muu1[x,t]],{x,0,Pi},PlotStyle->{{Thickness[0.01],Blue}},
Epilog->{
{Red,Thickness[0.01],Line[{{-h,0},{0,Evaluate[muu1[0,t]]}}]},{PointSize[0.012],Point[#]&/@{{-h,0},{Pi,0}}}
},
PlotRange->{{-2.1,Pi+0.1},{-1.2,1.2}},AspectRatio->1/5,Frame->True,FrameTicks->{Join[Range[-2,((-1)/4),(1/4)],Range[0,Pi,Pi/4]],{},{},{}},Axes->False,ImageSize->500]

],{t,0,7.3,0.05},{{h,1},(1/4),2,(1/4),ControlType->Setter}]