11

I have a outline image

img=Uncompress[FromCharacterCode[
    Flatten[ImageData[Import["https://i.stack.imgur.com/cc0Mt.png"],"Byte"]]]]

Mathematica graphics

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]

Mathematica graphics

And I don't know how to connect those pixels

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

Mathematica graphics

There are two question in this code

  • I's very slow for a big picture
  • Hard to get a connected picture
Alexey Popkov
  • 61,809
  • 7
  • 149
  • 368
yode
  • 26,686
  • 4
  • 62
  • 167

5 Answers5

11

CurvatureFlowFilter is great for smoothing binary images.

img = Uncompress[
  FromCharacterCode[
   Flatten[ImageData[Import["https://i.stack.imgur.com/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]

enter image description here

  • Interesting results can also be obtained by directly doing Erosion[CurvatureFlowFilter[Dilation[img, 1], 10], 1]. –  Apr 29 '17 at 02:55
  • Wow,good solution, and easily to understand.Thanks very much.. – yode Apr 29 '17 at 03:36
  • 2
    Or replace Rahul's CurvatureFlowFilter with PeronaMalikFilter[Binarize@filled, 10, 30] – bill s Apr 29 '17 at 04:03
  • @bills: Can you say something about the difference between CurvatureFlowFilter and PeronaMalikFilter? –  Apr 30 '17 at 15:33
  • 2
    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. – bill s Apr 30 '17 at 15:55
  • 2
    @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. –  May 11 '17 at 18:04
  • @bills Still waiting for an example of a binary image on which PeronaMalikFilter does better than CurvatureFlowFilter (in whatever sense you had in mind). –  Jan 20 '18 at 02:48
4

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"]

output

(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];
cm = ComponentMeasurements[{MorphologicalComponents[i], ColorNegate@i}, {"MaskedImage", 
    "BoundingBox"}];

smoothComponent[img_, n_] := 
  ImagePad[MorphologicalTransform[
    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}]

output


Dilation & Thinning

cm = ComponentMeasurements[img, "Image"];

Table[ColorNegate@ImagePad[Thinning[Dilation[ImagePad[cm[[2, 2]], r], r]], -r], {r, 1, 
  4, .5}]

output

Applying to each of the components individually:

i = Closing[img, 1];
cm = ComponentMeasurements[{MorphologicalComponents[i], ColorNegate@i}, {"MaskedImage", 
    "BoundingBox"}];

smoothComponent[img_, r_] := ImagePad[Thinning[Dilation[ImagePad[img, r], r]], -r];

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}]

output

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

Alexey Popkov
  • 61,809
  • 7
  • 149
  • 368
  • 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 :) – Rom38 Apr 24 '17 at 08: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 Apr 24 '17 at 08:58
  • @yode In this particular application the threshold 0.5 is fixed and hence you don't have to adjust it! – Alexey Popkov Apr 24 '17 at 09:00
  • @yode I updated my answer with another method. – Alexey Popkov Apr 24 '17 at 15:02
  • @Rahul Probably not. I can't reproduce my results using only Closing. If you can, please post an answer. – Alexey Popkov Apr 24 '17 at 16:19
  • +1).Thanks again,but the new method just can process one component one time?Well,I feel guilty,it's seem I always have some further request. – yode Apr 24 '17 at 17:21
  • @yode Yes, one component on time. But it could be automatized. – Alexey Popkov Apr 24 '17 at 17:22
  • @yode Actually the first method also must be restricted to one component if you need further smoothing... – Alexey Popkov Apr 24 '17 at 17:23
  • I have reduced the requirement,if you have seen the old version of this post,It has many components.I afraid it too hard to request an answer,so I have simplified it. – yode Apr 24 '17 at 17:30
3

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.stack.imgur.com/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]

Mathematica graphics     Mathematica graphics

Another example (from original question):

img0 = Import["https://i.stack.imgur.com/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]

Mathematica graphics

Mathematica graphics

Michael E2
  • 235,386
  • 17
  • 334
  • 747
3

Method1:

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

enter image description here

HyperGroups
  • 8,619
  • 1
  • 26
  • 63
1

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.stack.imgur.com/cc0Mt.png"],"Byte"]]]]

findMeanPoint[pos_] := 
 Module[{firstPoint, pairDir, secondPoint}, 
  firstPoint = Nearest[pos, pos, 2];
  pairDir = 
   Dispatch[Thread[pos -> Normalize@*Subtract @@@ firstPoint]];
  secondPoint = 
   Last /@ Nearest[pos, pos, 2, 
     DistanceFunction -> (If[Equal@##, 0, 
         Rescale[Abs[VectorAngle[#1 /. pairDir, #2 - #1]], {0, 
            Pi}, {.1, 2}]*EuclideanDistance[##]] &)];
  MapThread[Mean@*Prepend, {firstPoint, secondPoint}]]
newPos = Nest[findMeanPoint, ImageValuePositions[Thinning[img], 1], 
   40];

DeleteSmallComponents[
 ReplaceImageValue[ConstantImage[0, ImageDimensions[img]],newPos -> 1], 1]

Mathematica graphics

yode
  • 26,686
  • 4
  • 62
  • 167