Manipulate - strange behaviour with NSolve (I suppose)

Question

I have written the following code for a mechanical calculation. The calculation works, but as soon as I try to use Manipulate(needed to generate a .cdf after all), after quitting and re-starting the kernel (or if I open the file next time), I only get a loop of errors. I think the problem is caused by the parameter "doptini", which is not calculated quick enough inside Manipulate, but I am not sure and I also don't know how to correct it... I have also tried to use Maximizeinstead of NSolve, but no change.

Manipulate[
 cG = 81500;
 tM[d_] := (2105 - 780*Log10[d])*0.45;
 dstd = {0.2, 0.25, 0.32, 0.36, 0.40, 0.45, 0.50, 0.55, 0.63, 0.70, 
   0.80, 0.90, 1.00, 1.10, 1.25, 1.30, 1.40, 1.50, 1.60, 1.80, 2.00, 
   2.20, 2.50, 2.80, 3.00, 3.20, 3.60, 4.00, 4.50, 5.00, 5.50, 6.30, 
   7.00, 8.00};
 t0[d_] := (0.135 - 0.00625*dmed[d]/d)*(2105 - 780*Log10[d]);
 dmed[d_] := dme - d;
 lf[d_, n_] := (n + 1)*d;
 dmd[d_] := dmed[d]/d;
 w[d_] := (dmd[d] + 0.5)/(dmd[d] - 0.75);
 step = 0.1;
 mind = 0.1;
 maxd = 8;
 nw[d_] := (l1 + r - 2*dmed[d])/d - 1;
 k[d_] := cG*d^4/(8*dmed[d]^3*nw[d]);
 f0[d_] := t0[d]*If[cf == False, 1, 1/w[d]]*Pi*d^3/(8*dmed[d]);
 fmax[d_] := Pi*d^3*tM[d]/(8*dmed[d]*w[d]);
 f2[d_] := k[d]*(l2 - l1) + f0[d];
 doptini = 
  d /. Last[Quiet@ NSolve[{f2[d] == fmax[d], mind < d < maxd}, d, Reals]];
 dopt = Max@Select[dstd, # < doptini &];
 Column[{Grid[{{"R-d", "k", "n", "FLe", "F0", "F1", "F2", 
  "Cf"}, {doptini, k[doptini], nw[doptini], 
  lf[doptini, nw[doptini]], f0[doptini], 
  f2[doptini] - k[doptini]*(l2 - l1), f2[doptini], w[doptini]},
 {dopt, k[dopt], nw[dopt], lf[dopt, nw[dopt]], f0[dopt], 
  f2[dopt] - k[dopt]*(l2 - l1), f2[dopt], w[dopt]}}, Frame -> All],
  Show[Plot[{f2[d], fmax[d]}, {d, mind, maxd}, 
    PlotLegends -> "Expressions", AxesLabel -> {"d", "F"}, 
    PlotLabel -> "3 fs", GridLines -> Automatic, 
    PlotRange -> {{0.7*dopt, 1.3*dopt}, {0, fmax[dopt]*1.5}}, 
    ImageSize -> Large],
   ListPlot[{{doptini, f2[doptini]}}, Filling -> Axis],
   ListPlot[{{dopt, f2[dopt]}}, Filling -> Axis]]
  }],
{{l2, 80, "L2 :  "}, 15, 200, 0.1, Appearance -> "Labeled"},
{{l1, 50, "L1 :  "}, 10, 100, 0.1, Appearance -> "Labeled"},
{{dme, 10, "dme :  "}, 5, 20, 0.1, Appearance -> "Labeled"},
{{r, 5, "(L1 - L0) :  "}, 1, 50, 0.1, Appearance -> "Labeled"},
{{cf, "True", " > "}, {True, False}}, LocalizeVariables -> True, 
SaveDefinitions -> True]  

Could somebody help me with this?

Answer 1

Use ContinuousAction -> False in your Manipulate command if you have really complicated functions inside. In this way it will only reevaluate the code once you've stopped moving the slider.

I couldn't get your code to work as pasted, because you had the cf variable initialize to "True" instead of True.

After changing that, I found that for some values of l2, there were no solutions of d between 0.1 and 8, so I put in a test to see if there was a solution to the equation before evaluating the rest.

This seems to work

Manipulate[
 Module[{cG, tM, dstd, t0, dmed, lf, dmd, w, step, mind, maxd, nw, k, 
   f0, fmax, f2, sol, output, dopt, doptini},
  cG = 81500;
  tM[d_] := (2105 - 780*Log10[d])*0.45;
  dstd = {0.2, 0.25, 0.32, 0.36, 0.40, 0.45, 0.50, 0.55, 0.63, 0.70, 
    0.80, 0.90, 1.00, 1.10, 1.25, 1.30, 1.40, 1.50, 1.60, 1.80, 2.00, 
    2.20, 2.50, 2.80, 3.00, 3.20, 3.60, 4.00, 4.50, 5.00, 5.50, 6.30, 
    7.00, 8.00};
  t0[d_] := (0.135 - 0.00625*dmed[d]/d)*(2105 - 780*Log10[d]);
  dmed[d_] := dme - d;
  lf[d_, n_] := (n + 1)*d;
  dmd[d_] := dmed[d]/d;
  w[d_] := (dmd[d] + 0.5)/(dmd[d] - 0.75);
  step = 0.1;
  mind = 0.1;
  maxd = 8;
  nw[d_] := (l1 + r - 2*dmed[d])/d - 1;
  k[d_] := cG*d^4/(8*dmed[d]^3*nw[d]);
  f0[d_] := t0[d]*If[cf, 1/w[d], 1]*Pi*d^3/(8*dmed[d]);
  fmax[d_] := Pi*d^3*tM[d]/(8*dmed[d]*w[d]);
  f2[d_] := k[d]*(l2 - l1) + f0[d];
  sol = Quiet@NSolve[{f2[d] == fmax[d], mind < d < maxd}, d, Reals];
  output = 
   If[Length[sol] < 
     1,
    "No solutions within specified bounds", 
    doptini = 
     d /. Last[
       sol];
    dopt = Max@Select[dstd, # < doptini &];
    Column[{Grid[{{"R-d", "k", "n", "FLe", "F0", "F1", "F2", 
         "Cf"}, {doptini, k[doptini], nw[doptini], 
         lf[doptini, nw[doptini]], f0[doptini], 
         f2[doptini] - k[doptini]*(l2 - l1), f2[doptini], 
         w[doptini]}, {dopt, k[dopt], nw[dopt], lf[dopt, nw[dopt]], 
         f0[dopt], f2[dopt] - k[dopt]*(l2 - l1), f2[dopt], w[dopt]}}, 
       Frame -> All], 
      Show[Plot[{f2[d], fmax[d]}, {d, mind, maxd}, 
        PlotLegends -> {"f2(d)", "fmax(d)"}, AxesLabel -> {"d", "F"}, 
        PlotLabel -> "3 fs", GridLines -> Automatic, 
        PlotRange -> {{0.7*dopt, 1.3*dopt}, {0, fmax[dopt]*1.5}}, 
        ImageSize -> Large], 
       ListPlot[{{doptini, f2[doptini]}}, Filling -> Axis], 
       ListPlot[{{dopt, f2[dopt]}}, Filling -> Axis]]}]
    ];
  output
  ]
 , {{l2, 80, "L2 :  "}, 15, 200, 0.1, 
  Appearance -> "Labeled"}, {{l1, 50, "L1 :  "}, 10, 100, 0.1, 
  Appearance -> "Labeled"}, {{dme, 10, "dme :  "}, 5, 20, 0.1, 
  Appearance -> "Labeled"}, {{r, 5, "(L1 - L0) :  "}, 1, 50, 0.1, 
  Appearance -> "Labeled"}, {{cf, True, " > "}, {True, False}}, 
 LocalizeVariables -> True, SaveDefinitions -> True,ContinuousAction -> False]