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.
