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

deleted 60 characters in body

edited Dec 17, 2015 at 19:54

116.8k
13
208
466

i  = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI  = SelectComponents[i, "Count", 10 < # < 100 &]; vertexposvxPos  = ComponentMeasurements[vertexI, "Centroid"][[All, 2]];"Centroid"]; templatelines  = Subsets[Range@Length@vertexposSubsets[Range@Length@vxPos, {2}]; lines linePos = Subsets[vertexpos,lines {2}];/. vxPos; ti@x_  := Total@Flatten@ImageData@Binarize@x p = Position[ti@i - ti@Show[i, Graphics@Line@#] & /@ lineslinePos, x_ /; x < 100]; Show[Graphics[Graphics[{Red, Line[#]}] & /@ Extract[linesLine[Extract[linePos, p]]}]

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

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

deleted 36 characters in body

Source Link

edited Dec 17, 2015 at 17:57

Dr. belisarius

116.8k
13
208
466

i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vertexpos = ComponentMeasurements[vertexI, "Centroid"][[All, 2]]; template = Subsets[Range@Length@vertexpos, {2}]; lines = Subsets[vertexpos, {2}]; ti = Composition[Total, Flatten, ImageData, Binarize]; t1 ti@x_ := ti@i;Total@Flatten@ImageData@Binarize@x p = Position[t1Position[ti@i - ti@Show[i, Graphics@Line@#] & /@ lines, x_ /; x < 100]; Show[Graphics[{Red, Line[#]}] & /@ Extract[lines, p]]

Mathematica graphics

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

Mathematica graphics

i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vertexpos = ComponentMeasurements[vertexI, "Centroid"][[All, 2]]; template = Subsets[Range@Length@vertexpos, {2}]; lines = Subsets[vertexpos, {2}]; ti = Composition[Total, Flatten, ImageData, Binarize]; t1  = ti@i; p = Position[t1 - ti@Show[i, Graphics@Line@#] & /@ lines, x_ /; x < 100]; Show[Graphics[{Red, Line[#]}] & /@ Extract[lines, p]]

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

added 21 characters in body

Source Link

edited Dec 17, 2015 at 17:36

Dr. belisarius

116.8k
13
208
466

i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vertexpos = ComponentMeasurements[vertexI, "Centroid"][[All, 2]]; template = Subsets[Range@Length@vertexpos, {2}]; lines = Subsets[vertexpos, {2}]; ti = Composition[Total, Flatten, ImageData, Binarize]; t1 = ti@i;  p = Position[ti@iPosition[t1 - ti@Show[i, Graphics@Line@#] & /@ lines, x_ /; x < 100]; Show[Graphics[{Red, Line[#]}] & /@ Extract[lines, p]]

Mathematica graphics

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

Mathematica graphics

i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vertexpos = ComponentMeasurements[vertexI, "Centroid"][[All, 2]]; template = Subsets[Range@Length@vertexpos, {2}]; lines = Subsets[vertexpos, {2}]; ti = Composition[Total, Flatten, ImageData, Binarize]; p = Position[ti@i - ti@Show[i, Graphics@Line@#] & /@ lines, x_ /; x < 100]; Show[Graphics[{Red, Line[#]}] & /@ Extract[lines, p]]

Mathematica graphics

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

Mathematica graphics

i = Binarize@Import["https://i.sstatic.net/qofeF.png"]; vertexI = SelectComponents[i, "Count", 10 < # < 100 &]; vertexpos = ComponentMeasurements[vertexI, "Centroid"][[All, 2]]; template = Subsets[Range@Length@vertexpos, {2}]; lines = Subsets[vertexpos, {2}]; ti = Composition[Total, Flatten, ImageData, Binarize]; t1 = ti@i;  p = Position[t1 - ti@Show[i, Graphics@Line@#] & /@ lines, x_ /; x < 100]; Show[Graphics[{Red, Line[#]}] & /@ Extract[lines, p]]

Mathematica graphics

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

Mathematica graphics

added 1 character in body

Source Link

edited Dec 17, 2015 at 17:06

Dr. belisarius

116.8k
13
208
466

Loading

deleted 17 characters in body

Source Link

edited Dec 17, 2015 at 16:39

Dr. belisarius

116.8k
13
208
466

Loading

deleted 17 characters in body

Source Link

edited Dec 17, 2015 at 16:20

Dr. belisarius

116.8k
13
208
466

Loading

deleted 5 characters in body

Source Link

edited Dec 17, 2015 at 15:58

Dr. belisarius

116.8k
13
208
466

Loading

deleted 5 characters in body

Source Link

edited Dec 17, 2015 at 15:48

Dr. belisarius

116.8k
13
208
466

Loading

added 108 characters in body

Source Link

edited Dec 17, 2015 at 14:53

Dr. belisarius

116.8k
13
208
466

Loading

added 108 characters in body

Source Link

edited Dec 17, 2015 at 14:50

Dr. belisarius

116.8k
13
208
466

Loading

deleted 88 characters in body

Source Link

edited Dec 17, 2015 at 14:34

Dr. belisarius

116.8k
13
208
466

Loading

added 124 characters in body

Source Link

edited Dec 17, 2015 at 14:26

Dr. belisarius

116.8k
13
208
466

Loading

added 110 characters in body

Source Link

edited Dec 17, 2015 at 14:20

Dr. belisarius

116.8k
13
208
466

Loading

Source Link

answered Dec 17, 2015 at 14:09

Dr. belisarius

116.8k
13
208
466

Loading

Stack Exchange Network

Return to Answer