How can I delineate the outline of a complex shape?

Question

I have a picture of a lake as follows:

And I want to delineate the outline of the lake. I binarized the picture and obtained img:

tmp = img // ImageCrop[#, {900, 1200}, Bottom] & // DeleteBorderComponents // ComponentMeasurements[#, "ConvexVertices"] &
data = Range[913] /. tmp

With the coordinate data I can:

Flatten[#, 1] &[data] // Graphics[Point[#]] &

And it looks like this:

However, I don't know how to join them up to a closed shape, and there are too many points outside my assumed ``outline". Is there any way to solve my problem? Thank you!

Edit: To make it clearer, I draw this schematic diagram.

Answer 1

Here is another method which utilizes the third argument of ComponentMeasurements.

At first we mark the key regions on the original image:

i = RemoveAlphaChannel@Import["https://i.sstatic.net/6RQTI.png"];
pointsOfInterest = {{516, 400}, {234, 231}, {426, 653}, {178, 489}};
Show[i, Epilog -> {Red, Disk[#, Offset[10]] & /@ pointsOfInterest}]

Then we select only components whose minimal bounding boxes include these points of interest:

m = MorphologicalComponents[
   ColorNegate@
    Closing[EdgeDetect[ColorSeparate[ColorConvert[i, "LAB"]][[1]], 3, .010], 4]];
comps = ComponentMeasurements[m, "MinimalBoundingBox", 
   Or @@ RegionMember[Polygon[{#}]][pointsOfInterest] &];
iC = Colorize[m, ColorRules -> Append[Thread[comps[[;; , 1]] -> White], _ -> Black]];
Show[HighlightImage[i, MorphologicalPerimeter@iC], 
 Graphics[{Text[#1, Total[#2]/4, Background -> Yellow], FaceForm[], EdgeForm[LightYellow],
      Polygon[{#2}]} & @@@ comps], Graphics[{White, Line[{{180, 532}, {197, 541}}]}]]

Then we find the perimeter of the lake:

HighlightImage[i, 
 MorphologicalPerimeter[FillingTransform@ColorNegate@Opening[ColorNegate@iC, 4]]]

The only problem with this solution is that the bridge is excluded from the perimeter. We can fix this manually:

HighlightImage[i, 
 MorphologicalPerimeter[
  FillingTransform@
   ColorNegate@
    Opening[ColorNegate@
      Rasterize[Show[iC, 
        Epilog -> {White, Polygon[{{180, 532}, {195, 467}, {219, 473}, {201, 542}}]}], 
       "Image"], 4]]]

Now the result is almost perfect.

Answer 2

i = RemoveAlphaChannel@Import["https://i.sstatic.net/6RQTI.png"];
m = MorphologicalComponents[
   ColorNegate@Closing[EdgeDetect[ColorSeparate[ColorConvert[i, "LAB"]][[1]], 3], 4]];
Colorize[m]

Let us find 5 largest components:

Reverse[SortBy[ComponentMeasurements[m, "Count"], Last]][[;; 5]]

{3 -> 298285, 1 -> 34737, 7 -> 24297, 60 -> 7285, 32 -> 3610}

By trial an error we find that we need components 3 and 7:

iC = Colorize[m, ColorRules -> {3 -> Black, 7 -> Black, _ -> White}]

iF = FillingTransform@ColorNegate@Opening[iC, 4]

Finding the perimeter of the lake:

perimeter = MorphologicalPerimeter[iF]

Overlay on the original image:

ImageAdd[i, perimeter]

The result isn't perfect but can serve as a good start.

Answer 3

I'm not completely sure that this is what you're looking for, but Closing might be the function you're after. Example:

DeleteSmallComponents[ColorNegate[Closing[EdgeDetect[img], 3]]]

Answer 4

Just post a simple scheme:

img = Import["https://i.sstatic.net/6RQTI.png"]

Get the edge

Highlight it and finish this work.

HighlightImage[img, line]