1
$\begingroup$

I have a variable sig that is related to the variables (b,zQ,zh) given by torootsig, so I can solve this sig from the corresponding values of (b,zQ,zh). I setup a FindRoot of their relation for later input of the variables (b,zQ,zh).

Now, I have a function SQ where I want to find its minimum value at some point zQ. The function SQ is a function of (sig,b,zQ,zh), but since sig can be written as a function of (b,zQ,zh), SQ can just be written in terms of (b,zQ,zh).

The values of the variables are, b=0.1, 0.1<zh<0.9, and zQ is the one I am finding.

d = 3;
ag = 10;
pg = 10;
wp = 20;
f[z_, zh_] := 1 - (z/zh)^(d + 1);
torootsig[b_?NumericQ, sig_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := Module[{br, sigr, zQr, zhr}, {br, sigr, zQr, zhr} = Rationalize[{b, sig, zQ, zh}, 0]; br - NIntegrate[z^d/Sqrt[f[z, zhr] (zQr^(2 d) (1 + (sigr^2/f[zQr, zhr])) - z^(2 d))], {z, 0, zQr}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxRecursion -> 20]]
sig[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := sig /. FindRoot[torootsig[b, sig, zQ, zh], {sig, -0.3, -1.5, 0}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxIterations -> 100]
intSQ1[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := Module[{br, zQr, zhr}, {br, zQr, zhr} = Rationalize[{b, zQ, zh}, 0]; (-1/(d - 1)) (1/(zQr^(2 d) (1 + sig[br, zQr, zhr]^2/f[zQr, zhr]))) NIntegrate[z^d Sqrt[f[z, zhr]/(1 - (1/(zQr^(2 d) (1 + sig[br, zQr, zhr]^2/f[zQr, zhr]))) z^(2 d))], {z, 0, zQr}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxRecursion -> 20]]
intSQ2[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := Module[{br, zQr, zhr}, {br, zQr, zhr} = Rationalize[{b, zQ, zh}, 0]; (-1/(2 zhr^(d + 1))) ((d + 1)/(d - 1)) NIntegrate[z Sqrt[(1 - (1/(zQr^(2 d) (1 + sig[br, zQr, zhr]^2/f[zQr, zhr]))) z^(2 d))/f[z, zhr]], {z, 0, zQr}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxRecursion -> 20]]
intSQ3[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := Module[{br, zQr, zhr}, {br, zQr, zhr} = Rationalize[{b, zQ, zh}, 0]; (1/zhr)^(d + 1) NIntegrate[z/Sqrt[f[z, zhr] (1 - (1/(zQr^(2 d) (1 + sig[br, zQr, zhr]^2/f[zQr, zhr]))) z^(2 d))], {z, 0, zQr}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxRecursion -> 20]]
SQ[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := Module[{br, zQr, zhr}, {br, zQr, zhr} = Rationalize[{b, zQ, zh}, 0]; (-Sqrt[f[zQr, zhr] (1 - (1/(zQr^(2 d) (1 + sig[br, zQr, zhr]^2/f[zQr, zhr]))) zQr^(2 d))]/((d - 1) zQr^(d - 1)) + intSQ1[br, zQr, zhr] + intSQ2[br, zQr, zhr] + intSQ3[br, zQr, zhr] + 1/zQr^(d - 1))/4 ]

If I plot sig for zh=0.1 and zh=0.9, then I get

Plot[sig[0.1, zQ, 0.1], {zQ, 0.0994, 0.1}, PlotPoints -> 3, Frame -> True, FrameStyle -> Directive[Black, 18], PlotStyle -> {Blue, Thickness[0.005]}, PlotRange -> Full, ImageSize -> Large] // AbsoluteTiming(*{sig,-0.008,-0.2,0}*)

Image1

Plot[sig[0.1, zQ, 0.9], {zQ, 0.54, 0.9}, PlotPoints -> 3, Frame -> True, FrameStyle -> Directive[Black, 24], PlotStyle -> {Blue, Thickness[0.005]}, PlotRange -> Full, ImageSize -> Large] // AbsoluteTiming(*{sig,-0.5,-2,0}*)

Image2

Take note of the range of sig for the extremes of zh, i.e. zh=0.1 and zh=0.9.

If I apply FindMinimum for each case say, zh=0.1 and zh=0.9, and choose the range of sig in the FindRoot carefully, then I can find the minimum at some zQ.

FindMinimum[SQ[0.1, zQ, 0.1], {zQ, 0.0995, 0.0999}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxIterations -> 20]
{41.70848808, {zQ -> 0.09987512204}}

FindMinimum[SQ[0.1, zQ, 0.9], {zQ, 0.83, 0.86}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxIterations -> 20]
{0.2745876051, {zQ -> 0.8454219108}}

However, If I try to apply FindMinimum for several values at the same time, say zh spanning from 0.1 to 0.9 with an interval of 0.1, then Mathematica complains since if I choose a range that cover 0.1<zh<0.9, it seems like it is too big of a range for Mathematica to converge to the minimum, especially if I choose a starting point that is closer to zh=0.1, then it will complain about values closer to zh=0.9 and vice versa.

Table[FindMinimum[{SQ[0.1, zQ, zh/10]}, {zQ, 0.96 (zh/10), 0.93 (zh/10), 0.999 (zh/10)}, AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, MaxIterations -> 100], {zh, 1, 9, 1}] // AbsoluteTiming(*zQ for zh=0.1 to zh=0.9*)

FindRoot::lstol: 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 20.` digits of working precision to meet these tolerances.

FindRoot::lstol: 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 20.` digits of working precision to meet these tolerances.

FindRoot::lstol: 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 20.` digits of working precision to meet these tolerances.

General::stop: Further output of FindRoot::lstol will be suppressed during this calculation.

FindMinimum::reged: The point {0.093} is at the edge of the search region {0.093000000000000000000,0.099900000000000000000} in coordinate 1 and the computed search direction points outside the region.

FindMinimum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the function. You may need more than 20.` digits of working precision to meet these tolerances.

FindMinimum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the function. You may need more than 20.` digits of working precision to meet these tolerances.

FindMinimum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the function. You may need more than 20.` digits of working precision to meet these tolerances.

General::stop: Further output of FindMinimum::lstol will be suppressed during this calculation.

Is there any way to apply FindRoot and FindMinimum for a big range? I have also tried using a big working precision, say 500, but still the same error so I just reverted back to 20 since it just took a longer time anyways.

$\endgroup$
6
  • 1
    $\begingroup$ I cannot find a question being asked in this post. Can you, please, edit your post and clearly state your question? $\endgroup$ Aug 24 at 18:26
  • $\begingroup$ I am unable to reproduce your first plot. Please confirm that the code is correct. I can, however, reproduce your second plot. $\endgroup$
    – bbgodfrey
    Aug 25 at 20:19
  • $\begingroup$ @bbgodfrey You can use the range {sig,-0.008,-0.2,0} for FindRoot to obtain the first plot. See the comment at the end of the code for the first plot. $\endgroup$
    – mathemania
    Aug 25 at 20:40
  • $\begingroup$ Likewise, I am unable to reproduce the results of your first FindMinimum call, Instead receiving a string of error messages. Please confirm that the code is correct. I can reproduce the results of your second call. $\endgroup$
    – bbgodfrey
    Aug 25 at 20:40
  • $\begingroup$ @mathemania Yes, that change reproduces your first plot and also the results of your first call to FindMinimum. I suggest that you modify your question to make clear the specific parameters you used to call FindRoot. $\endgroup$
    – bbgodfrey
    Aug 25 at 20:49
2
$\begingroup$

There is no "silver bullet" that allows FindRoot to work well independent of the initial guess and allowed range. However, some modest changes to a portion of the code solves the problem at hand:

sig[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] := 
    sig /. FindRoot[torootsig[b, sig, zQ, zh], {sig, -0.008, -1.5, 0}, 
    AccuracyGoal -> ag, PrecisionGoal -> pg, WorkingPrecision -> wp, 
    MaxIterations -> 100]

and

Table[FindMinimum[SQ[0.1, zQ, zh/10], {zQ, 0.995 (zh/10), 0.93 (zh/10), 
    0.999 (zh/10)}, AccuracyGoal -> ag/2, PrecisionGoal -> pg/2, 
    WorkingPrecision -> wp, MaxIterations -> 100], {zh, 1, 9}]

(* {{41.708488082871755339, {zQ -> 0.099875122173899104886}}, 
    {7.3882696485627023476, {zQ -> 0.19730320573040630212}}, 
    {2.8757698770873017009, {zQ -> 0.29157451761998630781}}, 
    {1.5166624430845260746, {zQ -> 0.38432981366296936968}}, 
    {0.93669614150771657618, {zQ -> 0.47655732465217074490}}, 
    {0.63663715445176335400, {zQ -> 0.56867227658480048990}}, 
    {0.46128372679685788584, {zQ -> 0.66082912902815081500}}, 
    {0.34985408866400740299, {zQ -> 0.75307646956556178437}}, 
    {0.27458760506030462097, {zQ -> 0.84542190572477149758}}} *)

The primary error messages given in the question appear to result from the following:

FindRoot::lstol: 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 20.` digits of working precision to meet these tolerances.

occurs in this question, because the definition of sig appears to fail for zQ too small, so we must avoid that region.

FindMinimum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the function. You may need more than 20.` digits of working precision to meet these tolerances.

occurs in this question, because FindRoot produces input to FindMinimum with precision pg (at best), so we should not be surprised if FindMinimum produces output with precision less than that. Asking for a lower precision solves the problem.

As a sidelight, here is a plot of sig vs zQ/zH`.

Plot[Evaluate@Table[sig[0.1, n z, n], {n, .1, .9, .1}], {z, .5, 1}, 
    Frame -> True, PlotPoints -> 3, FrameStyle -> Directive[Black, 18], 
    PlotStyle -> Thickness[0.005], PlotRange -> Full, ImageSize -> Large,
    FrameLabel -> {"zQ/zH", "sig"}]

enter image description here

Avoid regions where sig is zero.

$\endgroup$
4
  • $\begingroup$ Just a side question, why is it that precision is poor for sig=0? It's still a number right? $\endgroup$
    – mathemania
    Aug 30 at 21:57
  • $\begingroup$ @mathemania I was mistaken. Some experimentation reveals instead that FindRoot convergence sometimes is too slow there. I deleted my last sentence. By the way, I plotted, Plot[sig[0.1, zQ, 0.1], {zQ, 0.099123, 0.099124}, ImageSize -> Large], which shows a discontinuity. I do not have time to investigate why, or even if it matters. $\endgroup$
    – bbgodfrey
    Aug 31 at 4:49
  • $\begingroup$ Your analysis really helped me understand the problem, however, when I use your code to plot, Mathematica complains 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. So this means that it can show the plot but with accuracy and precision less than what I imposed right? $\endgroup$
    – mathemania
    Aug 31 at 9:55
  • $\begingroup$ @mathemania By experimentation, I have found that this error only occurs for your question when Plot tries to evaluate points for sig equal to zero. Because SQ is not maximized there, such points should be of no interest, I believe. $\endgroup$
    – bbgodfrey
    Aug 31 at 14:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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