How do I find the coordinates of points in this image?

Question

I have never used image processing with Mathematica. I need to get the coordinates of the red points from this image I made in Illustrator. Is there a way to get Mathematica to read or detect the x-y coordinates?

Answer 1

A solution for Mathematica version 9:

image = Import["https://i.sstatic.net/R0Dqo.png"]
pts = PixelValuePositions[image, Red, .2];
ListPlot[pts, 
 PlotStyle -> Darker@Orange, 
 PlotMarkers -> {Automatic, .05}, 
 PlotRange -> {{0, 1500}, {0, 800}}, 
 ImageSize -> 600]

Answer 2

The question leaves open what a "point" is, as opposed to a pixel.

Attempt at points

If points overlap in the image, it is beyond my skill to separate them. Others here have far more experience in image processing and may be able to suggest things, within limits. If the points are separated, then here's a rough stab at finding them:

MorphologicalComponents[Binarize[img, {0.29, 0.6}], 0.68] // Colorize

(rules = ArrayRules[MorphologicalComponents[Binarize[img, {0.29, 0.6}], 0.68]];
  points = Mean /@ Map[First, GatherBy[rules, Last], {2}];) // Timing
Length[points]

{0.072981, Null}
195

The points are image coordinates; we should convert them to graphics coordinates before plotting:

ListPlot[{#[[2]], Last@ImageDimensions[img] - #[[1]]} & /@ points, 
 PlotMarkers -> {Automatic, 2}, 
 PlotRange -> Transpose[{{0, 0}, ImageDimensions[img]}], 
 PlotRangePadding -> 50, AxesOrigin -> {0, -50}]

Pixels

The same method is an efficient way to get the pixels (especially if you do not have v9 and PixelValuePositions to use).

(rules = ArrayRules[MorphologicalComponents[Binarize[img, {0.29, 0.6}], 0.68]];
  pixelCoords = SparseArray[rules]["NonzeroPositions"];) // Timing
Length@pixelCoords

{0.070562, Null}
2629

ListPlot[{#[[2]], Last@ImageDimensions[img] - #[[1]]} & /@ pixelCoords,
 PlotMarkers -> {Automatic, 0.25}, 
 PlotRange -> Transpose[{{0, 0}, ImageDimensions[img]}], 
 PlotRangePadding -> 50, AxesOrigin -> {0, -50}]

---

This way is nearly as fast and gives the same result as above:

pixelCoords = Position[ImageData@Binarize[img, {0.29, 0.6}], 1]; // Timing
Length@pixelCoords

{0.108690, Null}
2629

Answer 3

Using relatively simple functions:

c = Import["https://i.sstatic.net/R0Dqo.png"] ;
a = Rasterize[c];
reds = Cases[Union[Flatten[a[[1, 1]], 1]], {r_ /; r > 200, g_ /; g < 50, b_ /; b < 50}];
Row[{First[Timing[b = Map[Position[a[[1, 1]], #] &, reds]]], " seconds"}]

13.073 seconds

ListPlot[Reverse /@ Flatten[b, 1], PlotStyle -> Red, AxesOrigin -> {0, 0}]

Answer 4

Another way without Mathematica version 9 PixelValuePositions

img = Import["https://i.sstatic.net/R0Dqo.png"];
pix = Round[ImageData[img, DataReversed -> True]];
ListPlot[Reverse /@ Position[pix, {1, 0, 0}], AxesOrigin -> {0, 0}]