1
$\begingroup$

I am trying to investigate the effect of a parameter on a curve using Manipulate. See below.

F[y_, x_, a_, b_] := a*x^2 + b*x + y^2 + 1;


X = Table[i, {i, 0.1, 4, 0.01}];

            
Manipulate[
 Subscript[y, 01] = Quiet[y/.Solve[F[y, 0.1, 0, b] == 0, y][[1]]];

 Subscript[y, 1] = Table[sol = y/. FindRoot[F[y, x, 0, b] == 0, {y,Subscript[y,01]}]; 
 Subscript[y, 01] = sol, {x, 0.1, 4, 0.01}];
 
 ListLinePlot[Transpose[{X, Subscript[y, 1]}]], {b, 0, 0.5}]

Message: Recursion depth of 1024 exceeded during evaluation of

The code runs perfectly fine for the first few minutes. However, when it reaches b = 0.33 (an approximate value), the code runs indefinitely.

What could be the cause, and how can I fix it?

Thank you in advance.

$\endgroup$
1
  • $\begingroup$ It seems unlikely that the problem would be in Manipulate if it works for other values. As an aside, your code is pretty fragile: I get errors and warnings for most values of b anyway, just not the recursion error that you mention. Find a value of $b$ that reproduces that behavior (and add that to the question) then troubleshoot the underlying code for that value. $\endgroup$
    – MarcoB
    Sep 11 at 18:29

2 Answers 2

2
$\begingroup$
$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global`*"]

Use exact values for known constants.

F[y_, x_, a_, b_] = 
  
  0.5/((y - a*x)^2 - 0.3*x^2) + 0.5/((y - b*x)^2 - 0.3*x^2) - 1/x^2 - 1 // 
    Rationalize // Simplify;

X = Table[i, {i, 1/10, 4, 1/100}];

SolveValues[F[y, 1/10, 0, 0] == 0, y][[1]] // N

(* -0.113583 *)

To preclude any switches in the solution branch, in the Solve, constrain y to be negative .

Manipulate[
 br = Rationalize[b];
 Subscript[y, 01] =
  SolveValues[{F[y, 1/10, 0, br] == 0, y < 0}, y][[1]];
 Subscript[y, 1] = Table[
   Subscript[y, 01] = y /. 
     FindRoot[F[y, x, 0, br] == 0, {y, Subscript[y, 01]}],
   {x, X}];
 ListLinePlot[Transpose[{X, Subscript[y, 1]}]], {{b, 0}, 0, 0.5, 0.005, 
  Appearance -> "Labeled"},
 SynchronousUpdating -> False,
 TrackedSymbols :> {b}]

enter image description here

$\endgroup$
2
$\begingroup$

An alternative to calculating your results on the fly when plotting is to pre-calculate them at an appropriate resolution, then group them by the respective value of the $b$ parameter, and finally use Manipulate to select which subset to display:

results =
  Table[
    FoldList[
      Function[{triplet, newX}, {Rationalize@b, newX, y /. FindRoot[F[y, newX, 0, b] == 0, {y, triplet[[3]]}]}],
      {Rationalize@b, 0.1, First@NSolveValues[F[y, 0.1, 0, b] == 0, y]},
      (* values of x *)
      Range[0.1 + 0.01, 4, 0.01]
    ],
    {b, 0, 0.5, 0.01}
    ] ~ Flatten ~ 1 // GroupBy[First -> Rest];

Once the results are pre-calculated, their display is very fast and troublefree:

Manipulate[
 ListLinePlot[results[Rationalize@b], PlotRange -> All],
 {b, 0, 0.5, 0.05}
]

manipulate to visualize the curve corresponding to a specific value of b


This approach also has the advantage that you can display trends as a function of b:

ListLinePlot[
  KeyMap[ToString@*N, results],
  PlotLabels -> Automatic, AspectRatio -> 2,
  ImagePadding -> {{0, 75}, {0, 0}}
]

all curves together, with b labels

$\endgroup$

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.