NSolve failing to find the roots of an transcendental equation

Question

Why NSolve is not working for this problem. By plotting the determinant equation it is clear that there are roots between 5 t0 10, but NSolve could not able to find it. ClearAll["Global`*"] L = 4; W = a[1]*Sin[b*x] + a[2]*Cos[b*x] + a[3]*Sinh[b*x] + a[4]*Cosh[b*x]; e[1] = D[W, {x, 2}] /. x -> 0 e[2] = D[W, {x, 3}] /. x -> 0 e[3] = W /. x -> L e[4] = D[W, {x, 1}] /. x -> L var = Table[a[i], {i, 1, 4}]; eq = Table[e[i], {i, 1, 4}]; R = Normal@CoefficientArrays[eq, var][[2]]; P = Det[R] Plot[P, {b, 0, 5}] s1 = NSolve[P == 0 && 0 < b < 10]

Bob Hanlon · Answer

Clear["Global`*"]

L = 4;
W = a[1]*Sin[b*x] + a[2]*Cos[b*x] + a[3]*Sinh[b*x] + a[4]*Cosh[b*x];

e[1] = D[W, {x, 2}] /. x -> 0;
e[2] = D[W, {x, 3}] /. x -> 0;
e[3] = W /. x -> L;
e[4] = D[W, {x, 1}] /. x -> L;

var = Array[a, 4];
eq = e /@ Range[4];
R = Normal@CoefficientArrays[eq, var][[2]];

P = Det[R] // FullSimplify;

The exact solutions are Root functions

s1 = Solve[P == 0 && 0 < b < 10]

Alternatively, to use NSolve don't use machine precision

s1n = NSolve[P == 0 && 0 < b < 10,
   WorkingPrecision -> 15];

(b /. s1) == (b /. s1n)

(* True *)

Plot[P, {b, 0, 10},
 PlotRange -> {-.1, .1},
 MaxRecursion -> 5,
 Epilog -> {Red, AbsolutePointSize[4],
   Point[{b, 0} /. s1]}]

NSolve failing to find the roots of an transcendental equation

One Answer

Add your own answers!

Ask a Question