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.

Improve this question
$\endgroup$
8
  • 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, 2015 at 13:07
  • $\begingroup$ @Michael E2: See updated title and clarification of messages $\endgroup$
    – Stephen
    Aug 13, 2015 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, 2015 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, 2015 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, 2015 at 13:55

4 Answers 4

Reset to default
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

Improve this answer
$\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.

Improve this answer
$\endgroup$
8
  • $\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, 2015 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, 2015 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, 2015 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, 2015 at 15:00
  • $\begingroup$ @Michael E2: Your formatting suggestion is what I wanted. $\endgroup$
    – Stephen
    Aug 13, 2015 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

Improve this answer
$\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).

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.