Manipulate running indefinitely for a certain value of a dynamic parameter

Question

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.

Answer 1

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

Answer 2

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

---

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