# FindRoot Accuracy

How can I get FindRoot to be more accurate? I would require a solution for r that leaves expr at least much closer to zero. (I can check expr to some tolerance and discard the result if it's too far out.)

expr = 34334.9 (1 + r) - 150000 (1 + r)^0.16129 + 145472 (1 + r)^0.0645161 - 15177.4;

Clear[r]

r = r /. FindRoot[expr == 0, {r, -0.75}]

expr


6142.92

Plot[expr, {r, -1, 1}, AxesOrigin -> {0, 0}]


• From the plot it seems expr has no roots. NMinimize perhaps? Jul 9, 2019 at 13:47
• 'No solution' would be ok. I am just surprised at the approximate answer, and wondering if I can control the accuracy, rather than have to check the result. Jul 9, 2019 at 13:52
• I see. Did you check for the usual options AccuracyGoal and PrecisionGoal, etc? What happens if you Rationalize your floats? Jul 9, 2019 at 13:56
• I tried AccuracyGoal. I don't think it improved much a fairly accurate minimum. Maybe it's just simplest to check the value of expr. Jul 9, 2019 at 14:03
• BTW if I execute your code, I do get an error message "...unable to find a sufficient decrease in the merit function." This means that something went wrong and, in this case, means the function has no roots. So this is basically your "no solution" message. Jul 9, 2019 at 14:11

Clear[r]

expr =
34334.9 (1 + r) - 150000 (1 + r)^0.16129 + 145472 (1 + r)^0.0645161 -
15177.4;

Minimize[expr // Rationalize[#, 0] &, r]

(* {-(75887/5), {r -> -1}} *)


Since the minimum is negative there must be a root.

prec = 30;

sol = FindRoot[SetPrecision[expr, prec] == 0, {r, -1},
WorkingPrecision -> prec]

(* {r -> -0.99999999999999890965199354718} *)


Verifying the solution

SetPrecision[expr, prec] /. sol

(* 0.*10^-12 *)

Plot[SetPrecision[expr, prec], {r, -1.0005, -0.999},
WorkingPrecision -> prec]


For non-extreme solutions this is the type of routine I came up with.

froot[expr_, guess_] := Module[{a, check = Null},
Quiet[
a = r /. FindRoot[expr == 0, {r, guess}, MaxIterations -> 1000];
If[Length[$$MessageList] > 0, check = ToString[$$MessageList]]];

If[StringQ[check], Print[check]];