Nested Manipulate in Mathematica - wolfram-mathematica

Please consider:
Function[subID,
pointSO[subID] = RandomInteger[{1, 4}, {5, 2}]] /# {"subA", "subB"};
Manipulate[
Manipulate[
Graphics[{
Black, Rectangle[{0, 0}, {5, 5}],
White,Point#pointSO[subID][[i]]
},
ImageSize -> {400, 300}],
{i,Range[Length#pointSO[subID]]}],
{subID, {"subA", "subB"}}]
Provided that pointSO[subID] actually yields to lists of different length, is there a way to avoid having 2 Manipulate given that one of the manipulated variable depends on the other?

I am not sure that I got exactly what you are asking for, but I figured what you want is something like the following:
Given a UI with one variable, say an array that can change in size, and another (dependent) variable, which represents say an index into the current array that you want to use from the UI to index into the array.
But you do not want to fix the index variable layout in the UI, since it depends, at run time, on the size of the array, which can change using the second variable.
Here is a one manipulate, which has a UI that has an index control variable, which updates dynamically on the UI as the size of the array changes.
I used SetterBar for the index (the dependent variable) but you can use slider just as well. SetterBar made it more clear on the UI what is changing.
When you change the length of the array, the index control variable automatically updates its maximum allowed index to be used to match the current length of the array.
When you shrink the array, the index will also shrink.
I am not sure if this is what you want, but if it, you can adjust this approach to fit into your problem
Manipulate[
Grid[{
{Style[Row[{"data[[", i, "]]=", data[[i]]}], 12]},
{MatrixForm[data], SpanFromLeft}
},
Alignment -> Left, Spacings -> {0, 1}
],
Dynamic#Grid[{
{Text["select index into the array = "],
SetterBar[Dynamic[i, {i = #} &], Range[1, Length[data]],
ImageSize -> Tiny,
ContinuousAction -> False]
},
{
Text["select how long an array to build = "],
Manipulator[
Dynamic[n, {n = #; If[i > n, i = n];
data = Table[RandomReal[], {n}]} &],
{1, 10, 1}, ImageSize -> Tiny, ContinuousAction -> False]
, Text[Length[data]], SpanFromLeft
}
}, Alignment -> Left
],
{{n, 2}, None},
{{i, 2}, None},
{{data, Table[RandomReal[], {2}]}, None},
TrackedSymbols -> {n, i}
]
update 8:30 PM
fyi, just made a fix to the code above to add a needed extra logic.

To avoid the problem of i being too large when switching lists, you could add an If[] statement at the beginning of the Manipulate, e.g.
Clear[pointSO];
MapThread[(pointSO[#] = RandomInteger[{1, 4}, {#2, 2}]) &,
{{"subA", "subB"}, {5, 7}}];
Manipulate[
If[i > Length[pointSO[subID]], i = Length[pointSO[subID]]];
Graphics[{Black, Rectangle[{0, 0}, {5, 5}], White,
Point#pointSO[subID][[i]]}, ImageSize -> {400, 300}],
{{subID, "subA"}, {"subA", "subB"}, SetterBar},
{{i, {}}, Range[Length#pointSO[subID]], SetterBar}]
Maybe nicer is to reset i when switching between lists. This can be done by doing something like
Manipulate[
Graphics[{Black, Rectangle[{0, 0}, {5, 5}], White,
Point#pointSO[subID][[i]]}, ImageSize -> {400, 300}],
{{subID, "subA"},
SetterBar[Dynamic[subID, (i = {}; subID = #) &], {"subA", "subB"}] &},
{{i, {}}, Range[Length#pointSO[subID]], SetterBar}
]

An alternative implementation that preserves selection settings for each data set:
listlength["subA"] = 5; listlength["subB"] = 9;
Function[subID,
pointSO[subID] =
RandomInteger[{1, 4}, {listlength[subID], 2}]] /# {"subA", "subB"};
Manipulate[
Graphics[{Black, Rectangle[{0, 0}, {5, 5}],
Dynamic[If[subID == "subA", Yellow, Cyan]], PointSize -> .05,
Dynamic#Point#pointSO[subID][[k]]}, ImageSize -> {400, 300}],
Row[{Panel[
SetterBar[
Dynamic[subID,
(subID = #; k = If[subID == "subA", j, i]) &],{"subA", "subB"},
Appearance -> "Button", Background -> GrayLevel[.8]]], " ",
PaneSelector[{"subA" ->
Dynamic#Panel[
SetterBar[Dynamic[j, (k = j; j = #) &],
Range[Length#pointSO["subA"]], Appearance -> "Button",
Background -> Yellow]],
"subB" ->
Dynamic#Panel[
SetterBar[Dynamic[i, (k = i; i = #) &],
Range[Length#pointSO["subB"]], Appearance -> "Button",
Background -> Cyan]]}, Dynamic[subID]]}]]
Output examples:

Related

Force scientific notation in tick labels of Plot in mathematica

I am trying to scientific-format tick labels on a my Plot which is somehow a frame. By searching Mathgroup archives, it looks like the usual way to mess with tick labels is to extract them using AbsoluteOptions, run a replacement rule with the custom format, and then explicitly feed them to the plotting function with the Ticks->{...} option. However, the following doesn't work for FrameTicks:
makePlotLegend[names_, markers_, origin_, markerSize_, fontSize_,
font_] :=
Join ## Table[{Text[Style[names[[i]], FontSize -> fontSize, font],
Offset[{1.5*markerSize, -(i - 0.5)*
Max[markerSize, fontSize]*1.25}, Scaled[origin]], {-1, 0}],
Inset[Show[markers[[i]], ImageSize -> markerSize],
Offset[{0.5*markerSize, -(i - 0.5)*
Max[markerSize, fontSize]*1.25}, Scaled[origin]], {0, 0},
Background -> Directive[Opacity[0], White]]}, {i, 1,
Length[names]}];
LJ[r_] := 4 e ((phi/r)^12 - (phi/r)^6)
phi = 2.645;
e = 10.97 8.621738 10^-5;
l1 = Plot[LJ[r], {r, 2, 11}, PlotStyle -> {Blue},
PlotRange -> {{2, 6}, {0.001, -0.002}}, Frame -> True,
LabelStyle -> {8},
Epilog ->
makePlotLegend[{"He-He",
"H-H"}, (Graphics[{#, Line[{{-1, 0}, {1, 0}}]}]) & /# {Blue,
Red}, {0.80, 0.35}, 7.5, 7.3, "Times New Roman"]]

How can I simulate repulsion between multiple point charges (ball bearings) in Mathematica?

I'm trying to write a program in Mathematica that will simulate the way charged ball bearings spread out when they are charged with like charges (they repel each other). My program so far keeps the ball bearings from moving off the screen, and counts the number of times they hit the side of the box. I have the ball bearings moving randomly around the box so far, but I need to know how to make them repel each other.
Here's my code so far:
Manipulate[
(*If the number of points has been reduced, discard points*)
If[ballcount < Length[contents],
contents = Take[contents, ballcount]];
(*If the number of points has been increased, generate some random points*)
If[ballcount > Length[contents],
contents =
Join[contents,
Table[{RandomReal[{-size, size}, {2}], {Cos[#], Sin[#]} &[
RandomReal[{0, 2 \[Pi]}]]}, {ballcount - Length[contents]}]]];
Grid[{{Graphics[{PointSize[0.02],
(*Draw the container*)
Line[size {{-1, -1}, {1, -1}, {1, 1}, {-1, 1}, {-1, -1}}],
Blend[{Blue, Red}, charge/0.3],
Point[
(*Start the main dynamic actions*)
Dynamic[
(*Reset the collision counter*)
collision = 0;
(*Check for mouse interaction and add points if there has been one*)
Refresh[
If[pt =!= lastpt, If[ballcount =!= 50, ballcount++];
AppendTo[
contents, {pt, {Cos[#], Sin[#]} &[
RandomReal[{0, 2 \[Pi]}]]}]; lastpt = pt],
TrackedSymbols -> {pt}];
(*Update the position of the points using their velocity values*)
contents = Map[{#[[1]] + #[[2]] charge, #[[2]]} &, contents];
(*Check for and fix points that have exceeded the box in Y
direction, incrementing the collision counter for each one*)
contents = Map[
If[Abs[#[[1, 2]]] > size,
collision++; {{#[[1, 1]],
2 size Sign[#[[1, 2]]] - #[[1, 2]]}, {1, -1} #[[
2]]}, #] &,
contents];
(*Check for and fix points that have exceeded the box in X
direction, incrementing the collision counter for each one*)
contents = Map[
If[Abs[#[[1, 1]]] > size,
collision++; {{2 size Sign[#[[1, 1]]] - #[[1, 1]], #[[1,
2]]}, {-1, 1} #[[2]]}, #] &,
contents];
hits = Take[PadLeft[Append[hits, collision/size], 200], 200];
Map[First, contents]]]},
PlotRange -> {{-1.01, 1.01}, {-1.01, 1.01}},
ImageSize -> {250, 250}],
(*Show the hits*)
Dynamic#Show
[
ListPlot
[
Take[MovingAverage[hits, smooth], -100
]
,
Joined -> True, ImageSize -> {250, 250}, AspectRatio -> 1,
PlotLabel -> "number of hits", AxesLabel -> {"time", "hits"},
PlotRange -> {0, Max[Max[hits], 1]}], Graphics[]
]
}}
]
,
{{pt, {0, 1}}, {-1, -1}, {1, 1}, Locator, Appearance -> None},
{{ballcount, 5, "number of ball bearings"}, 1, 50, 1},
{{charge, 0.05, "charge"}, 0.002, 0.3},
{smooth, 1, ControlType -> None, Appearance -> None},
{size, 1, ControlType -> None, Appearance -> None},
{hits, {{}}, ControlType -> None},
{contents, {{}}, ControlType -> None},
{lastpt, {{0, 0}}, ControlType -> None}
]
What you need for your simulation is a "collision detection algorithm". The field of those algorithms is widespread since it is as old as computer games (Pong) are and it is impossible to give a complete answer here.
Your simulation as it is now is very basic because you advance your charged balls every time step which makes them "jump" from position to position. If the movement is as simple as it is with the constant velocity and zero acceleration, you know the exact equation of the movement and could calculate all positions by simply putting the time into the equations. When a ball bounces off the wall, it gets a new equation.
With this, you could predict, when two balls will collide. You simply solve for two balls, whether they have at the same time the same position. This is called A Priori detection. When you take your simulation as it is now, you would have to check at every timestep, whether or not two balls are so close together, that they may collide.
The problem there is, that your simulation speed is not infinitely high and the faster your balls are, the bigger the jumps in your simulation. It is then not unlikely, that two balls over-jump each other and you miss a collision.
With this in mind, you could start by reading the Wikipedia article to that topic, to get an overview. Next, you could read some scientific articles about it or check out, how the cracks do it. The Chipmunk physics engine for instance is an amazing 2d-physics engine. To ensure that such stuff works, I'm pretty sure they had to put a lot thoughts in their collision detection.
I can't do the detection part since that is a project on its own. But it seems now the interaction is faster, you had few Dynamics which were not needed. (if you see the side of the cell busy all the time, this always mean a Dynamic is busy where it should not be).
I also added a STOP/START button. I could not understand everything you were doing, but enough to make the changes I made. You are also using AppendTo everything. You should try to allocate contents before hand, and use Part[] to access it, would be much faster, since you seem to know the maximum points allowed?
I like to spread the code out more, this helps me see the logic more.
Here is a screen shot, and the updated version code is below. Hope you find it faster.
Please see code below, in update (1)
Update (1)
(*updated version 12/30/11 9:40 AM*)
Manipulate[(*If the number of points has been reduced,discard points*)
\
Module[{tbl, rand, npt, ballsToAdd},
If[running,
(
tick += $MachineEpsilon;
If[ballcount < Length[contents],
contents = Take[contents, ballcount]];
(*If the number of points has been increased,
generate some random points*)
If[ballcount > Length[contents],
(
ballsToAdd = ballcount - Length[contents];
tbl =
Table[{RandomReal[{-size, size}, {2}], {Cos[#], Sin[#]} &[
RandomReal[{0, 2 \[Pi]}]]}, {ballsToAdd}];
contents = Join[contents, tbl]
)
];
image = Grid[{
{LocatorPane[Dynamic[pt], Graphics[{
PointSize[0.02],(*Draw the container*)
Line[size {{-1, -1}, {1, -1}, {1, 1}, {-1, 1}, {-1, -1}}],
Blend[{Blue, Red}, charge/0.3],
Point[(*Start the main dynamic actions*)
(*Reset the collision counter*)
collision = 0;
(*Check for mouse interaction and add points if there has \
been one*)
If[EuclideanDistance[pt, lastpt] > 0.001, (*adjust*)
(
If[ballcount < MAXPOINTS,
ballcount++
];
rand = RandomReal[{0, 2 \[Pi]}];
npt = {Cos[rand], Sin[rand]};
AppendTo[contents, {pt, npt} ];
lastpt = pt
)
];
(*Update the position of the points using their velocity \
values*)
contents =
Map[{#[[1]] + #[[2]] charge, #[[2]]} &, contents];
(*Check for and fix points that have exceeded the box in \
Y direction,incrementing the collision counter for each one*)
contents = Map[
If[Abs[#[[1, 2]]] > size,
(
collision++;
{{#[[1, 1]],
2 size Sign[#[[1, 2]]] - #[[1, 2]]}, {1, -1} #[[2]]}
),
(
#
)
] &, contents
];
(*Check for and fix points that have exceeded the box in \
X direction,
incrementing the collision counter for each one*)
contents =
Map[If[Abs[#[[1, 1]]] > size,
collision++; {{2 size Sign[#[[1, 1]]] - #[[1, 1]], #[[
1, 2]]}, {-1, 1} #[[2]]}, #] &, contents
];
hits = Take[PadLeft[Append[hits, collision/size], 200],
200];
Map[First, contents]
]
},
PlotRange -> {{-1.01, 1.01}, {-1.01, 1.01}},
ImageSize -> {250, 250}
], Appearance -> None
],(*Show the hits*)
Show[ListPlot[Take[MovingAverage[hits, smooth], -100],
Joined -> True, ImageSize -> {250, 250}, AspectRatio -> 1,
PlotLabel -> "number of hits", AxesLabel -> {"time", "hits"},
PlotRange -> {0, Max[Max[hits], 1]}
]
]
}
}
]
)
];
image
],
{{MAXPOINTS, 50}, None},
{pt, {{0, 1}}, None},
{{ballcount, 5, "number of ball bearings"}, 1, MAXPOINTS, 1,
Appearance -> "Labeled", ImageSize -> Small},
{{charge, 0.05, "charge"}, 0.002, 0.3, Appearance -> "Labeled",
ImageSize -> Small},
Row[{Button["START", {running = True; tick += $MachineEpsilon}],
Button["STOP", running = False]}],
{{tick, 0}, None},
{smooth, 1, None},
{size, 1, None},
{hits, {{}}, None},
{{contents, {}}, None},
{lastpt, {{0, 0}}, None},
{{collision, 0}, None},
{image, None},
{{running, True}, None},
TrackedSymbols -> { tick},
ContinuousAction -> False,
SynchronousUpdating -> True
]

How can I select one out of several Graphics3D objects and change its coordinates in Mathematica?

In the accepted answer of question " Mathematica and MouseListener - developing interactive graphics with Mma " Sjoerd C de Vries demonstrates that it is possible to select an object in a 3D graphic and change its color.
I would like to know if it is possible (in a similar fashion as above) in a Graphics3D with two or more objects (e.g. two cuboids) to select one and change its coordinates (by moving or otherwise)?
I'm partly reusing Sjoerd's code here, but maybe something like this
DynamicModule[{pos10, pos11 = {0, 0, 0},
pos12 = {0, 0, 0}, pos20, pos21 = {0, 0, 0}, pos22 = {0, 0, 0}},
Graphics3D[{EventHandler[
Dynamic[{Translate[Cuboid[], pos11]}, ImageSize -> Tiny],
{"MouseDown" :> (pos10 = Mean#MousePosition["Graphics3DBoxIntercepts"]),
"MouseDragged" :> (pos11 =
pos12 + Mean#MousePosition["Graphics3DBoxIntercepts"] - pos10),
"MouseUp" :> (pos12 = pos11)}],
EventHandler[
Dynamic[{Translate[Cuboid[{1, 1, 1}], pos21]}, ImageSize -> Tiny],
{"MouseDown" :> (pos20 = Mean#MousePosition["Graphics3DBoxIntercepts"]),
"MouseDragged" :> (pos21 =
pos22 + Mean#MousePosition["Graphics3DBoxIntercepts"] - pos20),
"MouseUp" :> (pos22 = pos21)}]},
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}]]
Note that this just moves the cuboids in a plane so you would have to rotate the bounding box to move them perpendicular to that plane, but it shouldn't be too hard to introduce a third dimensions by adding modifier keys.
Edit
Thanks for the comments. Here's an updated version of the code above. In this version the cubes jump back to within the bounding box if they happen to move outside so that should solve the problem of the disappearing cubes.
DynamicModule[{init, cube, bb, restrict, generate},
init = {{0, 0, 0}, {2, 1, 0}};
bb = {{-3, 3}, {-3, 3}, {-3, 3}};
cube[pt_, scale_] :=
Translate[Scale[Cuboid[{-1/2, -1/2, -1/2}, {1/2, 1/2, 1/2}], scale], pt];
restrict[pt_] := MapThread[Min[Max[#1[[1]], #2], #1[[2]]] &, {bb, pt}];
generate[pos_, scale_] := Module[{mp, pos0, pos1, pos2},
mp := MousePosition["Graphics3DBoxIntercepts"];
pos1 = pos;
EventHandler[
Dynamic[{cube[pos1, scale]}, ImageSize -> Tiny],
{"MouseDown" :> (pos0 = LeastSquares[Transpose[mp], pos1].mp),
"MouseDragged" :>
((pos1 = #[[2]] + Projection[pos0 - #[[2]], #[[1]] - #[[2]]]) &#mp),
"MouseUp" :> (pos1 = restrict[pos1])}]];
Graphics3D[generate[#, 1] & /# init, PlotRange -> bb, PlotRangePadding -> .5]
]

Match legend and Plot size

Please Consider :
intense = Reverse[Round[Rationalize /# N[10^Range[0, 3, 1/3]]]];
values = Range[0, 9/10, 1/10];
intensityLegend = Column[Prepend[MapThread[
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 16, Bold], {2, .5}]}]}]],
{intense, values}], Text[Style["Photons Number", Bold, 15]]]];
IntersectionDp1={{1., 588.377}, {2.15443, 580.306}, {4.64159, 573.466}, {10.,560.664},
{21.5443, 552.031}, {46.4159, 547.57}, {100.,545.051},
{215.443, 543.578}, {464.159, 542.281}, {1000., 541.346}}
FindD1=ListLogLinearPlot[Map[List, IntersectionDp1],
Frame -> True,
AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize = 0.04}, {Graphics[{Lighter[Blue, #], Disk[]}],
markerSize} & /#Range[9/10, 0, -1/10]], Filling -> Axis,
FillingStyle -> Opacity[0.8],
PlotRange -> {{.5, 1100}, {540, 600}},
ImageSize->400];
Grid[{{intensityLegend, FindD1}, {intensityLegend, FindD1}},
ItemSize -> {50, 20}, Frame -> True]
How could I get the legend Column Size to Fit the Height of the Plot Area ?
While Row adjust the size I need to use Grid. This is why I duplicated in grid.
Working with Image Sizes. The (* <- *) marks the important modifications to your code, the rest are mainly font size thingies:
intense = Reverse[Round[Rationalize /# N[10^Range[0, 3, 1/3]]]];
values = Range[0, 9/10, 1/10];
imgSize = 400; (* <- *)
Off[Ticks::ticks]
IntersectionDp1 = {{1., 588.377}, {2.15443, 580.306}, {4.64159, 573.466},
{10., 560.664}, {21.5443, 552.031}, {46.4159, 547.57}, {100., 545.051},
{215.443, 543.578}, {464.159, 542.281}, {1000., 541.346}}
FindD1 = ListLogLinearPlot[Map[List, IntersectionDp1], Frame -> True,
AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize = 0.04},
{Graphics[{Lighter[Blue, #], Disk[]}], markerSize} &
/# Range[9/10, 0, -1/10]], Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{.5, 1100}, {540, 600}}, ImageSize -> imgSize]; (* <- *)
intensityLegend =
Rasterize[Column[
Prepend[
Reverse#MapThread[ (* <- *)
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 30, Bold], {2, .5}]}]}]],
{intense, values}],
Text[Style["Photons Number", Bold, 25]]]],
ImageSize -> {Automatic, (* <- *)
IntegerPart#
First[imgSize Cases[AbsoluteOptions[FindD1],
HoldPattern[AspectRatio -> x_] -> x]]}];
Grid[{{intensityLegend, FindD1}, {intensityLegend, FindD1}}, Frame -> True]
Where I reversed the intensities column for aesthetic purposes.
Edit
If you don't explicitly specify the ImageSize option for the Plot, you'll disappointingly find that AbsoluteOptions[Plot, "ImageSize"] returns "Automatic" !
Edit Answering the #500's comment bellow
The expression:
ImageSize -> {Automatic, (* <- *)
IntegerPart#
First[imgSize Cases[AbsoluteOptions[FindD1],
HoldPattern[AspectRatio -> x_] -> x]]}];
is really a working replacement for something that should work but doesn't to get the image size of a Plot:
ImageSize -> {Automatic, Last#AbsoluteOptions[FindD1,"ImageSize"]}
So, what the IntegerPart[...] thing is doing is getting the vertical size of the plot image, multiplying imgSize by the AspectRatio of the Plot.
To understand how it works, run the code and then type:
AbsoluteOptions[FindD1]
and you will see the Plot options there. Then the Cases[] function is just extracting the AspectRatio option.
In fact there is a cleaner way to do what the Cases[] does. It is:
AbsoluteOptions[FindD1,"AspectRatio"]
but there is another bug in the AbsoluteOptions function that prevents us to use it this way.
How about making the legend a bit smaller?
intensityLegend =
Column[Prepend[
MapThread[
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 12, Bold], {2, .5}]},
ImageSize -> 50]}]], {intense, values}],
Text[Style["Photons Number", Bold, 15]]]];

How can I constrain locators to a limited (but not regular) set of positions?

In Mathematica, locators can be constrained to certain screen regions via the parameters of LocatorPane (See LocatorPane documentation.)
A list of three ordered pairs {{{minX, minY}, {maxX, maxY}, {dX, dY}}} is usually the key to determining the behavior of locators. {minX, minY} and {maxX, maxY} set the region. {dX, dY} sets the jump size: zero for unrestrained, any other positive number for the size of each hop.
In the code below, {{{-.9, 0}, {1, 0}, {0, 0}}} sets the region and jumps for the locator pts. The first two ordered pairs limit the locators to the interval [-9, 1] on the number line. The ordered pair {0, 0} imposes no additional constraints on either of the locators. However, because the y values can only be zero, due to the region defined by the first two items, neither locator is free to leave the x-axis.
I'd like to confine each locator to x-values in myTicks. (In the full program, myTicks will change over time depending on decisions made by the user.) Because the ticks are not uniformly spaced along x, the issue cannot be solved by setting a constant value for the x-jump. And if the value were take into account the current position of the locator, the next left hop might be different size than the right hop.
myTicks = {-.9, 0, .1, .2, .45, .79, 1};
pts = {{.25, 0}, {.75, 0}};
LocatorPane[Dynamic[pts],
Graphics[{},
Axes -> {True, False},
PlotLabel -> Row[{"locators at: " , Dynamic[pts[[1, 1]]], " and ",
Dynamic[pts[[2, 1]]]}],
Ticks -> {myTicks, Automatic}],
{{{-.9, 0}, {1, 0}, {0, 0}}}]
Any suggestions would be appreciated!
This appears to work.
myTicks = {-.9, 0, .1, .2, .45, .79, 1};
DynamicModule[{p = {.25, 0}, p2 = {.75, 0}},
LocatorPane[Dynamic[{p, p2}],
Graphics[{}, Axes -> {True, False},
PlotLabel ->
Row[{"locators at: ",
Dynamic[p[[1]] = Nearest[myTicks, p[[1]]][[1]]], " and ",
Dynamic[p2[[1]] = Nearest[myTicks, p2[[1]]][[1]]]}],
Ticks -> {myTicks, Automatic}], {{{-.9, 0}, {1, 0}}}, ContinuousAction -> False]
]
Let's try this:
pts = {{0, 0}, {10, 0}};
myTics = Table[{x, 0}, {x, 0, 10, 5}];
LocatorPane[Dynamic[pts],
ListPlot[myTics, PlotRange -> {{-1, 11}, {-1, 1}},
PlotStyle -> Directive[PointSize[.07], Red],
Epilog -> {PointSize[.05], Blue, h = Point[Dynamic[{Nearest[myTics, pts[[1]]]}]],
PointSize[.03], Yellow, j = Point[Dynamic[{Nearest[myTics, pts[[2]]]}]],
Black,
Text[{"locators at: ", Dynamic[h[[1, 1]]], " and ",Dynamic[j[[1, 1]]]},
{5, .5}]}],
Appearance -> None]

Resources