Skip to main content

computer vision - How to place path lines on an image


I have a "sugarcane crop" image taken from above (with a Drone) which was pre-processed with the MorphologicalPerimeter and EdgeDetection functions of Mathematica, resulting in binary image with a series of features for which I'd like to find/place some path-lines with specific parameters. Here is the original image:


Field


With some simple image processing functions within Mathematica, I generated the following picture:


EdgeDetect[MorphologicalPerimeter[

ColorSeparate[aImg][[1]], 0.35], 20]

image1


The idea is to find all the free paths between the series of shapes such that they appear like "streets" for the shapes. In other words, the lines should only be drawn over the black background, never touching or crossing the white features (unless that is impossible). The spacing in between the lines should be almost constant, but may vary slightly from one street to the next. In this example they will be almost straight lines, but that is not necessarily the general case, for the "streets" may curve as well.


Here is a bad example of what a result would be. It is a bad example because the lines are evenly spaced, and therefore they end up going over the white features in the image, which shouldn't be allowed. But it illustrates what is to be achieved. Look at the left lower corner of the image to see what is expected for the solution.


image2


To me, this looks like an AI / Computer Vision problem, but I am wondering whether someone would give me a clever Mathematica idea for a starting point to solve this problem in an efficient manner. Bear in mind that in reality I will be dealing with images a lot larger that this.


An alternative solution is to draw the path-lines exactly over the white features, maximizing the "crossings" over the features, creating a series of "sugar cane lines" with as evenly spacing as possible. Please, refer only to the left lower corner of the image below for an idea of the alternate solution.


image3


These two problems seem to be dual, and either solution suffices. Any help will be greatly appreciated.



I am adding information here as I manage to get better preprocessed images. For instance,


EdgeDetect[GradientFilter[
MorphologicalPerimeter[ColorSeparate[aImg][[1]], 0.35], 1], 20]

gives me a very nice preprocessed image,


image4


which I can then add to the original image just to show off the nice results:


image5
(source: dccs.com.br)


However, none of this helps me in determining the best paths for the "street" lines, not to mention that they should not be considered to be straight lines. They just happen to be in this example.



Here goes an original image with the suggested curved path. Unfortunately, in this case, the sugarcane is still in its infancy, but it represents a real case problem which should be dealt with. Thanks.


Curved field



Answer



This is what a Fourier approach could look like.


img = Import["http://i.stack.imgur.com/KfoXJ.png"];
gray = ColorConvert[RemoveAlphaChannel[img], "Grayscale"];
data = ImageData[gray];

ft = Fourier[data];
ft = RotateLeft[ft, Floor[Dimensions[ft]/2]];


ft // Abs // Log // Rescale // Image

Mathematica graphics


We're interested in the maximum of the Fourier transform, as this corresponds to the strongest frequency. However we're not interested in the frequency zero, so before we look for a maximum we blot out that frequency.


pos = Position[
Abs[ft],
Max[Abs[ft] (CenterArray[DiskMatrix[10], Dimensions[ft]] /. {0 -> 1, 1 -> 0})]
];


invft = InverseFourier[SparseArray[pos -> 1, Dimensions[ft]] ft];

invimg = invft // Abs // Rescale // Image;
ImageMultiply[invimg, img]

Mathematica graphics


It doesn't look like there's one line per path, it's more like one line on each side of each path. In any case these lines encapsulate at least some information about the paths and the rows of plants.


The position of a maximum gives the direction of a line that runs orthogonally to the rows:


ArcTan[207, 254] // N



0.886999



Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...