Changing the border route in GraphPlot to avoid ambiguity

Question

I have the following undirected graph

gr={1->2,1->3,1->6,1->7,2->4,3->4,4->5,5->6,5->7}; 

which I want to build with GraphPlot in diamond format. I do this as follows (Method 1), giving the following:

The problem is that this representation is misleading, since there is no edge between the vertices 4 and 1 or 1 and 5 (an edge from 4 to 5). I want to change the edge path of {4,5} to get something like the following:

I do this by including another edge, {5,4}, and now I can use MultiedgeStyle to “move” the offending edge, and then I get rid of the added edge by defining the EdgeRenderingFunction without displaying the offending line. (Method 2, "Workaround"). This is inconvenient, to say the least. Is there a better way? (This is my first question!)

Method 1

 gr={1->2,1->3,1->6,1->7,2->4,3->4,4->5,5->6,5->7}; vcr={1-> {2,0},2-> {1,1},3-> {1,-1},4-> {0,0},5-> {4,0},6-> {3,1},7-> {3,-1}}; GraphPlot[gr,VertexLabeling-> True, DirectedEdges-> False, VertexCoordinateRules-> vcr, ImageSize-> 250] 

Method 2 (workaround)

 erf= (If[MemberQ[{{5,4}},#2], { }, {Blue,Line[#1]} ]&); gp[1] = GraphPlot[ Join[{5->4},gr], VertexLabeling->True, DirectedEdges->False, VertexCoordinateRules->vcr, EdgeRenderingFunction->erf, MultiedgeStyle->.8, ImageSize->250 ] 

Answer 1

Just kickstart

It is further determined whether there is an edge that “touches” a vertex that is not one of its endpoints.

It works only for direct lines.

The plan uses it as a first step, and then creates a layout, as in method 2 published in the question.

Uses another answer that I posted here.

 Clear["Global`*"]; gr = {1 -> 2, 1 -> 3, 1 -> 6, 1 -> 7, 2 -> 4, 3 -> 4, 4 -> 5, 5 -> 6, 5 -> 7}; vcr = {1 -> {2, 0}, 2 -> {1, 1}, 3 -> {1, -1}, 4 -> {0, 0}, 5 -> {4, 0}, 6 -> {3, 1}, 7 -> {3, -1}}; a = InputForm@GraphPlot[gr, VertexLabeling -> True, DirectedEdges -> False, VertexCoordinateRules -> vcr, ImageSize -> 250] ; distance[segmentEndPoints_, pt_] := Module[{c, d, param, start, end}, start = segmentEndPoints[[1]]; end = segmentEndPoints[[2]]; param = ((pt - start).(end - start))/Norm[end - start]^2; Which[ param < 0, EuclideanDistance[start, pt], param > 1, EuclideanDistance[end, pt], True, EuclideanDistance[pt, start + param (end - start)] ] ]; edgesSeq= Flatten[Cases[a//FullForm, Line[x_] -> x, Infinity], 1]; vertex=Flatten[ Cases[a//FullForm,Rule[VertexCoordinateRules, x_] -> x,Infinity] ,1]; Off[General::pspec]; edgesPos = Replace[edgesSeq, {i_, j_} -> {vertex[[i]], vertex[[j]]}, 1]; On[General::pspec]; numberOfVertexInEdge = Count[#, 0, 2] & /@ Table[ Chop@distance[segments, vertices], {segments, edgesPos}, {vertices, vertex} ]; If[Length@Select[numberOfVertexInEdge, # > 2 &] > 0, "There are Edges crossing a Vertex", "Graph OK"] 

Answer 2

Here's an even more inconvenient workaround:

 Graphics[Annotation[GraphicsComplex[{{2., 0.}, {1., 1.}, {1., -1.}, {3., 1.}, {3., -1.}, {0., 0.}, {4., 0.}, {0., 2.}, {4., 2.}}, {{RGBColor[0.5, 0., 0.], Line[{{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 6}, {3, 6}, {7, 4}, {7, 5}, {6, 8}, {8, 9}, {9, 7}}]}, {Text[Framed[1, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 1], Text[Framed[2, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 2], Text[Framed[3, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 3], Text[Framed[6, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 4], Text[Framed[7, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 5], Text[Framed[4, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 6], Text[Framed[5, {Background -> RGBColor[1, 1, 0.8], FrameStyle -> RGBColor[0.94, 0.85, 0.36], FrameMargins -> Automatic}], 7]}}, {}], VertexCoordinateRules -> {{2., 0.}, {1., 1.}, {1., -1.}, {3., 1.}, {3., -1.}, {0., 0.}, {4., 0.}}], FrameTicks -> None, PlotRange -> All, PlotRangePadding -> Scaled[0.1], AspectRatio -> Automatic, ImageSize -> 250] 

Of course, what I did was taken FullForm graphics graphics and edited. I added a couple of points to GraphicsComplex (ie {0., 2.} and {4., 2.} ), put a few new legs on the line (ie {6, 8}, {8, 9}, {9, 7} ) and removed the leg that drew a line between vertices 4 and 5.

I really do not propose this as a “solution”, but someone with more time than I should work on it should be able to write a function to manipulate GraphicsComplex in the right form.