在GraphPlot中更改边缘路线以避免歧义
我有以下无向图
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
]
只是一个kickstart
以下检测是否存在“触及”不是其端点之一的顶点的边。
它现在只适用于直线边缘。
该计划将其作为第一步，然后在问题中发布的方法2中创建模拟边缘。
使用我在这里发布的另一个答案。
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"]
这是一个更尴尬的解决方法：
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操作为所需的形式。
链接地址: http://www.djcxy.com/p/3425.html上一篇: Changing the Edge Route in GraphPlot to Avoid Ambiguity