# Find the coordinates of a hand drawn curve

Imagine I have saved a hand drawn curve as a jpg file. I want to be able to enclose it in a box and read off coordinates of the points that lie on the curve. One way is to click on a point and get the coordinates. But I want to automate this.

• Related questions and answers have been posted at MSE. (For example, 23764). Please, provide image(s) you want to work with. Nov 29, 2020 at 15:46
• How close is this WRI page, "Get Coordinates from an Image", to what you want to do? Nov 29, 2020 at 15:48
• In this method I have to manually specify which points I am interested in. I want to feed a jpg image of a hand drawn curve and automatically get coordinates (end points mandatory, the number of points is an input) Nov 29, 2020 at 15:54

(* get the image *)
img = Import["https://i.sstatic.net/FFioq.png"]

(* get the pixel positions on the line *)
binz = Thinning@ColorNegate@Binarize@CurvatureFlowFilter[img, 2];
positions = PixelValuePositions[binz, 1];

(* create a graph structure connecting pixel positions in a chain *)
gr = SimpleGraph[
NearestNeighborGraph[positions,
DistanceFunction -> ChessboardDistance, DirectedEdges -> False]];

(* make sure we discard any small pixels that are not on the main curve *)
largestgr = First@MaximalBy[ConnectedGraphComponents[gr], VertexCount];

(* the start/end pixels are the ones with lowest degree *)
{start, end} =
VertexList[largestgr][[
Flatten@Position[VertexDegree[largestgr], 1]
]];

(* find path from start to end and plot *)
path = First[FindPath[largestgr, start, end]];
ListLinePlot[path, AspectRatio -> 1]


This is a bit shorter if you use DeleteSmallComponents instead to remove any stray pixels not part of the curve:

bwimg = DeleteSmallComponents@Thinning@ColorNegate@Binarize@img;
gr = NearestNeighborGraph[PixelValuePositions[bwimg, 1],
DistanceFunction -> ChessboardDistance];
{start, end} = Select[VertexList@gr, VertexDegree[gr, #] == 1 &];
path = First@FindPath[gr, start, end];

HighlightImage[img, path]
ListLinePlot[path, AspectRatio -> 1]


If you need arbitrary paths that may contain loops and intersections, then maybe you should look at FindCurvePath instead:

img = Rasterize[Text["A"], RasterSize -> 64];
bwimg = DeleteSmallComponents@Thinning@ColorNegate@Binarize@img;
positions = PixelValuePositions[bwimg, 1];
paths = FindCurvePath[positions];
ListLinePlot[positions[[#]] & /@ paths]


Also, ListCurvePathPlot[positions] would work too.

• Even thought I am not supposed to say "Thanks" I will. A huge thanks to flinty. Dec 2, 2020 at 15:09
• @QuasarSupernova Cheers! I will continue to elaborate on this answer if I find a shorter or more robust way to do it. Dec 2, 2020 at 15:11
• However it does not seem to work on the letter R and many others. I get this error : Set::shape: Lists {start,end} and {{244,184},{271,181},{250,113},{267,121},{270,109},{242,86},{282,137},{297,84},{294,83},{282,95}} are not the same shape. Dec 2, 2020 at 16:09
• Letters like R, X, A etc all have multiple endpoints, so there is no way to sort them (except maybe topologically) and therefore no way to list plot them as a single cuve. If you just need the points then PixelValuePositions[#, 1]&@DeleteSmallComponents@Thinning@ColorNegate@Binarize@img will work, and so will everything before the line {start, end} ...  - You should provide examples of the curves you're working with and what you expect from them in your question Dec 2, 2020 at 16:22
• Just points will do. I want to use this to parametrise the curve and to classify them topologically. Dec 3, 2020 at 2:49