Return to Answer

added 249 characters in body

edited Apr 24, 2017 at 17:43

27.8k
4
69
183

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[imgImageValuePositions[Thinning[img], 1],  40];   DeleteSmallComponents[ ReplaceImageValue[ConstantImage[0, ImageDimensions[img]], newPos -> 1], 1]

Mathematica graphics

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

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[img, 1], 40]; ReplaceImageValue[ConstantImage[0, ImageDimensions[img]], newPos -> 1]

Mathematica graphics

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

Source Link

answered Apr 24, 2017 at 17:18

yode

27.8k
4
69
183

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

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[img, 1], 40]; ReplaceImageValue[ConstantImage[0, ImageDimensions[img]], newPos -> 1]

Mathematica graphics