# How to do edge detection in Mathematica?

I have some pictures of water level and I want to do edge detection, I used the following command, but this command is vertical edge detection and I want horizontal edge detection and water level. Thank you for your guidance.

use three image: full, medium, empty

ImageLines will be troublesome on this processing especially for the "empty" image where many horizontal lines can be found and ranked nearly equivalently. I suggest attempting to determine the level using the colorshift that is very evident in the "medium" image.

data = ImageData[img2];
Dimensions[data]
Total[data[[All, -20 ;;, 3]]\[Transpose]] // ListPlot


The transition is clearly at ~780 pixels which can be 205 mm?

For the "empty" image

data = ImageData[img3];
Dimensions[data]
Total[data[[All, -20 ;;, 3]]\[Transpose]] // ListPlot


Essentially no transition is observed.

For the "full" image processing is more channeling due to the reflections off of the fluid surface. A polarizer and controlled lighting may help in this case. Otherwise one may consider the first "transition" to be the level.

data = ImageData[img1];
Dimensions[data]
Total[data[[All, -20 ;;, 3]]\[Transpose]] // ListPlot


Transition at 80 pixels = ~472 mm?

• Thank you for your help, but I want to import these images into the model, so I need to make changes to the images. Commented Sep 6, 2023 at 4:03

Edited to use the new "empty" image

I would start by converting images to greyscale:

greyimgs = Table[ColorConvert[i, "Grayscale"], {i, imgs}]


Then taking strips from the right-hand side, to avoid the ruler:

strips = Table[d = ImageDimensions[i];
ImageTake[i, {1, d[[2]]}, {-50, d[[1]]}], {i, greyimgs}]


Binarize, using a threshold a bit lower than the average of the first row of pixels:

binstrips =
Table[abovewatergrey = Mean[ImageData[i][[1]]];
Binarize[i, abovewatergrey - .2], {i, strips}]


Find edges in the binarized images:

edges = Table[EdgeDetect[i, 50], {i, binstrips}]


Get column-averaged line profiles from the edge detection (reversing to account for coordinate system of images)

profiles = Table[Reverse[Mean /@ ImageData[i] // N], {i, edges}];

ListLinePlot[profiles, PlotLegends -> {"Full", "Medium", "Empty"}]


Find the maximum of the profiles (used Mean in case there is not a unique maximium):

maxpos =
Flatten@Table[Round[Mean[Position[p, Max[p]]]], {p, profiles}]


{912, 231, 78}

Table[HighlightImage[
imgs[[n]], {Thick,
Line[{{0, maxpos[[n]]}, {ImageDimensions[imgs[[n]]][[1]],
maxpos[[n]]}}]}], {n, Length[imgs]}]


With adjustments to optimize the "empty", the "full" no longer looks correct.

Here is another possible method:

strips2 =
Table[d = ImageDimensions[i];
ImageTake[i, {1, d[[2]]}, {-50, d[[1]]}], {.5, 0, 1}, {Automatic,
Automatic}], {i, greyimgs}]


This is what the column-averaged profiles look like:

stripprofiles = (Mean /@ ImageData[#]) & /@ strips2;
ListLinePlot[stripprofiles]


To see where the profiles first dip precipitously, get a rolling difference between moving averages:

moving = Table[m = MovingAverage[p, 5];
Table[m[[n - 1]] - m[[n]], {n, 2, Length[m]}]
, {p, stripprofiles}];

ListLinePlot[moving, PlotRange -> All]


Find the first peak (sensitive to adjustment of the threshold value (0.005 here))

firstpeaks =
First[Flatten[Position[PeakDetect[#, 0, 0, .005], 1]]] & /@ moving


{82, 762, 1128}

Table[
dim = ImageDimensions[imgs[[n]]];
HighlightImage[
imgs[[n]], {Thick,
Line[{{0, dim[[2]] - firstpeaks[[n]]}, {dim[[1]],
dim[[2]] - firstpeaks[[n]]}}]}], {n, Length[imgs]}]


• Thank you for the help, but the image related to the empty one is recognized as an error, if it can be improved, it will be better Commented Sep 6, 2023 at 4:46
• @Erfan do you mean that the empty one should have no water line at all? Commented Sep 6, 2023 at 5:02
• The line should be placed very low because it is the measuring standard of that line Commented Sep 6, 2023 at 5:49
• Empty's picture was updated Commented Sep 6, 2023 at 6:30
• @Erfan I edited the answer Commented Sep 7, 2023 at 2:38