在GraphPlot中标记边缘

Question

我正在尝试使用p上的示例来动画离散时间马尔可夫链的演化。 30 Kleinrock v.1。这非常有效：

p = {
 {0, 3/4, 1/4},
 {1/4, 0, 3/4},
 {1/4, 1/4, 1/2}
}
Animate[BarChart[{0, 1, 0}.MatrixPower[p, n], PlotRange -> 1, 
        ChartLabels -> {"Kyoto", "Tokyo", "Osaka"}, 
        Epilog -> {Text[Style[n, Bold, 14], 
        Scaled[{.05, .9}], {-1, 0}]}], {n, 0, 10, 1}, AnimationRate -> 1,
        AnimationRunning -> False, RefreshRate -> 30]

接下来我想绘制状态图本身...我试图将标签按照我想要的方式放在顶点和边缘上。这将使用城市名称标记顶点：

cities = {"Kyoto", "Tokyo", "Osaka"}
GraphPlot[p, DirectedEdges -> True, VertexLabeling -> True,
          MultiedgeStyle -> All, SelfLoopStyle -> All, EdgeLabeling -> True,
          VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .1], 
          Black, Text[cities[[#2]], #1]} &)]

这给出了一个不太漂亮但可维护的图形视图，边缘权重取自矩阵：

WeightedAdjacencyGraph[p, EdgeLabels -> "EdgeWeight"]

但我不能为我的生活弄清楚如何将两者结合起来。

最终我的计划是在顶点的圆旁边绘制一个条，就像上面Animate中的相应条一样，所以我真的需要一些绘图函数来让我修改顶点渲染。 （我相信我以后会回来提出更多问题......）

fwiw，这是Mac上的Mathematica 11.0.1.0。

帮助表示赞赏！

Answer 1

您可以使用EdgeRenderingFunction的GraphPlot选项来控制边缘图并为您添加权重。

首先，您需要将p转换为GraphPlot的顶点标签语法。

vl = Flatten[MapIndexed[{Rule @@ #2, #1} &, p, {-1}], 1];

然后使用以下EdgeRenderingFunction权重绘制。

GraphPlot[vl,
 DirectedEdges -> True,
 MultiedgeStyle -> All,
 SelfLoopStyle -> All,
 EdgeRenderingFunction -> (
   {Darker@Red, Arrow[#1, 0.1],
     Black,
     Inset[#3,
      With[{len = Length@#1},
       If[len == 2,
        Mean[#1],
        #1[[Ceiling[len/2]]]
        ]],
      Background -> White]} &),
 VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .1], 
     Black, Text[cities[[#2]], #1]} &)
 ]

您可以Style #3参数使其更符合您的喜好。

希望这有帮助。

另外，请查看Mathematica Stack Exchange以查找专门针对Mathematica的论坛。

Answer 2

结合上面的答案，这非常接近我想要的，虽然即使刷新率设置为30，它在我的笔记本电脑上也会以丑陋的方式闪烁。不过，我的笔记本电脑已经过了退休年龄。

Animate[GraphPlot[vl, DirectedEdges -> True, MultiedgeStyle -> All, 
  SelfLoopStyle -> All, 
  EdgeRenderingFunction -> ({Darker@Red, Arrow[#1, 0.1], Black, 
  Inset[#3, 
   With[{len = Length@#1}, 
    If[len == 2, Mean[#1], #1[[Ceiling[len/2]]]]], 
   Background -> White]} &),
  VertexRenderingFunction -> (
    {White, EdgeForm[Black], Disk[#1, 0.12],
    Pink, EdgeForm[Pink],
    {svpi = {0, 1, 0}.MatrixPower[p, n]; 
    Disk[#1, .1, {\[Pi]/2, \[Pi]/2 - 2 \[Pi] svpi[[#2]]}]},
    Black, Text[cities[[#2]], #1]} &)],
  {n, 0, 10, 1}, AnimationRate -> 1, AnimationRunning -> False, 
  RefreshRate -> 30]