Controlling the motion of points in Manipulate when there are multiple paths

Question

I recently asked a question about controlling a point with a slider, that stops at a value, waits a bit, then continues moving. The solution worked well and was much simpler than what I had done previously, but, it only works if there is just 1 y-value for the point to linger at.

For this scenario, there are three y-values for different ranges of x-values, that the point needs to linger at. The point needs to be able to take multiple paths (eg. follow blue arrow, lingering at red lines).

I am running into issues when I cross one red line/square and try to continue moving upward and change the x-position so I'm in a different region. This is what I am currently using:

Q1 = heat + 100;
Q2 = heat;
py = Sort[{Q1, Which[px < 0.6, 203, px > 0.6, 303, px == 0.6, 450], 
    Q2}][[2]];

With heat and x-position px set with controls in Manipulate:

Control[{{px, 0.2, "mole fraction B"}, 0, 1, 0.05}]
Control[{{heat, 20, "heat added (kJ)"}, 0, 500, 1}]

Thanks!

Answer 1

Suppose you have this path:

path = Line[{{10, 0}, {10, 20}, {30, 20}, {30, 35}, {35, 35}, {35, 0}}];

obstacles = {
   Line[{{0, 10}, {40, 10}}],
   Line[{{0, 30}, {40, 30}}]
   };

intersections = Point[{{10, 10}, {30, 30}, {35, 30}, {35, 10}}];

Graphics[{
  Thick,
  Darker@Blue, obstacles,
  Dashed, Green, path,
  PointSize[Large], Red, intersections
  }, PlotRange -> {{0, 40}, {0, 40}}]

When the particle traveling along the green line hits any of the blue lines it should be delayed by a fixed amount of time units. My approach to this is to create an interpolation between each turn on the beginning of the line, the red dots denoting intersections, and turning points on the line.

pointOfInterest = {{10, 0}, {10, 20}, {30, 20}, {30, 35}, {35, 35}, {35, 0}};
stops = (175./95.) Accumulate@Prepend[0][Norm /@ Differences[pointOfInterest]];
g = Interpolation[Transpose[{stops, pointOfInterest}], InterpolationOrder -> 1];

I multiply by (175./95.) for later convenience. The point is that now we have a continuous function that travels along the green line. Our goal now is to modify it to stop at the red dots for some time.

The first intersection is at {10, {10, 10}}, where the first part is time (or really, distance travelled) and the second part is the position. This is just the second element in stops, given above. What I'll do is I split it into two:

{10, {10, 10}}, {30, {10, 10}}

the way I've modified distance travelled, without having actually travelled anywhere at all, means that when I interpolate the modified list, it will stay still for a time corresponding to 20 units of distance travelled. Doing this for all points of intersection and taking care to also update the time at subsequent points reflect the delay to I get the new interpolation function:

itinerary = {
   {0, {10, 0}},
   {10, {10, 10}},
   {30, {10, 10}},
   {40, {10, 20}},
   {60, {30, 20}},
   {70, {30, 30}},
   {90, {30, 30}},
   {95, {30, 35}},
   {100, {35, 35}},
   {105, {35, 30}},
   {125, {35, 30}},
   {145, {35, 10}},
   {165, {35, 10}},
   {175, {35, 0}}
   };
f = Interpolation[itinerary, InterpolationOrder -> 1];

A demonstration (looks better in the notebook interface):

Manipulate[Graphics[{
    Thick,
    Darker@Blue, obstacles,
    Dashed, Green, path,
    PointSize[Large], Red, intersections,
    Black, Point[f[t]],
    Orange, Point[g[t]]
    }], {t, 0, 175}]

One of many ways to generate a path with delays programmatically:

addPoint[{first___, {dist_, last_}}, pt_] := 
 Append[{first, {dist, last}}, {dist + Norm[last - pt], pt}]
addDelay[{first___, {dist_, last_}}, pt_, delay_] := Append[
  Append[{first, {dist, last}}, {dist + Norm[last - pt], pt}],
  {dist + Norm[last - pt] + delay, pt}
  ]
userPath[userInput_] := Module[{pts = {{0, start}}},
  pts = addPoint[pts, pt1];
  pts = addPoint[pts, pt2];
  pts = addDelay[pts, pt3, 10];
  pts = addPoint[pts, pt4];
  Interpolation[pts, InterpolationOrder -> 1]
  ]