11
$\begingroup$

I have a outline image

img=Uncompress[FromCharacterCode[
    Flatten[ImageData[Import["https://i.sstatic.net/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
Improve this question
$\endgroup$

5 Answers 5

Reset to default
11
$\begingroup$

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]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ Interesting results can also be obtained by directly doing Erosion[CurvatureFlowFilter[Dilation[img, 1], 10], 1]. $\endgroup$
    – user484
    Commented Apr 29, 2017 at 2:55
  • $\begingroup$ Wow,good solution, and easily to understand.Thanks very much.. $\endgroup$
    – yode
    Commented Apr 29, 2017 at 3:36
  • 2
    $\begingroup$ Or replace Rahul's CurvatureFlowFilter with PeronaMalikFilter[Binarize@filled, 10, 30] $\endgroup$
    – bill s
    Commented Apr 29, 2017 at 4:03
  • 2
    $\begingroup$ 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. $\endgroup$
    – bill s
    Commented Apr 30, 2017 at 15:55
  • 2
    $\begingroup$ @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. $\endgroup$
    – user484
    Commented May 11, 2017 at 18:04
4
$\begingroup$

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.

Improve this answer
$\endgroup$
9
  • $\begingroup$ 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 :) $\endgroup$
    – Rom38
    Commented Apr 24, 2017 at 8:09
  • $\begingroup$ 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. :) $\endgroup$
    – yode
    Commented Apr 24, 2017 at 8:58
  • $\begingroup$ @yode In this particular application the threshold 0.5 is fixed and hence you don't have to adjust it! $\endgroup$
    – Alexey Popkov
    Commented Apr 24, 2017 at 9:00
  • $\begingroup$ @yode I updated my answer with another method. $\endgroup$
    – Alexey Popkov
    Commented Apr 24, 2017 at 15:02
  • $\begingroup$ @Rahul Probably not. I can't reproduce my results using only Closing. If you can, please post an answer. $\endgroup$
    – Alexey Popkov
    Commented Apr 24, 2017 at 16:19
3
$\begingroup$

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]

Mathematica graphics     Mathematica graphics

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]

Mathematica graphics

Mathematica graphics

Improve this answer
$\endgroup$
0
3
$\begingroup$

Method1:

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

enter image description here

Improve this answer
$\endgroup$
1
$\begingroup$

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 = 
   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

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.