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.

Improve this question
$\endgroup$
0

2 Answers 2

Reset to default
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]
Improve this answer
$\endgroup$
4
  • 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
    Commented Feb 21, 2018 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
    Commented Feb 22, 2018 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
    Commented Apr 3, 2019 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
    Commented Apr 3, 2019 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

Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ Great use of "DrawFreehand"! However I think your drawing skills lack originality. It's too much copied from Otto Zitko. $\endgroup$
    – anderstood
    Commented Feb 23, 2018 at 0:42
  • $\begingroup$ @anderstood, my "drawings skills" :) $\endgroup$
    – kglr
    Commented Feb 23, 2018 at 0:53
  • $\begingroup$ How to store the coordinates of the corresponding trajectory in a list ? $\endgroup$
    – Mariusz Iwaniuk
    Commented Feb 23, 2018 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
    Commented Feb 24, 2018 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
    Commented Feb 26, 2018 at 11:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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