# 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<\tau,\delta<1$. In principal $\delta(0)=1,\delta(1)=0$. However, when I solve the equation, the points near $\tau=1$ can't get exactly. Below is my sample code:

Clear["Global*"];
eps = 10^-13;
stepSize = 0.001;
df = 0.008;
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 $\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

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. – an offer can't refuse Oct 27 '15 at 4:20
• It's my mistake, I wrongly typed a character in my code. – an offer can't refuse 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. – an offer can't refuse Oct 27 '15 at 12:18