# Manipulate - strange behaviour with NSolve (I suppose)

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?

• Have you tried to reduce these ~50 lines of code to something shorter and isolate the location of the error? – Szabolcs Oct 27 '15 at 10:48
• @Szabolcs: Yes, as I said, I suspect that the problem is by the definition of "doptini". If I split the code between Manipulateand the line where Columnstarts and evaluate it, I get the right results, but inside Manipulate, it seems that "doptini" and recursively "dopt" are not (quick enough?) evaluated... – Conrad Oct 27 '15 at 10:56

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]

• I've observed that the option Quiet by definition of "doptini" seems to be ignored now, cause I get each time the known warning "Solve was unable to solve the system with inexact coefficients...". Could this be due to the Ifstatement? – Conrad Oct 27 '15 at 12:14
• I put back in the Quiet option, so it should be quiet after that – Jason B. Oct 27 '15 at 12:23