How to increase the precision to get the correct roots at the boundaries?

I want to solve an equation and Plot a graph of δ(τ)\delta(\tau), where 0<τ,δ<10<\tau,\delta<1. In principal δ(0)=1,δ(1)=0\delta(0)=1,\delta(1)=0. However, when I solve the equation, the points near τ=1\tau=1 can't get exactly. Below is my sample code: Clear["Global`*"]; eps = 10^-13; stepSize = 0.001; omegaD = 0.5; df = 0.008; c1 = omegaD/df; c0 = c0 /. FindRoot[1/c0 Log[Cosh[c1 c0]] == Sqrt[c1^2 + 1] - 1, {c0, Log[2]}]; list = Table[{Ï„, δ /. FindRoot[Ï„ Log[Cosh[c0 Sqrt[c1^2 + \delta^2]/Ï„]/Cosh[c0 δ/Ï„]] == c0 (Sqrt[c1^2 + 1] - 1), {δ, 1}]}, {Ï„, eps, 1.0,stepSize}]; p1 = ListLinePlot[list] Program complains that: The line search decreased the step size to within tolerance specified \ by AccuracyGoal and PrecisionGoal but was unable to find a sufficient \ decrease in the merit function. You may need more than \ MachinePrecision digits of working precision to meet these tolerances.@ Also clearly shown in the graph, the points near τ=1\tau=1 is missing. So I tried to add an option WorkingPrecision->30 at the end of the FindRoot function, the program complain the following this time:

the precision of the argument function … is less than WorkingPrecision (30.)

Even I decrease 30 to other number, it still complaining.

Question is how to add the missing points correctly at the boundary?




The precision of your arguments must be at least as high as the WorkingPrecision you are requesting. You should change your parameters to exact values, e.g. stepSize = 1/1000; omegaD = 1/2; df = 8/1000; and retry.
– MarcoB
Oct 26 ’15 at 15:41



As a sidenote to what @MarcoB correctly said, you can also just write 0.01//Rationalize for instance. That might be more convenient for you
– Lukas
Oct 26 ’15 at 16:30


1 Answer


First, the Table does not run up to t == 1.:

Table[Ï„, {Ï„, 1/20, 1, stepSize}]
(* {1.*10^-13, 0.001,…, 0.998, 0.999} *)

Update —
Now with the corrected formula (a typo fixed in the OP), let’s try

list = Table[{τ, δ /.
FindRoot[Ï„ Log[Cosh[c0 Sqrt[c1^2 + δ^2]/Ï„]/Cosh[c0 δ/Ï„]] == c0 (Sqrt[c1^2 + 1] – 1),
{δ, 1}]},
{Ï„, Union[Range[eps, 1.0, stepSize], {1.}]}]
p1 = ListLinePlot[list]

We get the desired plot.



IF you do it analytically, you may find it is indeed 0. That is why I think I need more precision. I will show the analytical derivation when I am at computer.
– buzhidao
Oct 27 ’15 at 4:20



It’s my mistake, I wrongly typed a character in my code.
– buzhidao
Oct 27 ’15 at 6:53



@buzhidao Thanks. I’ve updated the answer to your new input.
– Michael E2
Oct 27 ’15 at 11:34



@downvoter, Why? It would be helpful to the site to indicate a reason you think there is an issue with the answer!
– Michael E2
Oct 27 ’15 at 11:36



Thanks, I’ve also got that figure after I spot that misprint.
– buzhidao
Oct 27 ’15 at 12:18