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.
$\begingroup$
$\endgroup$
3
-
4$\begingroup$ Related questions and answers have been posted at MSE. (For example, 23764). Please, provide image(s) you want to work with. $\endgroup$– Anton AntonovNov 29, 2020 at 15:46
-
2$\begingroup$ How close is this WRI page, "Get Coordinates from an Image", to what you want to do? $\endgroup$– Anton AntonovNov 29, 2020 at 15:48
-
$\begingroup$ 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) $\endgroup$– Quasar SupernovaNov 29, 2020 at 15:54
Add a comment
|
1 Answer
$\begingroup$
$\endgroup$
12
(* get the image *)
img = Import["https://i.stack.imgur.com/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.
-
$\begingroup$ Even thought I am not supposed to say "Thanks" I will. A huge thanks to flinty. $\endgroup$ Dec 2, 2020 at 15:09
-
$\begingroup$ @QuasarSupernova Cheers! I will continue to elaborate on this answer if I find a shorter or more robust way to do it. $\endgroup$– flintyDec 2, 2020 at 15:11
-
$\begingroup$ 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. $\endgroup$ Dec 2, 2020 at 16:09
-
$\begingroup$ 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@imgwill 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 $\endgroup$– flintyDec 2, 2020 at 16:22 -
$\begingroup$ Just points will do. I want to use this to parametrise the curve and to classify them topologically. $\endgroup$ Dec 3, 2020 at 2:49