Circumnavigating a curve or going through it to show different behavior

Question

I am not sure if what I want to do is possible in Mathematica. I've provided something simple below to convey what I want to do. Basically what I want to happen is that when the Locator crosses over the blue line, the Disk[] will turn red and stay red until the Locator crosses the blue line again (it should stay red regardless of where the Locator is).

Manipulate[
 Plot[x^3, {x, 0, 1}, PlotRange -> {{0, 1.5}, {0, 1.5}}, Frame -> True,
  Epilog -> 
   Inset[Graphics[{Blue, Disk[]}, ImageSize -> 30], {0.2, 1}]],
 {{comp, {0.5, 0.7}}, Locator}]

enter image description here

I am trying to make a Demonstration that shows the behavior of a single component (water in this case) on a pressure vs. temperature phase diagram. Water exists in 3 distinct phases and there is only a phase change from liquid to vapor (or supercritical) if a certain boundary is crossed (looks like the one I showed here) but you can go around that boundary and not change phase. So that's what I am trying to show here with the colored disk as the indicator of "phase change"

EDIT:

Manipulate[
 DynamicModule[{col = False, acc = 0, p = {420, Log[6]}},
  EventHandler[Show[Quiet@LogPlot[Log[T], {T, 273.16, 647.096}, PlotStyle -> Thick] /. 
     l_Line :> EventHandler[l, {"MouseEntered" :> If[acc === 0, 
(col = col /. {True -> False, False -> True})]}],
    Frame -> True, PlotRange -> {{273.16, 700}, {Log[5.6], Log[7]}}, 
    Epilog -> 
     Inset[Graphics[
       Text[Style[Dynamic@If[col == True, "liquid", "vapor"], 18], 
        Scaled[{0.400, 0.1}]]]]],
   {"MouseDown" :> (acc = 1; MousePosition[Dynamic@p]), 
    "MouseDragged" :> (MousePosition[Dynamic@p]), 
    "MouseUp" :> (acc = 0; MousePosition[Dynamic@p])}, 
   PassEventsDown -> True]],
 {{p, {420, Log[6]}}, Locator, 
  Appearance -> Graphics[{Disk[]}, ImageSize -> 12]}]

It will only work if the mouse is not depressed.

What is the problem, it seems you've changed If[acc === 1, to If[acc === 0, on purpose. P.s. in case of True/False you can just use col = !col instead of rules. — Kuba, Jul 02 '14 at 08:48
I will try that. The reason I messed with If[acc===1 was because nothing at all worked with that definition for some reason. Thanks for all your help! — baumannr, Jul 02 '14 at 15:55

C. E. · Answer 1 · 2014-06-26T00:26:51.173

One way to detect crossings is to form a straight line between the previous position of the locator and the new position, and then check if there is an intersection between that straight line and $x^3$. I wrote this function to count the number of line intersection of a straight line with endpoints p1 and p2. The function which in this case is $x^3$ can be any function, and the interval which in this case is $0<x<1$ can be any interval.

SetAttributes[countIntersections, HoldFirst]
countIntersections[{f_, {xmin_, xmax_}}, p1_, p2_] := Module[{delta = p2 - p1, sol},
  If[p1 == p2, Return[0]];
  sol = Solve[{
     {x, f} == p1 + Normalize[delta] k,
     # < x < #2 & @@ Sort[{First[p1], First[p1 + delta]}],
     xmin < x < xmax,
     0 < k < Norm[delta]
     }, {x, k}];
  Length@sol
  ]

Just to emphasize how this work I built a little demo.

DynamicModule[{p1 = {0.5, 0.5}, p2 = {0.6, 0.5}},
 LocatorPane[
  Dynamic[{p1, p2}],
  Dynamic@Show[
    Plot[x^3, {x, 0, 1}],
    Graphics[{
      If[
       countIntersections[{x^3, {0, 1}}, p1, p2] == 0,
       Black,
       Red
       ],
      Line[{p1, p2}]
      }]
    ]
  ]
 ]

First demo

But of course for the real thing we don't have two locators. The second position is simply the previous position of the locator. Here's how that can be written:

DynamicModule[{p1 = {0.5, 0.5}, p2, plot, diskColor = Black},
 p2 = p1;
 LocatorPane[
  Dynamic[p1],
  Dynamic[
   If[
     countIntersections[{x^3, {0, 1}}, p1, p2] != 0,
     diskColor = diskColor /. {Red -> Black, Black -> Red}
     ]
    plot = Show[
      Plot[x^3, {x, 0, 1}],
      Graphics[{
        diskColor,
        Disk[{0.2, 1}, 0.08]
        }], AspectRatio -> 0.75, PlotRange -> {{0, 2}, {0, 1.5}}
      ];
   p2 = p1;
   plot
   ]
  ]
 ]

Second demo

Kuba · Accepted Answer · 2014-06-25T22:33:46.120

2

I don't know how to handle parallel Events but if there is single Locator you can try this:

DynamicModule[{col = Blue, acc = 0, p = {1, 1}},
 EventHandler[
  Show[
   Graphics[{Dynamic@Disk[p, Scaled@.03]}],
   Plot[x^3, {x, 0, 1}] /. l_Line :> EventHandler[ l, {"MouseEntered" :> 
                   If[acc === 1, (col = col /. {Red -> Blue, Blue -> Red})]}]
   , Frame -> True, PlotRange -> {{0, 1.5}, {0, 1.5}}, 
   Epilog -> Inset[Graphics[Dynamic@{col, Disk[]}, ImageSize -> 30], {0.2, 1}]
   ],
  {"MouseDown" :> (acc = 1; p = MousePosition["Graphics"]), 
   "MouseDragged" :> (p = MousePosition["Graphics"]),
   "MouseUp" :> (acc = 0;)}, PassEventsDown -> True]
 ]

enter image description here

Do not move cursor too quickly :P

The order of things in Show is important. Our custom locator has to be under the border line.

edited Jun 25 '14 at 22:33

answered Jun 25 '14 at 21:59

Kuba

136,707
13
279
740

Thank you! This is simple and works...well mostly. It only works in my other program it the mouse is NOT depressed haha. – baumannr Jul 01 '14 at 20:43
@baumannr could you say more, maybe I can help? (not today since I have to go but in near future :)) – Kuba Jul 01 '14 at 21:19
In your solution, when you have the button on the mouse depressed and move the black circle across the line x^3, the color of the other disk changes. In the code that I worked this into, if I "click" and hold the mouse and then drag the cursor over the line, it won't work. It does work properly only if I just scroll over the line (without ever having clicked the mouse). I've made a number of desperate attempts to correct it but no luck. I will post an update with code a bit more similar to what I am using in case that makes any difference. Thank you so much! No rush. – baumannr Jul 01 '14 at 21:50
@baumannr I will take a look at this tomorrow. If your update can change the context so those answers are not valid anymore please consider posting another question. Cya – Kuba Jul 01 '14 at 22:47

kglr · Answer 3 · 2014-06-25T22:36:10.060

Partial answer: this does not handle the going-around-the-curve bit.

 g1 = Graphics[{Blue, Table[Circle[{0, 0}, i], {i, 3}]}, ImageSize -> 20];
 g2 = Graphics[{Red, Table[Circle[{0, 0}, i], {i, 3}]},  ImageSize -> 20];

 DynamicModule[{pt = {0.1, 1}},
    Plot[x^3, {x, 0, 1}, PlotRange -> {{0, 1.5}, {0, 1.5}}, 
       Filling -> Bottom, Frame -> True, ImageSize -> 600,
       Epilog -> Dynamic@{
          If[Last[pt] < First[pt]^3, Blue, Red], PointSize[.05], Point[{.1, 1}],
          Locator[Dynamic[pt], If[Last[pt] < First[pt]^3, g1, g2]]}]]

enter image description here

Circumnavigating a curve or going through it to show different behavior

3 Answers3

Linked