5
$\begingroup$

I have made a knockoff of John Polking's dfield for a web-embedded CDF (via Enterprise Mathematica). My code extends that from Belisarius who last year showed me how to use ClickPane to store and clear solution curves.

Although clicking on any point of the slope field produces an apparently correct solution curve, an error message NDSolve::ndsz is generated by NDSolve. Moreover, by choosing an initial value near the point with coordinates (2,-2) and following by moving the "b" slide from its default position, the slope field turns the color pink and I get the message "InterpolatingFunction::dmval: Input value {-1.99992} lies outside the range of data in the interpolating function. Extrapolation will be used."

sf := 
  VectorPlot[{1, diffEq /. {a -> A, b -> B}}, {t, -2, 2}, {x, -2, 2},
    VectorPoints -> 17,
    VectorScale -> {0.03, Automatic, None}, 
    VectorStyle -> {{Red, Arrowheads[0]}}, ImagePadding -> 1, 
    PerformanceGoal -> "Speed"];

f[t_, a_, b_, t0_, x0_] := 
  u[t] /. First[Quiet[NDSolve[{u'[t] == ODE, u[t0] == x0}, u, {t, -2, 2}, 
                  Method -> "StiffnessSwitching"]]];

Manipulate[
  ODE = diffEq /. {a -> A, b -> B} /. x -> u[t];
  ClickPane[
    Show[
      Plot[g, {t, -2, 2}, 
        PlotRange -> 2, Frame -> True, 
        ImageSize -> 400, AspectRatio -> 0.75], 
      sf, 
      Graphics[{PointSize[Large], Point[sp]}]],
    (AppendTo[g, f[t, A, B, #[[1]], #[[2]]]]; {t0, u0} = #; 
     AppendTo[sp, #]) &],
  Style["Enter f(t,x)"],
  {{diffEq, x^2 - a t + b, "dx/dt = "}},
  {{A, 1, "a"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom},
  {{B, 0, "b"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom},
  Button["clear", {g = {}; sp = {}}, ImageSize -> {40, 20}], 
  Initialization :> {(
    g = {}; sp = {}; {t0, x0} = {})},
  SaveDefinitions -> True]

FYI, the ODE that I have set as an input is the default used in dfield.

enter image description here

The two error messages that I get are probably related.

NDSolve::ndsz: At t == -1.71226, step size is effectively zero; singularity or stiff system suspected. >>

InterpolatingFunction::dmval: Input value {-1.99992} lies outside the range of data in the interpolating function. Extrapolation will be used. >>

I do not have sufficient Mathematica chops to fix my problem.

$\endgroup$
  • 1
    $\begingroup$ (1) The NDSolve::ndsz message is technically a warning, not an error. It may just be telling you that there is a singularity, which is not an error. (2) You mention error in the singular at first and two errors at the end. Are they the same error? (3) What do the sliders a and b do? (4) Look up Quiet. There are other ways to handle the message, but I'm not sure I understand the question well enough yet. (5) I added the message identifier based on the text in your title. It helps others who get the same message. If you're getting two different messages, consider adding that one, too. $\endgroup$ – Michael E2 Aug 13 '15 at 13:07
  • $\begingroup$ @Michael E2: See updated title and clarification of messages $\endgroup$ – Stephen Aug 13 '15 at 13:35
  • $\begingroup$ @m_goldberg We're editing simultaneously -- I thought SE prevented/warned us. We seem to be clashing here. Looks ok, now, I think...Look good to you? $\endgroup$ – Michael E2 Aug 13 '15 at 13:48
  • $\begingroup$ I changed your title and inserted examples of the messages into the body of your question. Your title was inaccurate. Only one of messages is produced by NDSolve. The other is produced by InterpolatingFunction when f is being plotted. $\endgroup$ – m_goldberg Aug 13 '15 at 13:51
  • $\begingroup$ @MichaelE2. Editing wars are not prevented by SE, unfortunately. The warnings often show up too late. Sorry about the clash. I'm done editing for now. $\endgroup$ – m_goldberg Aug 13 '15 at 13:55
4
$\begingroup$

Re NDSolve::ndsz: Using WhenEvent, one can stop the integration before the solution reaches an infinite singularity, which is what is happening with the example differential equation. I removed the Quiet so one might test it. If the differential equation is changed, then it would be possible to get the message to appear. Use Quiet to suppress it, Check to deal with it.

Re InterpolatingFunction::dmval: Using the NDSolve option

"ExtrapolationHandler" -> {Indeterminate &, "WarningMessage" -> False}

prevents extrapolation and turns off the warning message.

Random changes: I incorporated needed definitions in the Initialization option instead of SaveDefinitions; see The dangers of SaveDefinitions --- should this really happen? I made the functions explicitly depend on the Manipulate variables. This is just a good habit when developing code, especially Dynamic code. Otherwise, one day it works, and the next a minor change breaks the dynamic updating. I localized g and sp. One might want to localize the functions, too. I probably did a few other idiosyncratic things as I went along. None of these had anything to do with the two messages the OP asked about.

Manipulate[
 ClickPane[
  Show[
   Plot[g, {t, -2, 2}, PlotRange -> 2, Frame -> True, 
    ImageSize -> 400, AspectRatio -> 0.75],
   sf@dx[diffEq, A, B],
   Graphics[{PointSize[Large], Point[sp]}]],
  (AppendTo[g, f[dx[diffEq, A, B], #]];
    AppendTo[sp, #]) &],

 Style["Enter f(t,x)"],
 {{diffEq, x^2 - a t + b, "dx/dt = "}},
 {{A, 1, "a"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom},
 {{B, 0, "b"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom},
 {{g, {}}, ControlType -> None}, {{sp, {}}, ControlType -> None},
 Button["clear", g = {}; sp = {}, ImageSize -> {Automatic, 20}],

 Initialization :> (    (* alternative to SaveDefinitions -> True; *)
   Clear[f, sf, dx]; 
   g = {};
   sp = {};
   dx[de_, a0_, b0_] := de /. {a -> a0, b -> b0};
   sf[dx_] := VectorPlot[{1, dx},
     {t, -2, 2}, {x, -2, 2},
     VectorPoints -> 17, VectorScale -> {0.03, Automatic, None}, 
     VectorStyle -> {{Red, Arrowheads[0]}}, ImagePadding -> 1, 
     PerformanceGoal -> "Speed"];
   f[dx_, {t0_, x0_}] := u[t] /. 
      First@ NDSolve[            (* consider `Quiet`, `Check` to handle NDSolve::ndsz *)
       {u'[t] == dx /. {x -> u[t]}, u[t0] == x0,
        WhenEvent[Abs[u[t]] > 3, "StopIntegration"]},
       u, {t, -2, 2},
       Method -> "StiffnessSwitching", 
       "ExtrapolationHandler" -> {Indeterminate &, "WarningMessage" -> False}];
   )]

Mathematica graphics


A somewhat more robust way might be to use the functionality for this sort of thing built into VectorPlot. One significant difference is that it will not draw solutions when they get too close to one another, and no solution if it starts too close to another solution. It allows one to simplify the code considerably since VectorPlot handles all the NDSolve stuff under the hood.

Another difference is that the curves automatically change when the a or b sliders are changed, since VectorPlot recomputes the stream lines.

Manipulate[
 ClickPane[
  Show[
   VectorPlot[{1, dx[diffEq, A, B]}, {t, -2, 2}, {x, -2, 2}, 
    VectorPoints -> 17, VectorScale -> {0.03, Automatic, None}, 
    VectorStyle -> {{Red, Arrowheads[0]}}, ImagePadding -> 1, 
    PerformanceGoal -> "Speed", PlotRange -> 2, Frame -> True, 
    ImageSize -> 400, AspectRatio -> 0.75,
    StreamPoints -> {Thread[
       {sp,
        Table[
         Directive[ColorData[97, i], AbsoluteThickness[1.6]], {i, 
          Length@sp}]}]},
    StreamScale -> None],
   Graphics[{PointSize[Large], Point[sp]}]],
  AppendTo[sp, #] &],

 Style["Enter f(t,x)"],
 {{diffEq, x^2 - a t + b, "dx/dt = "}},
 {{A, 1, "a"}, -4, 4, 0.01, Appearance -> "Labeled", 
  ControlPlacement -> Bottom},
 {{B, 0, "b"}, -4, 4, 0.01, Appearance -> "Labeled", 
  ControlPlacement -> Bottom},
 Button["clear", sp = {}, ImageSize -> {Automatic, 20}],

 Initialization :> (
   Clear[dx];
   sp = {};
   dx[de_, a0_, b0_] := de /. {a -> a0, b -> b0};
   )]

Mathematica graphics

$\endgroup$
4
$\begingroup$

I think your Quiet is not in the right place, and you may need another one.

For f:

f[t_, a_, b_, t0_, x0_] := 
  Quiet[u[t] /. 
    First[NDSolve[{u'[t] == ODE, u[t0] == x0}, u, {t, -2, 2}, 
      Method -> "StiffnessSwitching"]]];

gets rid of the NDSolve warning. Then add another Quiet around the Plot:

Quiet[Plot[g, {t, -2, 2}, PlotRange -> 2, Frame -> True, 
  ImageSize -> 400, AspectRatio -> 0.75]]

This removes the InterpolatingFunction warning.

$\endgroup$
  • $\begingroup$ +1. LOL, I didn't even notice the Quiet around the NDSolve. I took it that the OP was actually getting the singularity warning... $\endgroup$ – Michael E2 Aug 13 '15 at 14:11
  • $\begingroup$ That did it bill s! All is Quiet now. And I don't get the pink colored plot. $\endgroup$ – Stephen Aug 13 '15 at 14:28
  • $\begingroup$ @Michael E2: I like your formatting touch that enlarges the font for "Enter f(t,x)" and "dx/dt". How do I make the rhs of the ODE, "b-at+x^2" to display in a bigger font size? $\endgroup$ – Stephen Aug 13 '15 at 14:37
  • $\begingroup$ @Stephen I'm not sure to what formatting touch you're referring, but maybe {{diffEq, x^2 - a t + b, "dx/dt = "}, BaseStyle -> {FontSize -> 14}} will do what want. $\endgroup$ – Michael E2 Aug 13 '15 at 15:00
  • $\begingroup$ @Michael E2: Your formatting suggestion is what I wanted. $\endgroup$ – Stephen Aug 13 '15 at 15:22
2
$\begingroup$

The following turns off the warning messages, but is not really a good solution, since it doesn't deal with the root problem of the trouble NDSolve is having with your differential equation.

sf[eq_, A_, B_] := 
  VectorPlot[{1, eq /. {a -> A, b -> B}}, {t, -2, 2}, {x, -2, 2}, 
    VectorPoints -> 17, VectorScale -> {0.03, Automatic, None}, 
    VectorStyle -> {{Red, Arrowheads[0]}}, ImagePadding -> 1,
    PerformanceGoal -> "Speed"]

f[t_, a_, b_, t0_, x0_] := 
   u[t] /. 
     First[Quiet @ NDSolve[{u'[t] == ODE, u[t0] == x0}, u, {t, -2, 2}, 
                     Method -> "StiffnessSwitching"]]

Manipulate[
  ODE = diffEq /. {a -> A, b -> B} /. x -> u[t];
  ClickPane[
    Show[
      Quiet @ Plot[g, {t, -2, 2},
        PlotRange -> 2, Frame -> True, ImageSize -> 400, AspectRatio -> 0.75],
      sf[diffEq, A, B],
      Graphics[{PointSize[Large], Point[sp]}]], 
    (AppendTo[g, f[t, A, B, #[[1]], #[[2]]]]; {t0, u0} = #;
     AppendTo[sp, #]) &],
  Style["Enter f(t,x)", 12],
  {{diffEq, x^2 - a t + b, Style["dx/dt = ", 12]}}, 
  {{A, 1, "a"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom}, 
  {{B, 0, "b"}, -4, 4, 0.01, Appearance -> "Labeled", ControlPlacement -> Bottom}, 
  Button[Style["Clear", 10], {g = {}; sp = {}}, ImageSize -> {50, 25}],
  Initialization :> (g = {}; sp = {}; {t0, x0} = {}),
  SaveDefinitions -> True]

diff_eq

$\endgroup$
1
$\begingroup$

I've not answered any questions with this example, but I added tmin, tmax, xmin, xmax, and adjusted when to halt the integration. I don't know yet how to handle the Check command in MichaelE2's comment, so that still remains in the code.

Manipulate[ClickPane[Show[Plot[g, {t, tmin, tmax},
    PlotRange -> {{tmin, tmax}, {xmin, xmax}},
    Frame -> True, ImageSize -> 400, AspectRatio -> 0.75], 
   sf@dx[diffEq, A, B], 
   Graphics[{PointSize[Large], Point[sp]}]], (AppendTo[g, 
     f[dx[diffEq, A, B], #]];
    AppendTo[sp, #]) &], 
 Style["Enter f(t,x)"], {{diffEq, x^2 - a t + b, "dx/dt = "}},
 Row[{
   Control[{{tmin, -2, "tmin = "}}],
   Spacer[10],
   Control[{{tmax, 10, "tmax = "}}]
   }],
 Row[{
   Control[{{xmin, -4, "xmin = "}}],
   Spacer[10],
   Control[{{xmax, 4, "xmax = "}}]
   }],
 {{A, 1, "a"}, -4, 4, 0.01, Appearance -> "Labeled", 
  ControlPlacement -> Bottom}, {{B, 0, "b"}, -4, 4, 0.01, 
  Appearance -> "Labeled", ControlPlacement -> Bottom}, {{g, {}}, 
  ControlType -> None}, {{sp, {}}, ControlType -> None}, 
 Button["clear", g = {}; sp = {}, ImageSize -> {Automatic, 20}], 
 Initialization :> ((*alternative to SaveDefinitions\[Rule]True;*)
   Clear[f, sf, dx];
   g = {};
   sp = {};
   dx[de_, a0_, b0_] := de /. {a -> a0, b -> b0};
   sf[dx_] := 
    VectorPlot[{1, dx}, {t, tmin, tmax}, {x, xmin, xmax}, 
     VectorPoints -> 17, VectorScale -> {0.03, Automatic, None}, 
     VectorStyle -> {{Red, Arrowheads[0]}}, ImagePadding -> 1, 
     PerformanceGoal -> "Speed"];
   f[dx_, {t0_, x0_}] := 
    u[t] /. First@
      NDSolve[(*consider `Quiet`,`Check` to handle NDSolve::ndsz*){u'[
           t] == dx /. {x -> u[t]}, u[t0] == x0, 
        WhenEvent[Abs[u[t]] > 2.5 Max[{Abs[xmin], Abs[xmax]}], 
         "StopIntegration"]}, u, {t, tmin, tmax}, 
       Method -> "StiffnessSwitching", 
       "ExtrapolationHandler" -> {Indeterminate &, 
         "WarningMessage" -> False}];)] 

enter image description here

I've also adjusted tmin, tmax, xmin, xmax to match the default image in John Polking's dfield program.

enter image description here

I like the use of keeping the parameters a and b at the bottom, as you can use them in other functions. For example, try (a-x)(b-x).

$\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.