6
$\begingroup$

I got a picture like this, and what I want to do is to extract lines from the picture.

borrenan

what I have done now is 

img = Import["http://euler.nmt.edu/mathwiki/images/e/ef/Borromean.png"] PixelValuePositions[img, Blue, 0.5] // Point // Graphics

from which I get a list of positions of the blue curve like this:

enter image description here

so my question is , how do I get a Line from the postion data I get above? what I want to get is not a circle function, but a list of points in good order.

Improve this question
$\endgroup$
4
  • $\begingroup$ I'm not clear what you're asking - the result of PixelValuePositions is a list of positions of the "points". $\endgroup$ Commented Mar 5, 2014 at 9:19
  • $\begingroup$ Vectorize the image first to PDF for example via online.rapidresizer.com, then import that to Mma. $\endgroup$ Commented Mar 5, 2014 at 9:55
  • $\begingroup$ @rasher,but with PixelValuePositions I get a list of unordering points, what I want is like this Line[{p1,p2...pn}] $\endgroup$ Commented Mar 5, 2014 at 10:34
  • 1
    $\begingroup$ @tintin FindCurvePath can make the ordering. $\endgroup$ Commented Mar 5, 2014 at 10:59

2 Answers 2

Reset to default
7
$\begingroup$

There are over 2700 points and because they fill out a thick region, there is no real order to them. It seems to me to get a single line, one would want to approximate the image by lines first. One way is to use Thinning.

img = Import["http://euler.nmt.edu/mathwiki/images/e/ef/Borromean.png"]; comp = MorphologicalComponents @ Thinning[ColorNegate @ Binarize[img]]; splice[{list1_?VectorQ, list2_?VectorQ}] /; First@list1 == First@list2 := Join[Reverse@list1, Rest@list2]; splice[lists_] := Join @@ lists; Graphics[ Table[ {Hue[c/6 - 0.1], With[{pos = Position[comp, c]}, Line[pos[[ splice @ FindCurvePath[pos] ]]]]}, {c, 6}] ]

Mathematica graphics

Update: It happens in this case that FindCurvePath splits the first three lines into two components with the same starting point; the fourth into two disjoint components; and the rest are just one line. When I first posted, I had forgotten to check all of them. The update fixes how they are spliced together. Some smoothing may obtained by skipping some points:

splice[FindCurvePath[pos]] ~Part~ (3 ;; -3 ;; 3)

Mathematica graphics

Another way is to fit a circle:

circle = FindFit[ Transpose[Append[Transpose[#], ConstantArray[0, Length @ #]]] &@ PixelValuePositions[img, Blue, 0.5], (x - a)^2 + (y - b)^2 - r^2, {a, b, r}, {x, y}] (* {a -> 95.864, b -> 97.5503, r -> 89.9539} *) Graphics[{ PixelValuePositions[img, Blue, 0.5] // Point, Red, Circle[{a, b}, r] /. circle }]

Mathematica graphics

One can use the circle data to generate a Line if desired.

There is also the methods found in Derive a smooth circle with cusp from an image

Improve this answer
$\endgroup$
3
  • $\begingroup$ thanks so much, the first part is exactly what I want $\endgroup$ Commented Mar 5, 2014 at 12:43
  • $\begingroup$ @tintin You're welcome and thanks for the accept. You might be interested the modification I made, which I think is an improvement. $\endgroup$ Commented Mar 5, 2014 at 13:42
  • $\begingroup$ nice answer, nice update, it works $\endgroup$ Commented Mar 5, 2014 at 16:04
3
$\begingroup$

Without going to morphological manipulations, a quick way that might get you what you need (it's not super clear in the op) might be (uses the second image in your question in img2):

Needs["ComputationalGeometry`"] pp = PixelValuePositions[img2, Black, 0.5]; curvelines = pp[[ConvexHull[pp, AllPoints -> True]]]; Graphics[{Line[curvelines]}]

enter image description here

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.