5
$\begingroup$

When I move with the mouse over a plot with a given plot range I would like to store the coordinates of the corresponding trajectory in a list and plot it.

I have seen that MousePosition is used to read the current mouse position in the notebook, but I do not how to start.

$\endgroup$
6
$\begingroup$

The following works:

mymouse := Block[{}, pos = MousePosition["Graphics"]; 
              If[pos =!= None, AppendTo[posList, pos]]]
posList = {};
plot = Plot[Sin[x], {x, 0, 4 Pi}]; (* your plot *)

Dynamic[Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]

enter image description here

(This amazing artwork is copyrighted ©anderstood)

Edit Maybe this is a bit smoother?

mymouse := Block[{}, pos = MousePosition["Graphics"];
  If[pos =!= None, AppendTo[posList, pos];
         posList = DeleteDuplicates@posList;]]
(* If[pos =!= None && Not@MemberQ[postList,pos], AppendTo[posList, pos]; *) 
posList = {};
plot = Plot[Sin[x], {x, 0, 4 Pi}];(*your plot*)Dynamic[
 Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]

And this to avoid the slow AppendTo:

i = 1;
mymouse := Block[{}, pos = MousePosition["Graphics"];
  If[pos =!= None, posList[[i]] = pos; i++;]]
posList = ConstantArray[{0, 0}, 1000];
plot = Plot[Sin[x], {x, 0, 4 Pi}];(*your plot*)Dynamic[
 Show[plot, ListLinePlot[posList, PlotStyle -> Red]]]
Dynamic[mymouse]
$\endgroup$
  • 1
    $\begingroup$ Thank you, this works good, but somehow my on my computer it is very slow: when I move the mouse I have to wait a while to see the curve. Can you also observe this? Another problem: if the mouse is not moved the code continuously stores the same coordinate. Can the code store only once this coordinates? PS: Nobody will be able exactly to repeat your copyrighted artwork, it is unique ;-) $\endgroup$ – lio Feb 21 '18 at 9:31
  • 3
    $\begingroup$ @lio I edited, is it better? I tried on two PCs and is was OK, not perfect but OK. To improve that, you would need someone more knowledgeable than me... AppendTo is not recommended but I do not see how to avoid that. I added a third possibility just to see if its smoother, but it introduces the point {0, 0}. $\endgroup$ – anderstood Feb 22 '18 at 0:25
  • $\begingroup$ This is excellent for a project I am currently working on; I did not know about MousePosition! Is there an easy way to make this start recording points on the path after a mouseclick, and end after clicking again? $\endgroup$ – Steve Apr 3 at 4:28
  • $\begingroup$ @Steve I don't have MMA readily available to try it, but I would start by reading reference.wolfram.com/language/ref/EventHandler.html. $\endgroup$ – anderstood Apr 3 at 14:53
5
$\begingroup$
ClearAll[addLines]
addLines = DynamicModule[{lc, t = .01, nps = NewPrimitiveStyle /.
       Options[$FrontEnd, NewPrimitiveStyle]},
 Column[{Row[{Button["add lines", FrontEndExecute[
    FrontEnd`Select2DTool["DrawFreehand", "Persistent" -> True]], Alignment -> Center],
  Panel@ColorSetter[Dynamic[lc, (lc = #; SetOptions[$FrontEndSession,
     NewPrimitiveStyle -> {nps = nps /. Rule[LineColor, _] :> Rule[LineColor, #]}]) &],
     BaselinePosition -> Scaled[1/4]],
  Panel@Labeled[LabeledSlider[Dynamic[t, ((t = #; SetOptions[$FrontEndSession,
     NewPrimitiveStyle -> {nps = nps /. Rule[Thickness, _] :>  Rule[Thickness, #]}])) &], 
    {0, 1/10, 1/100}, ImageMargins -> 0, ContentPadding -> False], "thickness", Left]},
 Spacer[1], Alignment -> Center], #}]] &;

Examples:

addLines[Plot[Sin[x], {x, 0, 4 Pi}, ImageSize -> 500]]

enter image description here

addLines[BarChart[Range[10], ImageSize -> 500]]

enter image description here

See also: tutorial/InteractiveGraphicsPalette

$\endgroup$
  • 1
    $\begingroup$ Great use of "DrawFreehand"! However I think your drawing skills lack originality. It's too much copied from Otto Zitko. $\endgroup$ – anderstood Feb 23 '18 at 0:42
  • $\begingroup$ @anderstood, my "drawings skills" :) $\endgroup$ – kglr Feb 23 '18 at 0:53
  • $\begingroup$ How to store the coordinates of the corresponding trajectory in a list ? $\endgroup$ – Mariusz Iwaniuk Feb 23 '18 at 11:13
  • $\begingroup$ @MariuszIwaniuk, I don't know an easy way to modify this to get the coordinates. I will update if I come up with a solution. $\endgroup$ – kglr Feb 24 '18 at 2:34
  • 1
    $\begingroup$ This is great and very fast, but I need to access the coordinates. It would be great if that would be possible. $\endgroup$ – lio Feb 26 '18 at 11:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.