8
$\begingroup$

I am aware of the Locator button and I am aware of the Equation Trekker package, but they are not what I want to use. Here is what I specifically want to know how to do, if possible. Consider the system:

\begin{align*} x'&=2x+3y\\ y'&=3x+2y \end{align*}

Create a vector plot.

A = {{2, 3}, {3, 2}};
F[x_, y_] = A.{x, y};
VectorPlot[F[x, y], {x, -4, 4}, {y, -4, 4}, Axes -> True,
 AxesLabel -> {x, y},
 VectorScale -> {0.045, 0.9, None},
 VectorPoints -> 16]

enter image description here

Now my question. What I want to be able to do is use my mouse to click a point in the vector plot and as a result, the solution trajectory will be added to the vector plot. I also want to be able to do this repeatedly, click the mouse several times and then several trajectory solutions are plotted on the vector plot starting at the clicked point initial condition.

Is this possible using Mathematica?

KGULER Suggestion: OK, gave your idea Epilog -> {vp[1], Red, PointSize[Large], Point[u]} a try:

ClearAll[a, vp, x, y]
a = {{2, 3}, {3, 2}};
vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, 
   VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16];
options = {PlotStyle -> Red, 
   Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]}, 
   AspectRatio -> 1, Axes -> True, AxesLabel -> {"x", "y"}, 
   Frame -> True, PlotRange -> PlotRange[vp]};

Then:

Manipulate[
 z = NDSolveValue[
     Thread[{x'[t], y'[t], x[0], y[0]} == Join[a.{x@t, y@t}, #]], {x@
       t, y@t}, {t, -2, 1}] & /@ u;
 ParametricPlot[z, {t, -2, 1}, Evaluate@options], {{u, {}}, Locator, 
  Appearance -> None, LocatorAutoCreate -> All}, {z, {}, None}, 
 Paneled -> False]

But I got the following image result and the warning message: "Coordinate $CellContext`u should be a pair of numbers, or a Scaled or Offset form."

enter image description here

However, I still tried the PasteSnapshot and got an image with the dots, but for some reason I can't include it in this post.

So, what have I done wrong?

$\endgroup$
  • $\begingroup$ Using the options directly inside ParametricPlot, i.e., Manipulate[ z = NDSolveValue[ Thread[{x'[t], y'[t], x[0], y[0]} == Join[a.{x@t, y@t}, #]], {x@ t, y@t}, {t, -2, 1}] & /@ u; ParametricPlot[z, {t, -2, 1}, Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]}, PlotStyle -> Red, AspectRatio -> 1, Axes -> True, AxesLabel -> {"x", "y"}, Frame -> True, PlotRange -> PlotRange[vp]], {{u, {}}, Locator, Appearance -> None, LocatorAutoCreate -> All}, {z, {}, None}, Paneled -> False] prevents the error.... $\endgroup$ – kglr Mar 16 '15 at 18:13
  • $\begingroup$ ... or, change Point[u] to Point[pnts] inside options and change Evaluate@options to Evaluate@(options /. pnts -> u) inside ParametricPlot. $\endgroup$ – kglr Mar 16 '15 at 18:16
  • $\begingroup$ I think the first approach is cleaner/safer so that you all symbols are inside Manipulate. You can also Initialization to define options, i.e, add Initialization :> {options = {Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]}, PlotStyle -> Red, AspectRatio -> 1, Axes -> True, AxesLabel -> {"x", "y"}, Frame -> True, PlotRange -> PlotRange[vp]}}. $\endgroup$ – kglr Mar 16 '15 at 18:27
  • $\begingroup$ @kguler: Wow! And you can drag the dot as if it were a locator button, adjusting the trajectory curves.Then when you Paste Snapshot at the end, the red dots still appear. I've found that Ctrl+Clicking the snapshot and saving as a .eps file (.pdf is still a bug when you do this) can be well used in a LaTeX document. I really appreciate your effort on my behalf. My students will benefit from your kindness. $\endgroup$ – David Mar 16 '15 at 19:27
  • $\begingroup$ really glad to know it is useful for you and your students. $\endgroup$ – kglr Mar 16 '15 at 19:33
13
$\begingroup$

Update 2: Using DynamicSetting to turn Manipulate into an input expression to print snapshots:

manipulate = Manipulate[Module[{a = {{2, 3}, {3, 2}}, vp}, 
    vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, 
      VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16];
    z = NDSolveValue[Thread[{x'[t], y'[t], x[0], y[0]} == 
          Join[a.{x@t, y@t}, #]], {x@t, y@t}, {t, -2, 1}] & /@ u;
    plot = ParametricPlot[z, {t, -2, 1}, ImageSize -> 200, 
      Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]}, 
      PlotStyle -> Red, AspectRatio -> 1, Axes -> True, 
      AxesLabel -> {"x", "y"}, Frame -> True, 
      PlotRange -> PlotRange[vp]]], {{u, {}}, Locator, 
    Appearance -> None, LocatorAutoCreate -> All}, {z, {}, None}, {plot, {}, None}];

Evaluate the following line in place, i.e. highlight it and use Ctrl+Shift+Enter:

DynamicSetting[manipulate]

To print the current snapshot in the next cell use Shift+Enter: enter image description here


Update: Adding a button to print a snapshot:

Manipulate[Module[{a = {{2, 3}, {3, 2}}, vp}, 
  vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, 
    VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16]; 
  z = NDSolveValue[Thread[{x'[t], y'[t], x[0], y[0]} == Join[a.{x@t, y@t}, #]], 
    {x@t, y@t}, {t, -2, 1}] & /@ u;
  plot = ParametricPlot[z, {t, -2, 1}, ImageSize -> 300, 
    Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]}, 
    PlotStyle -> Red, AspectRatio -> 1, Axes -> True, 
    AxesLabel -> {"x", "y"}, Frame -> True, 
    PlotRange -> PlotRange[vp]]],
 {{u, {}}, Locator, Appearance -> None, LocatorAutoCreate -> All}, 
 {z, {}, None}, {plot, {}, None}, 
 Button["Print snapshot in next cell", SelectionMove[EvaluationNotebook[], Next, Cell];
  NotebookWrite[EvaluationNotebook[], ToBoxes@plot]]]

enter image description here


Original post:

You can use Locator with the option setting LocatorAutoCreate->All to

create a new locator with any mouse click

ClearAll[a, vp, x, y]
a = {{2, 3}, {3, 2}};
vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, 
     VectorScale -> {0.045, 0.9, None}, VectorPoints -> 16];
dot = Graphics[{Red, PointSize[Large], Point[{0, 0}]}, ImageSize -> 20];
options = {PlotStyle -> Red, Epilog -> vp[[1]], AspectRatio -> 1, 
   Axes -> True, AxesLabel -> {"x", "y"}, Frame -> True, PlotRange -> PlotRange[vp]};

Using the functions returned by NDSolveValue as the first argument of ParametricPlot and using vp above as Epilog, we can let Manipulate manage the mouse click events:

Manipulate[z = NDSolveValue[Thread[{x'[t], y'[t], x[0], y[0]}==Join[a.{x@t, y@t}, #]], 
                           {x@t, y@t}, {t, 0, 1}] & /@ u;
 ParametricPlot[z, {t, 0, 1}, Evaluate@options], 
 {{u, {}}, Locator,  Appearance -> dot, LocatorAutoCreate -> All}, 
 {z, {}, None},  AppearanceElements -> {}, Paneled -> False]

enter image description here

Note: With option setting LocatorAutoCreate->All, you can remove any existing locator using Alt+Click.

$\endgroup$
  • $\begingroup$ Two outstanding presentations! I have two questions on this one. First, when I delete ImageSize->20, it no longer works properly. Very strange. How come? Second, how can a student export the final image to a pdf file. Ctrl+click does not work. $\endgroup$ – David Mar 15 '15 at 20:08
  • $\begingroup$ @David, re ImageSize->20 puzzling indeed -- don't know why removing ImageSize affects how LocatorAutoCreate behaves. Re exporting the final image, you can use ` // Setting` to the right of the manipulate object and Evaluate the cell to create a graphics object with the current settings which then can be saved as pdf using Save Selection As ... Better way would be to add an export button inside Manipulate. If you remove AppearanceElements-{} from the code, you can also use Paste Snapshot and evaluate the resulting cell to get a static graphics that can exported as usual. $\endgroup$ – kglr Mar 15 '15 at 20:32
  • $\begingroup$ ... Re locator appearance: you can also use Appearance->None and add the red dots into the Epilog settings: Epilog -> {vp[[1]], Red, PointSize[Large], Point[u]} . $\endgroup$ – kglr Mar 15 '15 at 20:45
  • $\begingroup$ I tried the //Setting to the right of the manipulate object, but then clicking in the vector field did not work. I tried removing the AppearanceElements->{}, then clicked on the little + button in the upper right hand corner, selected Paste Snapshot and a huge amount of code was produced (any way to suppress that?), which when compiled, produced my image, which I was then able to save. The dots disappeared, so no I understand your last comment and will give it a try. Thanks for this awesome work. $\endgroup$ – David Mar 16 '15 at 17:11
  • $\begingroup$ Interesting. If you remove AppearanceElements-{} and Paneled->False in your original code, then do a Paste Snapshot, the locators disappears and the panel disappears, leaving a very good image for the students to save. $\endgroup$ – David Mar 16 '15 at 19:01
8
$\begingroup$

Using the "almost new" feature of NDSolve[] that allows it to detect vector equations based upon the dimensions of the initial conditions.

a = {{2, 3}, {3, 2}};
vp = VectorPlot[a.{x, y}, {x, -4, 4}, {y, -4, 4}, Axes -> True, 
                AxesLabel -> {x, y}, VectorScale -> {0.045, 0.9, None}, 
                VectorPoints -> 16];


DynamicModule[{pt, ss = {{pt -> ({5, 5} &)}}},
 EventHandler[ Dynamic@ Show[vp, ParametricPlot[pt@t/. ss, {t,0,1}, PlotStyle->Red],
                             Epilog -> {PointSize[Large], Red, Point[pt@0 /. ss]}],
               "MouseDown" :> AppendTo[ss, First@NDSolve[{pt'@t == a.pt@t, 
                              pt@0 == MousePosition["Graphics"]}, pt, {t, 0, 1}]]]]

Mathematica graphics


Or using some tweaks in @kguler's answer you may also do:

DynamicModule[{pt, ss = {}}, 
 EventHandler[
  Dynamic@ParametricPlot[Through@ss@t, {t, 0, 1}, PlotStyle -> Red, Epilog -> 
     {vp[[1]], PointSize[Large], Red, Point@Through@ss@0}, PlotRange -> PlotRange@vp],
  "MouseDown" :> 
  AppendTo[ss, NDSolveValue[{pt'@t == a.pt@t, pt@0 == MousePosition["Graphics"]},
      pt, {t, 0, 1}]]]]
$\endgroup$
  • $\begingroup$ For some reason, this second version makes the Frame disappear. $\endgroup$ – David Mar 16 '15 at 18:21

protected by Community Mar 18 '15 at 11:34

Thank you for your interest in this question. Because it has attracted low-quality or spam answers that had to be removed, posting an answer now requires 10 reputation on this site (the association bonus does not count).

Would you like to answer one of these unanswered questions instead?

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