Constrain movement of a locator inside Manipulate

Question

Once again a big thank you for the great help in my earlier post: Plotting function with Dynamic parameter. It totally worked out.

I now have a new coding problem

Manipulate[
  Plot[Norm @ p2*t + Norm @ p1, {t, 0, 1}, PlotRange -> {0, 5}], 
  {{p1, {0, 0}}, Locator}, 
  {{p2, {0, 0}}, Locator}]

Given this Manipulate object, how would it be possible to add a new locator that has its movement constrained to a given parametric curve? I've tried the code given on the user manual of Locator and of LocatorPane, but without success.

Answer 1

Maybe this will help. I can adapt my answer here, using the second argument of Dynamic to set the position of the Locator to a point on a parametric curve. We can use FindMinimum to find the point on the parametric curve that is closest to the mouse. To speed things up, it helps to have good initial points for FindMinimium. To do that, we save the values of the parameter t calculated by ParametricPlot in the list t0. Then Nearest is used to find the parameter t of the point of those calculated by ParametricPlot that is closest to the mouse. This t is used as the initial value for FindMinimum. There are alternatives to using the points computed by ParametricPlot (see below). To further speed things up, it can help to reduce the accuracy demanded of FindMinimum. All this requires extra local variables (with no controls, specified by None).

I put Dynamic around LocatorPane so that the initialization code (for plot, nf) would not be reevaluated, except, technically, on the first update after initial evaluation. (This extra evaluation could be eliminated by adding the Manipulate option TrackedSymbols :> {p}.)

f[t_] := t {Cos[10 t], Sin[10 t]};
Manipulate[
 {plot, {t0}} = Reap @ ParametricPlot[f[t], {t, 0, 2}, EvaluationMonitor :> Sow[t]];
 nf = Nearest[f /@ t0 -> t0];
 Dynamic @ LocatorPane[
  Dynamic[
   p,
   (p = f @ Clip[t /. Last @ FindMinimum[EuclideanDistance[f[t], #], {t, First @ nf[#]},
                       AccuracyGoal -> 5, PrecisionGoal -> 4],
                 {0, 2}]) &],
  plot],
 {{p, {0, 0}}, None}, {plot, None}, {t0, None}, {nf, None}
 ]

Alternative initial points

The easiest way is just to take equally spaced values of t:

nf = Nearest[f /@ # -> #] &@ Range[0, 2, 0.01];  (* {0, 2} is the domain of t *)

One advantage to ParametricPlot is that it tends to calculate more points where the curvature is great. Where the curvature is great, FindMinimum sometimes jumps around in its solutions. In our example case, the curvature is greatest near the origin; once the number of values of t is above about 150 or so, the behavior seems smooth. By comparison, ParametricPlot calculates 1645 points, so in some sense this method could be considered optimal in this example case.

A second method is to take point equally spaced along the curve. This can be useful when the velocity of parametrization varies widely. However, where the curvature is tight, the same problem of FindMinimum jumping from one part of the curve to another can occur.

arclength = NDSolveValue[{t'[s] Norm[f'[t[s]]] == 1, t[0] == 0}, 
  t, {s, 0, NIntegrate[Norm[f'[t]], {t, 0, 2}]}]; (* {0, 2} is the domain of t *)
nf = Nearest[f /@ # -> #] &@ 
  (arclength /@ Range @@ Flatten[{#, Differences /@ # / 200}] &@ arclength["Domain"]);

Answer 2

In Mathematica 10 there is a new way to constrain locators that is short and simple. First define your region:

circles = Table[Circle[{0, 0}, r], {r, 1, 15, 2}];
lines = Table[Line[{{-15 Cos[the], -15 Sin[the]}, {15 Cos[the], 15 Sin[the]}}], {the, 0, Pi, Pi/6}];
grid = RegionUnion[circles, lines];

And then use the second argument of Dynamic like in Michael E2's answer but using RegionNearest to determine the nearest allowed point:

DynamicModule[
 {pt = {4, 0}},
 LocatorPane[
  Dynamic[pt, (pt = RegionNearest[grid, #]) &],
  Graphics[{Lighter@Lighter@Blue, circles, lines}]
  ]
 ]

Answer 3

If you want to constrain a locator to a line, and want the line itself to be adjustable with endpoint locators, then here is a method. The following routine projects an off-the-line locator perpendicularly onto the line. I generated the somewhat complicated looking result using John Browne's Grassmann algebra application.

ConstrainedLocatorToLine::usage = 
  "ConstrainedLocatorToLine[locator, ptA, ptB] will return new \
locator coordinates that have been projected onto the line defined by \
ptA and ptB. All quantities are in the form of list coordinates: {x, \
y}.";
SyntaxInformation[
   ConstrainedLocatorToLine] = {"ArgumentsPattern" -> {_, _, _}};
ConstrainedLocatorToLine[{xloc_, yloc_}, {xA_, yA_}, {xB_, yB_}] :=
  {xA - ((xA - xB) (xA^2 + xB xloc - 
       xA (xB + xloc) + (yA - yB) (yA - yloc)))/((xA - xB)^2 + (yA - 
       yB)^2), ((xA - xB) (-xB yA + xloc (yA - yB) + xA yB) + (yA - 
       yB)^2 yloc)/((xA - xB)^2 + (yA - yB)^2)};

The following is a DynamicModule illustrating its use with the ever handy second argument of Dynamic.

DynamicModule[
 {ptA = {-1, -1}, ptB = {1, 1}, locator = {0, 0}, constrain},
 constrain[loc_, pa_, 
   pb_] := (locator = ConstrainedLocatorToLine[loc, pa, pb]);
 Graphics[{
   Dynamic@{Line[{ptA, ptB}]},
   Locator[Dynamic[ptA, (ptA = #; constrain[locator, ptA, ptB]) &]],
   Locator[Dynamic[ptB, (ptB = #; constrain[locator, ptA, ptB]) &]],
   Locator[
    Dynamic[locator, (locator = #; constrain[locator, ptA, ptB]) &]]},
  PlotRange -> 2,
  ImageSize -> 250]
 ]