# How can I manually pick the data out of the image of a plot?

edit: The automatic way listed here doesn't work for an application like mine in which there are several curves on the same plot that all have the same markers, but you only want one curve (it will pick all of them, and then you will have to manually pick the points anyway), and it actually threw errors and crashed when I tried it anyway. So, I modified it to remove the automatic steps and it does exactly what I'd like, I've put the code at the bottom of this post.

I actually have several related questions, but I didn't know how to phrase them, and this seemed like the best way.

Basically, I frequently import plots from old papers, and I need their data. I usually can't use one of the online tools that grabs a plot's data, because often there will be several curves on the same plot (someone, please correct me if there's an easy way to do this!).

So, I made a little set of functions in Mathematica, that pretty much does what I need. It's all based on the fact that when you right click on an image and click "get coordinates", you can click on many points, and then ctrl+C to copy, and then ctrl+V to paste in the notebook, and it will give you a pretty list of pairs of the coordinates of all the points you picked! So I click on a couple of points for each axes to get the scaling function between values on the plot and pixels (like, at the 0 tic and the 300 tic for one axes), and then I do the same for a bunch of points on the data curve. Then, my functions turn those coordinates into actual data values, using the scaling from before.

So this works, but it's kind of awkward. I have to do the clicking, the copying and pasting, and then punch it all into my function. What I'd much rather prefer is to have a function where I start it, it pops up a dialog box, I either select an image from file and it loads it or I just use my mouse to select an image I already inserted into the Notebook, then it prompts me for two points on the horizontal axes, I click those (without having to right click->get coords) and enter their tic values in a text field, click 'ok' in a dialog box, it does the same for the vertical axes, and then the same for a bunch of points on the data curve, and then it simply spits out the final data.

The way I'm thinking of doing it now is, I have my image inserted into my notebook, and I use a combination of MousePosition[] and EventHandler[], and I don't actually need the image to be selected at all, or even for the function to know about the image. From there, I'll make it so when the mouse clicks, the EventHandler adds its position to a list, until you hit ok, for the next step.

I think that'll work, but is there a smarter way?

edit: Modified solution (I left the removed sections commented out so you can see what was removed) from here:

findMarkers[img_, pt_, thres_, minArea_] :=
ComponentMeasurements[
MorphologicalComponents[
ColorNegate[
Binarize[
ImageCorrelate[img, ImageTrim[img, pt],
NormalizedSquaredEuclideanDistance], thres]]], {"Centroid",
"Area"}, #2 > minArea &][[All, 2, 1]];

SetAttributes[getMarkers, HoldRest];
getMarkers[img_, resMarkers_] :=
DynamicModule[{pt = {ImageDimensions[img]/4, ImageDimensions[img]/2},
axisDefinePane,(*defineMarkerPane,findMarkerPane,*)
editMarkersPane, finalResultPane, xAxisBegin, xAxisEnd, yAxisBegin,
yAxisEnd, myMarkers, myTransform,
xoy = {{1/2, 1/8} ImageDimensions[img], {1/8, 1/8} ImageDimensions[
img], {1/8, 1/2} ImageDimensions[img]}},
axisDefinePane =
Grid[{{LocatorPane[Dynamic[xoy],
Dynamic[Show[img, Graphics[{Line[xoy]}]]],
Appearance -> {Graphics[{Red, AbsolutePointSize[5],
Point[{0, 0}]}],
Graphics[{Green, AbsolutePointSize[5], Point[{0, 0}]}],
Graphics[{Blue, AbsolutePointSize[5],
Point[{0, 0}]}]}]}, {Row[{"x(1): ",
InputField[Dynamic[xAxisBegin], Number, FieldSize -> Tiny],
" x(2): ",
InputField[Dynamic[xAxisEnd], Number,
FieldSize -> Tiny]}]}, {Row[{"y(1): ",
InputField[Dynamic[yAxisBegin], Number, FieldSize -> Tiny],
" y(2): ",
InputField[Dynamic[yAxisEnd], Number, FieldSize -> Tiny]}]}}];
(*defineMarkerPane=LocatorPane[Dynamic[pt],Dynamic[Show[img,
Graphics[{EdgeForm[Black],FaceForm[],Rectangle@@pt}]]],
Appearance\[Rule]Graphics[{Red,AbsolutePointSize[5],Point[{0,0}]}]];
findMarkerPane=Manipulate[Show[img,Graphics[{Red,Circle[#,
5]&/@(myMarkers=findMarkers[img,pt,t,1.05])}]],{{t,0.2,"Threshold"},
0,1},TrackedSymbols\[Rule]{t},ControlPlacement\[Rule]Bottom];*)
myMarkers = {};
editMarkersPane =
LocatorPane[Dynamic[myMarkers], img,
Appearance -> Graphics[{Red, Circle[{0, 0}, 1]}, ImageSize -> 10],
LocatorAutoCreate -> True];
finalResultPane =
Dynamic[
myTransform =
FindGeometricTransform[{{xAxisEnd, yAxisBegin}, {xAxisBegin,
yAxisBegin}, {xAxisBegin, yAxisEnd}}, xoy][[2]] // Quiet;
ListLinePlot[resMarkers = myTransform /@ Sort[myMarkers],
Frame -> True, Mesh -> All],
TrackedSymbols -> {myMarkers, xoy, xAxisEnd, yAxisBegin,
xAxisBegin, yAxisBegin, xAxisBegin, yAxisEnd}];
TabView[{"Define axes" ->
axisDefinePane,(*"Define marker"\[Rule]defineMarkerPane,
"Find Markers"\[Rule]findMarkerPane,*)
"Edit Markers" -> editMarkersPane, "Results" -> finalResultPane}]]


The only part I had to add was a myMarkers={}; in front of the edit section, because it had been defined in one of the removed spots. Now you alt-click to add markers.

• Have you seen this and this? Feb 24, 2016 at 18:11
• @J.M. I saw those, but wish I had replied sooner, before this got closed -- neither of those will work for my application. And, in fact, I just tried the first link you posted, and it doesn't work at all, for what seems like a fairly straightforward application. It throws a ton of errors and doesn't find the markers, given a very clear one. It seems reasonable that this question should be able to be asked even if there's already one solution, because that solution doesn't work for all applications, so I've edited my question so it can hopefully be reopened. Feb 25, 2016 at 16:49
• @J.M. So his application was throwing an error for whatever reason during the automatic marker finding stage, but that actually wouldn't have worked for my application anyway (because all the markers are the same, for several lines). Removing the automatic section of his and just leaving the "edit markers" stage made the error go away and does exactly what I need, so I'll edit my question to reflect that, and leave it closed. Feb 25, 2016 at 17:14
• Closes are not permanent. Please post your modified solution as a self-answer. In the future if you have a unique answer for a closed question, your own or otherwise, flag the post and explain this, and I will probably reopen it. Feb 25, 2016 at 20:02

So I basically just used the solution from this post, but modified to remove the automatic marker finding part:

findMarkers[img_, pt_, thres_, minArea_] :=
ComponentMeasurements[
MorphologicalComponents[
ColorNegate[
Binarize[
ImageCorrelate[img, ImageTrim[img, pt],
NormalizedSquaredEuclideanDistance], thres]]], {"Centroid",
"Area"}, #2 > minArea &][[All, 2, 1]];

SetAttributes[getMarkers, HoldRest];
getMarkers[img_, resMarkers_] :=
DynamicModule[{pt = {ImageDimensions[img]/4, ImageDimensions[img]/2},
axisDefinePane,(*defineMarkerPane,findMarkerPane,*)
editMarkersPane, finalResultPane, xAxisBegin, xAxisEnd, yAxisBegin,
yAxisEnd, myMarkers, myTransform,
xoy = {{1/2, 1/8} ImageDimensions[img], {1/8, 1/8} ImageDimensions[
img], {1/8, 1/2} ImageDimensions[img]}},
axisDefinePane =
Grid[{{LocatorPane[Dynamic[xoy],
Dynamic[Show[img, Graphics[{Line[xoy]}]]],
Appearance -> {Graphics[{Red, AbsolutePointSize[5],
Point[{0, 0}]}],
Graphics[{Green, AbsolutePointSize[5], Point[{0, 0}]}],
Graphics[{Blue, AbsolutePointSize[5],
Point[{0, 0}]}]}]}, {Row[{"x(1): ",
InputField[Dynamic[xAxisBegin], Number, FieldSize -> Tiny],
" x(2): ",
InputField[Dynamic[xAxisEnd], Number,
FieldSize -> Tiny]}]}, {Row[{"y(1): ",
InputField[Dynamic[yAxisBegin], Number, FieldSize -> Tiny],
" y(2): ",
InputField[Dynamic[yAxisEnd], Number, FieldSize -> Tiny]}]}}];
(*defineMarkerPane=LocatorPane[Dynamic[pt],Dynamic[Show[img,
Graphics[{EdgeForm[Black],FaceForm[],Rectangle@@pt}]]],
Appearance\[Rule]Graphics[{Red,AbsolutePointSize[5],Point[{0,0}]}]];
findMarkerPane=Manipulate[Show[img,Graphics[{Red,Circle[#,
5]&/@(myMarkers=findMarkers[img,pt,t,1.05])}]],{{t,0.2,"Threshold"},
0,1},TrackedSymbols\[Rule]{t},ControlPlacement\[Rule]Bottom];*)
myMarkers = {};
editMarkersPane =
LocatorPane[Dynamic[myMarkers], img,
Appearance -> Graphics[{Red, Circle[{0, 0}, 1]}, ImageSize -> 10],
LocatorAutoCreate -> True];
finalResultPane =
Dynamic[
myTransform =
FindGeometricTransform[{{xAxisEnd, yAxisBegin}, {xAxisBegin,
yAxisBegin}, {xAxisBegin, yAxisEnd}}, xoy][[2]] // Quiet;
ListLinePlot[resMarkers = myTransform /@ Sort[myMarkers],
Frame -> True, Mesh -> All],
TrackedSymbols -> {myMarkers, xoy, xAxisEnd, yAxisBegin,
xAxisBegin, yAxisBegin, xAxisBegin, yAxisEnd}];
TabView[{"Define axes" ->
axisDefinePane,(*"Define marker"\[Rule]defineMarkerPane,
"Find Markers"\[Rule]findMarkerPane,*)
"Edit Markers" -> editMarkersPane, "Results" -> finalResultPane}]]


The only thing I added (as opposed to removing) was the myMarkers={}; in front of the edit section, because it had been defined in one of the removed spots. Now you alt-click to add markers.