Skip to main content

dynamic - How to efficiently drag points on a curve within a Manipulate


My intention is to demonstrate on any conic various metrics properties on points belonging to the conic and connected by lines.
I want the points to be dynamically moved not the usual way, indirectly with the help of any Manipulate controls like Slider, but by an artifice, hiding the Locator control object and let one feel that by dragging any point on the curve you manipulate directly that point (though of course it is the locator that you manipulate).
Here is my embryonic code so far, just a circle with two points (and I made here the 2 locators visible):


findY[ptX_] := Module[{},
Which[((First[ptX] <= 0 && ptX[[2]] <=  0) || (First[ptX] > 0 && 
   ptX[[2]] <=  0) ),                  

   y /. Solve[x^2 + y^2 == 4, {y}][[1]] /. {x -> First[ptX]},
             ((First[ptX] <= 0 && 
   ptX[[2]] >  0) || (First[ptX] > 0 && ptX[[2]] >  0) ) ,                  
     y /. Solve[x^2 + y^2 == 4, {y}][[2]] /. {x -> First[ptX]}]]

Manipulate[
{{Style[StringForm[
 "Locator for the blue point `1` Blue point coords{`2`,`3`}", 
 Dynamic[ptA], First[ptA], findY[ptA]]]},
{Style[StringForm[

 "Locator for the green point `1` Green point coords{`2`,`3`}", 
 Dynamic[ptB], First[ptB], findY[ptB]]]}}, 
Row[{LocatorPane[Dynamic[{ptA, ptB}], 
ContourPlot[x^2 + y^2 == 4, {x, -3, 3}, {y, -3, 3}, 
 PlotRange -> Automatic, AspectRatio -> 1, Axes -> True, 
 Frame -> None, ImageSize -> 300, 
 Epilog -> {{PointSize[Large], Blue,  
    Point[Dynamic[{First[ptA], findY[ptA]}]]},
                     {PointSize[Large], Green, 
    Point[Dynamic[{First[ptB], findY[ptB]}]]}}],

Appearance -> Style["\[CirclePlus]", 20, Red]]}], 
(* Replace with Appearance->None to hide the Locators *)
{{ptA, {-2, 0}},None}, {{ptB, {2, 0}}, None}] (* ptA Blue ptB Green *)

You can see that by clicking on any of the two locators each point will move along the whole circle, even cross each other: if you move your mouse slowly the locator will stay very close to the point but if you do it too quickly the point will move too but the locator may be far off giving an erratic effect to the movement of the point.
And an issue too, having difficulty of retrieving it then with your mouse if the locator is not visible.
My question: On a PC when you want to drag a point which is to be moved along a curve, you start by clicking on the point and then dragging where you want it to be (and not something else). Can the same effect be obtained be obtained with MMA? If internally this means dragging a MMA Locator it should be as far as possible transparent.


I took pains to check that my question is not a duplicate,sorry if it is. Errare humanum est.



In short: How can I constrain a locator to move along a curve, similar to the goal in Constrain movement of a locator inside Manipulate, except that here the curve is defined by an equation instead of parametrically?




Answer



Here's a way to constrain the locators to the curve. We use ContourPlot to generate a list of points on the curve; the nearest one, returned by the NearestFunction nf, is used as a starting point for FindRoot to solve for the nearest point on the curve.


Clear[findP, loc];
findP[p0_, conicEqn_, {x0_, y0_}] :=
  {x, y} /. FindRoot[
    {Cross[{x, y} - p0].D[Subtract @@ conicEqn, {{x, y}}] == 0, 
     conicEqn},
    {{x, x0, -3, 3}, {y, y0, -3, 3}},
    AccuracyGoal -> 3, PrecisionGoal -> 4];


loc[Dynamic[pts_], conic_] := DynamicModule[{nf},
   nf = Nearest[Cases[
      ContourPlot[conic, {x, -3, 3}, {y, -3, 3}, PlotPoints -> 100, 
        MaxRecursion -> 4, Axes -> None, Frame -> None],
      {_Real, _Real}, Infinity]];
   pts = findP[#, conic, First@nf[#]] & /@ pts;
   Row[
    {LocatorPane[
      Dynamic[pts, (pts = findP[#, conic, First@nf[#]] & /@ #) &], 
      Dynamic@ContourPlot[conic,

        {x, -3, 3}, {y, -3, 3},
        AspectRatio -> 1, Axes -> True, Frame -> None, 
        ImageSize -> 200],
      Appearance -> Style["\[CirclePlus]", 20, Red]]}
    ]
   ];

Manipulate[{ptA, ptB},
 {{conic, x^2 + y^2 == 4}, InputField},
 Dynamic@Refresh[

   loc[Dynamic[{ptA, ptB}], conic],
   TrackedSymbols :> {conic}],
 {{ptA, {-2, 0}}, None}, {{ptB, {2, 0}}, None}
 ]

Mathematica graphics


Mathematica graphics


Comments

Post a Comment

Popular posts from this blog

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

What is and isn't a valid variable specification for Manipulate?

I have an expression whose terms have arguments (representing subscripts), like this: myExpr = A[0] + V[1,T] I would like to put it inside a Manipulate to see its value as I move around the parameters. (The goal is eventually to plot it wrt one of the variables inside.) However, Mathematica complains when I set V[1,T] as a manipulated variable: Manipulate[Evaluate[myExpr], {A[0], 0, 1}, {V[1, T], 0, 1}] (*Manipulate::vsform: Manipulate argument {V[1,T],0,1} does not have the correct form for a variable specification. >> *) As a workaround, if I get rid of the symbol T inside the argument, it works fine: Manipulate[ Evaluate[myExpr /. T -> 15], {A[0], 0, 1}, {V[1, 15], 0, 1}] Why this behavior? Can anyone point me to the documentation that says what counts as a valid variable? And is there a way to get Manpiulate to accept an expression with a symbolic argument as a variable? Investigations I've done so far: I tried using variableQ from this answer , but it says V[1...
Post a Comment
Read more