# How to get a smooth outline

I have a outline image

img=Uncompress[FromCharacterCode[
Flatten[ImageData[Import["https://i.sstatic.net/cc0Mt.png"],"Byte"]]]]

This is current method

pos = ImageValuePositions[img, 1];
newPos = Nest[Function[pts, Mean@*Rest /@ Nearest[pts, pts, 3]], pos, 50];
ReplaceImageValue[ConstantImage[0, ImageDimensions[img]], newPos -> 1]

And I don't know how to connect those pixels

Graphics[Line /@ Nearest[newPos, newPos, 3]]

There are two question in this code

• I's very slow for a big picture
• Hard to get a connected picture

CurvatureFlowFilter is great for smoothing binary images.

img = Uncompress[
FromCharacterCode[
Flatten[ImageData[Import["https://i.sstatic.net/nNRoa.png"],
"Byte"]]]];
filled = Colorize[
WatershedComponents[Dilation[img, 1], CornerNeighbors -> False],
ColorRules -> {1 -> White, 2 -> White, 3 -> White,
4 -> White, _ -> Black}];
MorphologicalPerimeter@
Binarize@CurvatureFlowFilter[Binarize@filled, 10]

• Interesting results can also be obtained by directly doing Erosion[CurvatureFlowFilter[Dilation[img, 1], 10], 1].
– user484
Commented Apr 29, 2017 at 2:55
• Wow,good solution, and easily to understand.Thanks very much..
– yode
Commented Apr 29, 2017 at 3:36
• Or replace Rahul's CurvatureFlowFilter with PeronaMalikFilter[Binarize@filled, 10, 30] Commented Apr 29, 2017 at 4:03
• Rahul -- they both attack the same problem (smoothing of curves) in a similar way (by solving a differential equation). The difference is in the specific DEs chosen and in the properties of that DE. From an implementation perspective, I would suggest trying them both. Commented Apr 30, 2017 at 15:55
• @bills: I know that they are different, I was hoping you could say something about how they are different and/or in what circumstances you might prefer one over the other. My understanding is that on binary images, CurvatureFlowFilter is always more appropriate and gives reliably better results than PeronaMalikFilter. I'd be grateful to see an example of a binary image where PeronaMalikFilter performs better, so that I can revise my understanding.
– user484
Commented May 11, 2017 at 18:04

## Blur & Binarize

One way is to Blur and then Binarize with threshold exactly 0.5 (no need to adjust!):

MorphologicalTransform[Binarize[Blur[FillingTransform[Closing[img, 1]], 5], 0.5], "Remove"]

(In some cases (but not in this case) applying Blur twice can give better results:

MorphologicalTransform[
Binarize[Blur[Blur[FillingTransform[Closing[img, 1]], 3], 4], .5], "Remove"]

)

If further smoothing is needed, one can apply this method separately to each component of the image using one of the methods from this thread:

i = Closing[img, 1];
"BoundingBox"}];

smoothComponent[img_, n_] :=
Binarize[Blur[ImagePad[FillingTransform[ColorNegate@img], n], n], 0.5], "Remove"], -n];

smoothAllComponents[cm_, n_] := Module[{newComps, iW, iH},
newComps = smoothComponent[#, n] & /@ cm[[;; , 2, 1]];
{iW, iH} = ImageDimensions@i;
Image[Total[
Table[SparseArray[
Band[1 + Round@{iH - #[[2, 2]], #[[1, 1]]} &@cm[[i, 2, 2]]] ->
ImageData[newComps[[i]]], {iH, iW}], {i, Length[cm]}]]]];

Table[s[cm, n], {n, 20}]

## Dilation & Thinning

cm = ComponentMeasurements[img, "Image"];

4, .5}]

Applying to each of the components individually:

i = Closing[img, 1];
"BoundingBox"}];

smoothAllComponents[cm_, n_] := Module[{newComps, iW, iH},
newComps = smoothComponent[#, n] & /@ cm[[;; , 2, 1]];
{iW, iH} = ImageDimensions@i;
Image[Total[
Table[SparseArray[
Band[1 + Round@{iH - #[[2, 2]], #[[1, 1]]} &@cm[[i, 2, 2]]] ->
ImageData[newComps[[i]]], {iH, iW}], {i, Length[cm]}]]]];

Table[s[cm, n], {n, 20}]

It is easy to check that the output is identical to the one obtained in the previous section.

• I guess, the best way to have a principally smooth contours is usage of MorphologicalComponents for separation of separated contours and following interpolation of their points after re-ordering as sequence from one to the nearest.. But Alexey's method is much easy :) Commented Apr 24, 2017 at 8:09
• I always avoid to use those threshold value in a real solution too much,it will make the code be in low applicability.Anyway,thanks for show the Blur+Binarize. :)
– yode
Commented Apr 24, 2017 at 8:58
• @yode In this particular application the threshold 0.5 is fixed and hence you don't have to adjust it! Commented Apr 24, 2017 at 9:00
• @yode I updated my answer with another method. Commented Apr 24, 2017 at 15:02
• @Rahul Probably not. I can't reproduce my results using only Closing. If you can, please post an answer. Commented Apr 24, 2017 at 16:19

For what it's worth, here's Simon Woods' approach from How to create a new "person curve"?

param[x_, m_, t_] :=
Module[{f, n = Length[x], nf},
f = Chop[Fourier[x]][[;; Ceiling[Length[x]/2]]];
nf = Length[f];
Total[(2 Abs[f]/Sqrt[n] Sin[
Pi/2 - Arg[f] + 2. Pi Range[0, nf - 1] t])[[;; Min[m, nf]]]]];

tocurve[Line[data_], m_, t_] := param[#, m, t] & /@ Transpose[data];

OP's example:

img = Uncompress[
FromCharacterCode[
Flatten[ImageData[Import["https://i.sstatic.net/cc0Mt.png"],
"Byte"]]], HoldComplete];
img = ReleaseHold@img

pts0 = PixelValuePositions[img, 1];
paths = FindCurvePath@pts0;
pts = pts0[[#]] & /@ paths;
pp = MapThread[ (* parametrized paths *)
tocurve[Line[#1], #2, t] &,
{pts,
Max[#, 4] & /@ Round[(Length /@ pts)/12] (* no. of modes - controls smoothing *)}
];
pp = pp - (pp /. _Sin -> 0) + (Mean /@ pts);
plot = ParametricPlot[pp, {t, 0, 1}, Frame -> True]
Show[img, plot]

Another example (from original question):

img0 = Import["https://i.sstatic.net/myVKd.png"];
img2 = Thinning@Binarize[img0, 0.05]

pts0 = PixelValuePositions[img2, 1];
paths = Rest@FindCurvePath@pts0; (* remove boundary *)
pts = pts0[[#]] & /@ paths;
pp = MapThread[ (* parametrized paths *)
tocurve[Line[#1], #2, t] &,
{pts,
Max[#, 4] & /@ Round[(Length /@ pts)/12](* no. of modes - controls smoothing *)}
];
pp = pp - (pp /. _Sin -> 0) + (Mean /@ pts);
plot = ParametricPlot[pp, {t, 0, 1}, Frame -> True]
Show[img2, plot]

Method1:

meshes =
ConnectedMeshComponents@
ImageMesh@
CurvatureFlowFilter[FillingTransform@Dilation[img, 1], 10];
Graphics[
BSplineCurve[MeshPrimitives[#, 0][[All, 1]],
SplineClosed -> True] & /@ meshes]

Not perfect,but almost.I solve the disconnected problem in original post and it is slow still..

img = Uncompress[FromCharacterCode[
Flatten[ImageData[Import["https://i.sstatic.net/cc0Mt.png"],"Byte"]]]]

findMeanPoint[pos_] :=
Module[{firstPoint, pairDir, secondPoint},
firstPoint = Nearest[pos, pos, 2];
pairDir =