更改GraphPlot中的边缘路径以避免歧义

Question

我有以下无向图

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

我想用GraphPlot以'菱形'格式绘制.我这样做如下所述(方法1)给出以下内容:

问题是这种表示具有欺骗性,因为顶点4和1或1和5之间没有边缘(边缘是4到5).我希望改变边缘{4,5}的路线,得到如下内容:

我通过包含另一条边{5,4}来做到这一点,现在我可以使用MultiedgeStyle来"移动"有问题的边缘,然后通过定义EdgeRenderingFunction来消除添加的边缘,从而不显示有问题的线条.(方法2,'解决方法').至少可以说这很尴尬.有没有更好的办法？(这是我的第一个问题!)

方法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]

方法2(解决方法)

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

这是一个更尴尬的解决方法：

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]

当然，我所做的是获取FullForm图表的图形并对其进行编辑。GraphicsComplex我向（即{0., 2.}和）添加了几个点{4., 2.}，将一些新的腿放入线中（即{6, 8}, {8, 9}, {9, 7}）并删除了在顶点 4 和 5 之间绘制线的腿。

我并没有真正将其作为“解决方案”提供，但是比我有更多时间从事此工作的人应该能够编写一个函数来将 GraphicsComplex 操作为所需的形式。