# How to generate a Graph from a picture of a graph?

I have a picture like this

I can get this graph's vertexes

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


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


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


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

• This has been asked before I believe, check out this answer: mathematica.stackexchange.com/questions/6774/…
– M.R.
Dec 17, 2015 at 7:27
• – M.R.
Dec 17, 2015 at 7:28
• @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.
– yode
Dec 17, 2015 at 8:19
• @M.R. After I read all your related links,I think this problem is a essential question still.
– yode
Dec 17, 2015 at 8:22
• Updates to questions are a mean for clarifying them, not for scope drifting Dec 18, 2015 at 13:12

i       = Binarize@Import["http://i.stack.imgur.com/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]]}]


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


– eldo
Dec 17, 2015 at 14:39
• Dec 17, 2015 at 14:43
• Bash-wise: Does that mean all Drs are evil dark lords? The helmet fits your avatar perfectly :D Dec 17, 2015 at 14:52
• 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. Dec 17, 2015 at 21:27
• @Oleksandr youtube.com/watch?v=gdi3FIrsHgo Dec 22, 2015 at 22:26