# Defining a polygon by clicking on an image [duplicate]

Imagine I have some image, $I$, and I'd like to define a polygon by sequentially clicking on the image to define vertices $(v_1, ...) \in V$, where vertices $v_i$ and $v_j$ share an edge if $j = (i+1)$. I'd like to end the vertex selection process by right clicking, or hitting something on the keypad - really anything that's convenient. I suppose I'd like the $v_i$ to be specified in terms of image coordinates vs. image indices (if possible).

Is there a straightforward way to do this in Mathematica 9.0?

• Duplicate: mathematica.stackexchange.com/q/3566/5
– rm -rf
Jul 27, 2013 at 3:09
• @Nasser Ahhh shoot, I'm sorry, I didn't look around carefully enough. >_< Jul 27, 2013 at 3:33

Just a quick start, to see if this is what you want. Can easily extend/clean up. To start a new polygon now or clean the old one, need to re-evaluate, just back of the envelope thing, to see first if this is what you wanted...

pt = {0, 0};
pts = {pt};
ClickPane[
Dynamic[Graphics[{
{Yellow, Disk[]},
{Black, Point[pt]},
{Red, Line[pts]}
}, ImageSize -> Tiny]], (pt = #; AppendTo[pts, pt]) &]

and if you want to use an Image:

pt = {0, 0};
pts = {pt};
img = Import["ExampleData/lena.tif"];
Framed@Grid[{
{
ClickPane[
Dynamic[
Show[Image[img, ImageSize -> 200],
Graphics[{
{Red, PointSize[Large], Point[pt]},
{Thick, White, Line[pts]}
}, ImageSize -> Tiny]]], (pt = #; AppendTo[pts, pt]) &]
},
{Dynamic[pt]}
}
]

• How would I define the first point by clicking only? Jul 27, 2013 at 3:49

Here's a way using Manipulate:

img = Import["ExampleData/lena.tif"];
create = True; color = White;
Manipulate[uS = u;
If[Length[uS] > 1 && Norm[uS[[-1]] - uS[[1]]] < 5, create = False;  color = Red;];
Show[img, Graphics[{color, Line[u]}, PlotRange -> 2]],
{{u, {{0, 0}}}, Locator, LocatorAutoCreate -> Dynamic[create]}]

In this implementation, you can use the locators to draw white lines. Add new locators by command-clicking. As soon as the final locator gets close enough (arbitrarily chosen to be "5" pixels) then the polygon turns red and the addition of new locators is suppressed.

In addition to Nasser's very nice answer, one can also slightly modify the answer of Heiki from the link rm -rf posted: Interactively extract points from a plot (ListPlot or SmoothDensityHistogram) with a button that returns the vertices of the drawn polytope:

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 = ListPlot[points, ColorFunction -> "TemperatureMap", ImageSize -> {850, 850}];
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["Get Polytope Vertices", Print[poly]], Button["Reset", poly = {}; pos = {}]}]]]