Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Root finding needs higher accuracy

  • To: mathgroup at smc.vnet.net
  • Subject: [mg123159] Re: Root finding needs higher accuracy
  • From: "Oleksandr Rasputinov" <oleksandr_rasputinov at hmamail.com>
  • Date: Fri, 25 Nov 2011 04:53:58 -0500 (EST)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <jalbrn$sib$1@smc.vnet.net>

On Thu, 24 Nov 2011 12:04:07 -0000, HwB <hwborchers at googlemail.com> wrote:

> I would like to numerically find the root of the following function
> with up to 20 digits.
>
>     f12[x_] := Log[x] + x^2 / (2 Exp[1]) - 2 x / Sqrt[Exp[1]] + 1
>
> This problem is known to be difficult for solvers in double precision
> arithmetics. I thought it should be easy with Mathematica, but the
> following attempts were not successful.
>
>     SetPrecision[
>         x /. FindRoot[f12[x], {x, 1.0, 3.4}, Method -> "Brent",
>                  AccuracyGoal -> Infinity, PrecisionGoal -> 20], 16]
>     # 1.648732212532746
>     SetPrecision[
>         x /. FindRoot[f12[x], {x, 1.0, 3.4}, Method -> "Secant",
>                  AccuracyGoal -> Infinity, PrecisionGoal -> 20], 16]
>     # 1.648710202030051
>
> The true root obviously is Sqrt[Exp[1]]//N = 1.648721270700128...
>
> The symbolic solver explicitely says it cannot solve this expression.
> What do I need to do to get a much more exact result out of
> Mathematica?
>
> Many thanks, Hans Werner
>

This example needs quite high working precision in order to get the right  
answer. Why PrecisionGoal doesn't deal with this automatically I am not  
sure, but one can see how much precision is required for any given number  
of correct output digits by adapting one of the examples from the FindRoot  
documentation as follows:

Block[{prec = MachinePrecision},
  FindRoot[f12[x], {x, 1.0, 3.4},
   PrecisionGoal -> 50, WorkingPrecision -> 250,
   MaxIterations -> Infinity,
   StepMonitor :> If[Precision[x] != prec,
     prec = Precision[x];
     Print["Increased precision to ", prec, " at x = ", x];
    ]
  ] ~N~ 50
]

Increased precision to 22.5696 at x = 1.6487322125327459332311

Increased precision to 36.5184 at x = 1.648721374841646612577391800\
565954854

Increased precision to 59.0881 at x = 1.648721270702420370629525870\
3627276509506510504319572642272

Increased precision to 95.6065 at x = 1.648721270700128146916322464\
88686398379199745290239060756077856939685227628191642463512718464832

Increased precision to 154.695 at x = 1.648721270700128146848650787\
8142075038521581133809975282156292557669985282581157969309334240808\
833720966852901635178145293354315920227892691746952853066932

{x -> 1.6487212707001281468486507878141635716537761007102}

This gives the correct answer to 50 places, but 250 digits of working  
precision is only just enough to achieve this. For your example of 16  
correct places, 48 digits of working precision are required.



  • Prev by Date: Re: Using Equal with Real Numbers
  • Next by Date: Re: Using Equal with Real Numbers
  • Previous by thread: Re: Root finding needs higher accuracy
  • Next by thread: Re: Root finding needs higher accuracy