Skip to main content

manipulate - Clicking to add/remove a Locator


I would like to add a Locator to a figure displayed by Manipulate when I click inside the figure, at the location where I click, and to have this trigger an update of the figure. I would also like to have clicking on an existing Locator remove it, and dragging a locator reposition it (again, redrawing the figure in response in each case).


For (a silly) example, I would like clicking anywhere in the region displayed by


With[{locs = {}}, 
Manipulate[Graphics[Text[locs, {0, 0}], PlotRange -> 2],
{{q, {1, 1}}, Locator,
Appearance -> Graphics[{Green, Disk[{0, 0}, .1]}, ImageSize -> 10]},

{{p, locs}, Locator,
Appearance -> Graphics[{Red, Disk[{0, 0}, .1]}, ImageSize -> 10]}]]

to add the corresponding Point to locs, and for clicking on any p Locator to remove it from locs, with the text, updating accordingly in response to additions, deletions or repositionings of a Locator.


To make things hard, I have another locator q that needs to coexist with the one to which I would like to add/remove; and p and q have different appearances.



Answer



I would approach the overall goal of the program in a different way that avoids the limitations* of Manipulate. I would store a list of all the locators in one variable, with the permanent locator(s) at the beginning of the list. The transient locators can be added and removed with ALT+click. The permanent locators are maintained by the option of the form LocatorAutoCreate -> min, where min is the number of permanent locators.


Using With to assign symbols to represent the parts of the list locs of locators seems slightly inelegant, but overall the approach has the advantage of being simple.


Manipulate[
With[{q = locs[[1]], p = Drop[locs, 1]},

Graphics[Text[locs, {0, 0}], PlotRange -> 2]
],
{{locs, {{1, 1}}}, Locator, LocatorAutoCreate -> 1}
]



*Limitation: When several Locator controls, p, q, ..., appear in a Manipulate, a LocatorPane is created of the form


LocatorPane[Dynamic[{p, q, ...}], ...]

The option LocatorAutoCreate can be passed to the LocatorPane; however, it does not work because the length of the list {p, q, ...} cannot be changed.





Update: Appearance


The appearance of the locators may be controlled in two ways. The documented, and hence common, solution is to use invisible locators and insert graphics primitives into the Graphics:


Manipulate[
With[{q = locs[[1]], p = Drop[locs, 1]},
Graphics[{
Text[locs, {0, 0}],
Locator[q], {Red, PointSize[Large], Point[p]},
PlotRange -> 2]
],

{{locs, {{1, 1}}}, Locator, LocatorAutoCreate -> 1}
]

Another way is to use the option setting


Appearance -> {Automatic, Graphics[{Red, Disk[]}, ImageSize -> 10]}

The last specification is repeated when there are more than two locators, a behavior that I could not find documented.


Comments

Popular posts from this blog

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...

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...

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}]