1
$\begingroup$

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}]

enter image description here

$\endgroup$
8
  • 2
    $\begingroup$ From the plot it seems expr has no roots. NMinimize perhaps? $\endgroup$ Jul 9, 2019 at 13:47
  • $\begingroup$ '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. $\endgroup$ Jul 9, 2019 at 13:52
  • 1
    $\begingroup$ I see. Did you check for the usual options AccuracyGoal and PrecisionGoal, etc? What happens if you Rationalize your floats? $\endgroup$ Jul 9, 2019 at 13:56
  • $\begingroup$ 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. $\endgroup$ Jul 9, 2019 at 14:03
  • 2
    $\begingroup$ 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. $\endgroup$ Jul 9, 2019 at 14:11

2 Answers 2

5
$\begingroup$
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]

enter image description here

$\endgroup$
0
$\begingroup$

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]];
  If[Head[a] === Complex, Print["Complex"]];

  If[Or[StringQ[check], Head[a] === Complex], "No solution", a]]

Clear[r]

expr = 34334.9 (1 + r) - 150000 (1 + r)^0.16129 + 145472 (1 + r)^0.0645161 - 15177.4;
guess = -0.75;
froot[expr, guess]

{FindRoot::lstol}

No solution

$\endgroup$

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.