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

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]
Post a Comment
Read more

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]
Post a Comment
Read more

plotting - Mathematica: 3D plot based on combined 2D graphs

I have several sigmoidal fits to 3 different datasets, with mean fit predictions plus the 95% confidence limits (not symmetrical around the mean) and the actual data. I would now like to show these different 2D plots projected in 3D as in but then using proper perspective. In the link here they give some solutions to combine the plots using isometric perspective, but I would like to use proper 3 point perspective. Any thoughts? Also any way to show the mean points per time point for each series plus or minus the standard error on the mean would be cool too, either using points+vertical bars, or using spheres plus tubes. Below are some test data and the fit function I am using. Note that I am working on a logit(proportion) scale and that the final vertical scale is Log10(percentage). (* some test data *) data = Table[Null, {i, 4}]; data[[1]] = {{1, -5.8}, {2, -5.4}, {3, -0.8}, {4, -0.2}, {5, 4.6}, {1, -6.4}, {2, -5.6}, {3, -0.7}, {4, 0.04}, {5, 1.0}, {1, -6.8}, {2, -4.7}, {3, -1....
Post a Comment
Read more