1
$\begingroup$

We can convert a Graph into Graphics very easily like it is shown in this answer. My question is: how to convert a Graphics object into the original Graph from which it was created? Like the g1,g2 and g3 in the following:

SeedRandom[1]
g1 = Show[RandomGraph[{6, 10}]]
Head[g1]

enter image description here

Graphics
g2 = GraphPlot3D[{1 -> 2, 1 -> 3, 1 -> 4, 1 -> 5, 2 -> 3, 2 -> 4, 
   2 -> 5, 3 -> 4, 3 -> 5, 4 -> 5}]

enter image description here

g3 = GraphPlot[{1 -> 2, 2 -> 1, 3 -> 1, 3 -> 2, 4 -> 1, 4 -> 2, 
   4 -> 4}, VertexLabeling -> True, DirectedEdges -> True]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Interesting!Why I get so many close in such a valuable post? $\endgroup$ – yode Jun 6 '16 at 12:24
  • $\begingroup$ Your question as given can't be answered for the obvious reasons. You should probably ask something like: "How can I re-create the original Graph object from Graphics object into which that Graph was converted previously?" It would be a well-defined question. $\endgroup$ – Alexey Popkov Jun 6 '16 at 18:21
  • $\begingroup$ @AlexeyPopkov Actually I can't distinguish the difference between both.But I have changed it as what you suggest.I hope it will be more better post. :) $\endgroup$ – yode Jun 6 '16 at 18:32
  • $\begingroup$ I have edited your question in order to make it simpler and more clear. $\endgroup$ – Alexey Popkov Jun 6 '16 at 18:40
  • $\begingroup$ @AlexeyPopkov Thanks very very much. $\endgroup$ – yode Jun 6 '16 at 18:42
3
$\begingroup$

WOW! I made it!

Code first~

Graphics2Graph[g_] := 
 Module[{cd = 
    If[FreeQ[g, Line], 
     DirectedEdge @@@ (Extract[g, Position[g, Arrow[___]]] /. 
        Arrow[x_, ___] :> {First@x, Last@x}), 
     UndirectedEdge @@@ Extract[g, Position[g, Line[_]]][[1, 1]]]},
  Graph[cd, 
   VertexCoordinates -> 
    Extract[Extract[g, Position[g, GraphicsComplex[___]]][[1, 1]], 
     List /@ VertexList@Graph[cd]], VertexLabels -> "Name"]]

Graphics2Graph /@ {g1, g2, g3}

Well, the method of doing this is quite simple. After analyzed several Graph's FullForm, I realized that all the Graphics created are in the form of GraphicsComplex and all the useful information are stored in the form of either a great Line or several Arrow. The storage, fortunately, are in regular forms:

(*Line Form*)
Line[{{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, {3, 4}, {3, 5}, {4, 5}}]

(*Arrow Form*)
Arrow[{2,1}]
Arrow[{2,3,4,5,1}]
Arrow[{1,2},0.2]

Also, I found out that in one graph, only one form will be presented. So either a graph is totally presented by Line Form or totally presented by Arrow Form.

So the only thing I'll have to do is to find out all the Line Expression or Arrow Expression and properly convert them into styled forms. The code simply do this job with Position and Extract.

Seemingly this version do is wide-range supportive~ I've tried a few examples in Graph's documentation and it seems that this function works fine. Also the speed is quite high too~

$\endgroup$
  • $\begingroup$ Nice job and I found InputForm[DiscretizeGraphics[g2]] will get a very simple form.But we cann't macth it by Cases $\endgroup$ – yode Jun 8 '16 at 1:33
  • $\begingroup$ Try my method of Position and Extract $\endgroup$ – Wjx Jun 8 '16 at 1:35
  • $\begingroup$ I mean to process Graphics3D $\endgroup$ – yode Jun 8 '16 at 1:36
  • $\begingroup$ oh, alright. :) $\endgroup$ – Wjx Jun 8 '16 at 1:36
  • $\begingroup$ And SeedRandom[1] g1 = Show[Graph[RandomGraph[{6, 10}], VertexLabels -> "Name"]] Graphics2Graph[g1] seem to give some unexpected result?SeedRandom[1] g1 = Show[RandomGraph[{6, 10}]] Graphics2Graph[g1] will mix the direct or undirect? :) $\endgroup$ – yode Jun 8 '16 at 1:44
0
$\begingroup$

I made it with a non-perferct solution,but actually I don't content with it.I hope to get a general methond to do this rather than customized for every Graphics.

For g1

pos = Cases[Normal[g1], _Arrow, Infinity][[All, 1]];
rule = MapIndexed[Rule[#, First[#2]] &, 
   DeleteDuplicates@Catenate[pos]];
Graph[UndirectedEdge @@@ (pos /. rule), 
 VertexCoordinates -> Reverse /@ rule, VertexLabels -> "Name"]

The ordering of the vertices seem to been refined

For g2

data = Cases[g2, _GraphicsComplex, Infinity];
Graph3D[UndirectedEdge @@@ data[[1, 2, 1, 2, 1]], 
 VertexCoordinates -> data[[1, 1]], GraphStyle -> "SmallNetwork"]

For g3

pos = Through[{First, Last}[#]] & /@ 
   Cases[Normal[g3], _Arrow, Infinity][[All, 1]];
rule = MapIndexed[Rule[#, First[#2]] &, 
   DeleteDuplicates@Catenate[pos]];
Graph[DirectedEdge @@@ pos /. rule, 
 VertexCoordinates -> Reverse /@ rule, VertexLabels -> "Name"]

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.