17
$\begingroup$

I have a picture like this

enter image description here

I can get this graph's vertexes

mor = MorphologicalBinarize[img // ColorNegate] // DeleteSmallComponents // ColorNegate // MorphologicalComponents; selectmor = SelectComponents[ mor, {"AreaRadiusCoverage", "Count"}, # > 0.78 && #2 < 1000 &] // Image; mask = Graphics@ Point@ComponentMeasurements[selectmor, "Centroid"][[All, 2]]

enter image description here

Or get its edges

fillimg = FillingTransform[ MorphologicalBinarize[img // ColorNegate] // DeleteSmallComponents // Thinning // Pruning, selectmor // Binarize] // Thinning // Pruning; lines = ImageLines[fillimg, MaxFeatures -> 200, Method -> {"Hough", "Segmented" -> True}]; Graphics[{Thick, Red, Line /@ lines}]

enter image description here

This my current work. May be you can realize it by more smart method. My target is not a Image but a Graph. So how to rebuild the Graph by this vertex and this edge?

Update: After the M.R.'s comments (Thanks for your comment), we can use the MorphologicalGraph to get the embryo of graph.

fillimg // MorphologicalGraph[#, VertexLabels -> "Name"] &

enter image description here

But it have a low precision. So How to refine it?

Improve this question
$\endgroup$
10
  • 1
    $\begingroup$ This has been asked before I believe, check out this answer: mathematica.stackexchange.com/questions/6774/… $\endgroup$ Commented Dec 17, 2015 at 7:27
  • $\begingroup$ And mathematica.stackexchange.com/questions/8935/… $\endgroup$ Commented Dec 17, 2015 at 7:28
  • 1
    $\begingroup$ @M.R. Thanks for your MorphologicalGraph in your link.But its precision is very poor when I try to do it.It will introduce many superfluous vertex. $\endgroup$ Commented Dec 17, 2015 at 8:19
  • 2
    $\begingroup$ @M.R. After I read all your related links,I think this problem is a essential question still. $\endgroup$ Commented Dec 17, 2015 at 8:22
  • $\begingroup$ Updates to questions are a mean for clarifying them, not for scope drifting $\endgroup$ Commented Dec 18, 2015 at 13:12

1 Answer 1

Reset to default
22
$\begingroup$ 
i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vxPos = ComponentMeasurements[vertexI, "Centroid"]; lines = Subsets[Range@Length@vxPos, {2}]; linePos = lines /. vxPos; ti@x_ := Total@Flatten@ImageData@Binarize@x p = Position[ti@i - ti@Show[i, Graphics@Line@#] & /@ linePos, x_ /; x < 100]; Graphics[{Red, Line[Extract[linePos, p]]}]

Mathematica graphics

Graph[Range@Length@vxPos, UndirectedEdge @@@ Extract[lines, p], VertexLabels -> "Name", ImagePadding -> 20, VertexCoordinates -> vxPos]

Mathematica graphics

Improve this answer
$\endgroup$
12
  • 5
    $\begingroup$ Congratulations to your doctorate $\endgroup$ Commented Dec 17, 2015 at 14:39
  • 1
    $\begingroup$ @eldo You, you may say. I'm a dreamer, but I'm not the only one :) $\endgroup$ Commented Dec 17, 2015 at 14:43
  • $\begingroup$ Bash-wise: Does that mean all Drs are evil dark lords? The helmet fits your avatar perfectly :D $\endgroup$ Commented Dec 17, 2015 at 14:52
  • 3
    $\begingroup$ Getting a Ph.D. made me finally realise how truly useless titles are, and how much unnecessary trouble it causes trying to choose the right one for oneself and others in different situations. Now I never use any at all. $\endgroup$ Commented Dec 17, 2015 at 21:27
  • 1
    $\begingroup$ @Oleksandr youtube.com/watch?v=gdi3FIrsHgo $\endgroup$ Commented Dec 22, 2015 at 22:26

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.