# 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.
Commented Dec 17, 2015 at 7:27
• – M.R.
Commented 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
Commented 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
Commented Dec 17, 2015 at 8:22
• Updates to questions are a mean for clarifying them, not for scope drifting Commented Dec 18, 2015 at 13:12

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


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