20
$\begingroup$

Is there a way to dynamically define a polygon on a plot (I'm working with ListPlot and SmoothDensityHistogram) to select a cluster of interest, and give the positions of those points in the original list of data?

I'd appreciate any help!

Here's just an example set of points:

x = {
     {RandomReal[{0, 5}, 20],
      RandomReal[{4, 4.5}, 10]},
     {RandomReal[1, 20],
      RandomReal[{1.5, 2}, 10]}
    };

points = Transpose[Join @@@ x] ~RandomSample~ 30;

SmoothDensityHistogram[points, ColorFunction -> "TemperatureMap"]
ListPlot[points, PlotRange -> {{0, 5.5}, {0, 2.5}}]
Improve this question
$\endgroup$
1
  • 3
    $\begingroup$ Press CTRL-D to open the drawing tools, then draw a polygon. Select the polygon, copy it, and paste it back into an input cell to get the vertex coordinates. Then filter the points based on whether they're in the polygon. Someone will probably write a Manipulate with a Paste button to do this automatically. $\endgroup$
    – Szabolcs
    Commented Mar 27, 2012 at 11:40

2 Answers 2

Reset to default
19
$\begingroup$

This is basically the same as what b.gatessucks is doing. The main addition is that I've put all the locators in one list. To add vertices to the polygon you just click somewhere on the graph. I've also added a reset button and a button that prints the indices of the points inside the polygon which makes it easier to copy.

points = RandomSample[
   Transpose[{Flatten[{RandomReal[{0, 5}, 20], RandomReal[{4, 4.5}, 10]}], 
     Flatten[{RandomReal[1, 20], RandomReal[{1.5, 2}, 10]}]}], 30];

winding[poly_, pt_] := Round[(Total @ Mod[(# - RotateRight[#]) &@
  (ArcTan @@ (pt - #) & /@ poly), 2 Pi, -Pi]/2/Pi)]

DynamicModule[{pl, pos},
 pl = SmoothDensityHistogram[points, ColorFunction -> "TemperatureMap"];
 Manipulate[
  pos = Pick[Range[Length[points]], Unitize[winding[poly, #] & /@ points], 1];
  Show[pl, 
   Epilog -> {{Darker[Green], PointSize[Medium], Point[points[[pos]]]},
     {Black, Point[Complement[points, points[[pos]]]]},
     {EdgeForm[{Red, Dashed}], FaceForm[], Polygon[poly]}}],

  {{poly, {}}, Locator, LocatorAutoCreate -> All},
  Row[{Button["Copy Points", Print[pos]], Button["Reset", poly = {}; pos = {}]}]]]

Mathematica graphics

Improve this answer
$\endgroup$
3
  • $\begingroup$ @Heike I suppose you can also have have a button: Button["Get Polytope Vertices", Print[poly]], which returns the vertices of the polytope you've defined by clicking. $\endgroup$
    – Sparse Pine
    Commented Jul 27, 2013 at 3:54
  • $\begingroup$ @SparsePine and an "undo" button is also useful, Button["undo", poly = Drop[poly, -1]] $\endgroup$
    – matheorem
    Commented Dec 11, 2013 at 4:39
  • $\begingroup$ Hi, Heike, Could you please tell me how to change Locator size in manipulate? $\endgroup$
    – matheorem
    Commented Dec 11, 2013 at 6:46
12
$\begingroup$

Something like (@Szabolcs provided the link to PointInPoly) :

Manipulate[
  Column[{
    Show[ListPlot[points, PlotRange -> {{0, 5.5}, {0, 2.5}}], 
      Graphics[{Pink, Opacity[0.5], Polygon[{p1, p2, p3, p4}]}]], 
    Position[points, #] & /@ Select[points, PointInPoly[#, {p1, p2, p3, p4}] == 1 &]}], 
  {{p1, {0, 0}}, Locator}, 
  {{p2, {3, 1}}, Locator}, 
  {{p3, {1, 1}}, Locator}, 
  {{p4, {2, 1}}, Locator}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you. This was very helpful. $\endgroup$
    – Daniel S
    Commented Mar 27, 2012 at 13:40
  • $\begingroup$ It would probably be more convenient to actually have the code for PointInPoly here... kind of bloats, but makes evaluating that much more comfortable. $\endgroup$
    – Yves Klett
    Commented Mar 28, 2012 at 8:40

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.