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:

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 $\tau=1$ is missing.

enter image description here

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?

  • 1
    $\begingroup$ 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. $\endgroup$
    – MarcoB
    Commented Oct 26, 2015 at 15:41
  • $\begingroup$ 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 $\endgroup$
    – Lukas
    Commented Oct 26, 2015 at 16:30

1 Answer 1


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]

Mathematica graphics

We get the desired plot.

  • $\begingroup$ 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. $\endgroup$ Commented Oct 27, 2015 at 4:20
  • 1
    $\begingroup$ It's my mistake, I wrongly typed a character in my code. $\endgroup$ Commented Oct 27, 2015 at 6:53
  • $\begingroup$ @buzhidao Thanks. I've updated the answer to your new input. $\endgroup$
    – Michael E2
    Commented Oct 27, 2015 at 11:34
  • 1
    $\begingroup$ @downvoter, Why? It would be helpful to the site to indicate a reason you think there is an issue with the answer! $\endgroup$
    – Michael E2
    Commented Oct 27, 2015 at 11:36
  • $\begingroup$ Thanks, I've also got that figure after I spot that misprint. $\endgroup$ Commented Oct 27, 2015 at 12:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.