GraphPlots的一致尺寸

9
更新于10/27:我已经在答案中提供了实现一致缩放的详细步骤。基本上,对于每个Graphics对象,您需要将所有填充/边距固定为0,并手动指定plotRange和imageSize,以使1)plotRange包括所有图形2)imageSize = scale * plotRange。

仍然不确定如何在完全泛化的情况下执行1),但给出了一个适用于由点和粗线(AbsoluteThickness)组成的Graphics的解决方案。


我在VertexRenderingFunction中使用"Inset"和"VertexCoordinates"来保证图形的子图之间具有一致的外观。这些子图被绘制成另一个图形的顶点,使用"Inset"。存在两个问题,一个是结果框未围绕图形进行裁剪(即,仍将具有一个顶点的图形放置在大框中),另一个是大小之间存在奇怪的变化(您可以看到一个框是垂直的)。有人能看到解决这些问题的方法吗?
这与早期的问题有关,即如何保持顶点大小相同,虽然Michael Pilat建议使用Inset可以使顶点以相同比例呈现,但整体比例可能不同。例如,在左分支上,由顶点2,3组成的图形相对于顶部图形中的“2,3”子图而言被拉伸了,即使我为两者都使用了绝对顶点定位。


(来源: yaroslavvb.com)

(*utilities*)intersect[a_, b_] := Select[a, MemberQ[b, #] &];
induced[s_] := Select[edges, #~intersect~s == # &];
Needs["GraphUtilities`"];
subgraphs[
   verts_] := (gr = 
    Rule @@@ Select[edges, (Intersection[#, verts] == #) &];
   Sort /@ WeakComponents[gr~Join~(# -> # & /@ verts)]);

(*graph*)
gname = {"Grid", {3, 3}};
edges = GraphData[gname, "EdgeIndices"];
nodes = Union[Flatten[edges]];
AppendTo[edges, #] & /@ ({#, #} & /@ nodes);
vcoords = Thread[nodes -> GraphData[gname, "VertexCoordinates"]];

(*decompose*)
edgesOuter = {};
pr[_, _, {}] := None;
pr[root_, elim_, 
   remain_] := (If[root != {}, AppendTo[edgesOuter, root -> remain]];
   pr[remain, intersect[Rest[elim], #], #] & /@ 
    subgraphs[Complement[remain, {First[elim]}]];);
pr[{}, {4, 5, 6, 1, 8, 2, 3, 7, 9}, nodes];

(*visualize*)

vrfInner = 
  Inset[Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black, 
      Text[#2, {0, 0}]}, ImageSize -> 15], #] &;
vrfOuter = 
  Inset[GraphPlot[Rule @@@ induced[#2], 
     VertexRenderingFunction -> vrfInner, 
     VertexCoordinateRules -> vcoords, SelfLoopStyle -> None, 
     Frame -> True, ImageSize -> 100], #] &;
TreePlot[edgesOuter, Automatic, nodes, 
 EdgeRenderingFunction -> ({Red, Arrow[#1, 0.2]} &), 
 VertexRenderingFunction -> vrfOuter, ImageSize -> 500]

这是另一个示例,与之前的问题相同,但相对比例差异更加明显。目标是使第二张图片中的部分精确匹配第一张图片中的部分。
(来源:yaroslavvb.com)
(* Visualize tree decomposition of a 3x3 grid *)

inducedGraph[set_] := Select[edges, # \[Subset] set &];
Subset[a_, b_] := (a \[Intersection] b == a);
graphName = {"Grid", {3, 3}};
edges = GraphData[graphName, "EdgeIndices"];
vars = Range[GraphData[graphName, "VertexCount"]];
vcoords = Thread[vars -> GraphData[graphName, "VertexCoordinates"]];

plotHighlight[verts_, color_] := Module[{vpos, coords},
   vpos = 
    Position[Range[GraphData[graphName, "VertexCount"]], 
     Alternatives @@ verts];
   coords = Extract[GraphData[graphName, "VertexCoordinates"], vpos];
   If[coords != {}, AppendTo[coords, First[coords] + .002]];
   Graphics[{color, CapForm["Round"], JoinForm["Round"], 
     Thickness[.2], Opacity[.3], Line[coords]}]];

jedges = {{{1, 2, 4}, {2, 4, 5, 6}}, {{2, 3, 6}, {2, 4, 5, 6}}, {{4, 
     5, 6}, {2, 4, 5, 6}}, {{4, 5, 6}, {4, 5, 6, 8}}, {{4, 7, 8}, {4, 
     5, 6, 8}}, {{6, 8, 9}, {4, 5, 6, 8}}};
jnodes = Union[Flatten[jedges, 1]];

SeedRandom[1]; colors = 
 RandomChoice[ColorData["WebSafe", "ColorList"], Length[jnodes]];
bags = MapIndexed[plotHighlight[#, bc[#] = colors[[First[#2]]]] &, 
   jnodes];
Show[bags~
  Join~{GraphPlot[Rule @@@ edges, VertexCoordinateRules -> vcoords, 
    VertexLabeling -> True]}, ImageSize -> Small]

bagCentroid[bag_] := Mean[bag /. vcoords];
findExtremeBag[vec_] := (
   vertList = First /@ vcoords;
   coordList = Last /@ vcoords;
   extremePos = 
    First[Ordering[jnodes, 1, 
      bagCentroid[#1].vec > bagCentroid[#2].vec &]];
   jnodes[[extremePos]]
   );

extremeDirs = {{1, 1}, {1, -1}, {-1, 1}, {-1, -1}};
extremeBags = findExtremeBag /@ extremeDirs;
extremePoses = bagCentroid /@ extremeBags;
vrfOuter = 
  Inset[Show[plotHighlight[#2, bc[#2]], 
     GraphPlot[Rule @@@ inducedGraph[#2], 
      VertexCoordinateRules -> vcoords, SelfLoopStyle -> None, 
      VertexLabeling -> True], ImageSize -> 100], #] &;

GraphPlot[Rule @@@ jedges, VertexRenderingFunction -> vrfOuter, 
 EdgeRenderingFunction -> ({Red, Arrowheads[0], Arrow[#1, 0]} &), 
 ImageSize -> 500, 
 VertexCoordinateRules -> Thread[Thread[extremeBags -> extremePoses]]]

任何其他关于图形操作美观可视化的建议都欢迎。

1
我从未实现过一致的图像大小,不仅是在图表中,而且在叠加图像和绘图时也是如此。希望有人能拿出魔法棒并借给我们... - Dr. belisarius
你的图表看起来非常漂亮。当你完成这个项目后,你会为我们这些凡人发布一个软件包吗? - Simon
出于好奇,为什么你要编写自己的“Intersection”版本? - Simon
当然,我正在实现“广义分配律”,一旦它不令人尴尬,我会尽快提供。使用intersection是因为Intersection会对列表进行排序。 - Yaroslav Bulatov
添加到工具包 https://dev59.com/nuo6XIcBkEYKwwoYTS1D - Dr. belisarius
4个回答

5
这里是实现精确控制图形对象相对比例所需的步骤。
要实现一致的比例,需要明确指定输入坐标范围(常规坐标)和输出坐标范围(绝对坐标)。常规坐标范围取决于PlotRange、PlotRangePadding(可能还有其他选项?)。绝对坐标范围取决于ImageSize、ImagePadding(可能还有其他选项?)。对于GraphPlot,只需指定PlotRange和ImageSize即可。
要创建以预定比例呈现的Graphics对象,您需要找出完全包括对象所需的PlotRange、相应的ImageSize,并返回具有这些设置的Graphics对象。当涉及到粗线时,为了确定必要的PlotRange,更容易处理AbsoluteThickness(称之为abs)。为了完全包括这些线条,可以取包括端点的最小PlotRange,然后将最小x和最大y边界偏移abs/2,并将最大x和最小y边界偏移(abs/2+1)。请注意,这些是输出坐标。
在组合几个经过“比例校准”的Graphics对象时,需要重新计算PlotRange/ImageSize并为组合的Graphics对象显式设置它们。
要将“比例校准”对象插入到GraphPlot中,您需要确保用于自动GraphPlot定位的坐标处于相同的范围内。为此,您可以选择几个角节点,手动固定它们的位置,然后让自动定位完成其余工作。
基元Line/JoinedCurve/FilledCurve根据线条是否(几乎)共线以不同方式呈现连接/帽子,因此需要手动检测共线性。
使用此方法,渲染的图像应具有宽度等于
(inputPlotRange*scale + 1)+ lineThickness*scale + 1
第一个额外的1是为了避免“篱笆邮件错误”,第二个额外的1是在右侧添加的额外像素,以确保不会切断厚线条。
我通过对组合的Show进行光栅化并对使用Texture映射的对象进行3D绘图,并使用正交投影查看来验证了这个公式,它与预测的结果相匹配。将Inset到GraphPlot中的对象进行“复制/粘贴”,然后进行光栅化,我得到的图像比预测的少一个像素。


(source: yaroslavvb.com)

(**** Note, this uses JoinedCurve and Texture which are Mathematica 8 primitives.
      In Mathematica 7, JoinedCurve is not needed and can be removed *)

(** Global variables **)
scale = 50;
lineThickness = 1/2; (* line thickness in regular coordinates *)

(** Global utilities **)

(* test if 3 points are collinear, needed to work around difference \
in how colinear Line endpoints are rendered *)

collinear[points_] := 
 Length[points] == 3 && (Det[Transpose[points]~Append~{1, 1, 1}] == 0)

(* tales list of point coordinates, returns plotRange bounding box, \
uses global "scale" and "lineThickness" to get bounding box *)

getPlotRange[lst_] := (
   {xs, ys} = Transpose[lst];
   (* two extra 1/
   scale offsets needed for exact match *)
   {{Min[xs] - 
      lineThickness/2, 
     Max[xs] + lineThickness/2 + 1/scale}, {Min[ys] - 
      lineThickness/2 - 1/scale, Max[ys] + lineThickness/2}}
   );

(* Gets image size for given plot range *)

getImageSize[{{xmin_, xmax_}, {ymin_, ymax_}}] := (
   imsize = scale*{xmax - xmin, ymax - ymin} + {1, 1}
   );

(* converts plot range to vertices of rectangle *)

pr2verts[{{xmin_, xmax_}, {ymin_, ymax_}}] := {{xmin, ymin}, {xmax, 
    ymin}, {xmax, ymax}, {xmin, ymax}};

(* lifts two dimensional coordinates into 3d *)

lift[h_, coords_] := Append[#, h] & /@ coords
(* convert Raster object to array specification of texture *)

raster2texture[raster_] := Reverse[raster[[1, 1]]/255]

Subset[a_, b_] := (a \[Intersection] b == a);
inducedGraph[set_] := Select[edges, # \[Subset] set &];
values[dict_] := Map[#[[-1]] &, DownValues[dict]];


(** Graph Specific Stuff *)
graphName = {"Grid", {3, 3}};
verts = Range[GraphData[graphName, "VertexCount"]];
edges = GraphData[graphName, "EdgeIndices"];
vcoords = Thread[verts -> GraphData[graphName, "VertexCoordinates"]];
jedges = {{{1, 2, 4}, {2, 4, 5, 6}}, {{2, 3, 6}, {2, 4, 5, 6}}, {{4, 
     5, 6}, {2, 4, 5, 6}}, {{4, 5, 6}, {4, 5, 6, 8}}, {{4, 7, 8}, {4, 
     5, 6, 8}}, {{6, 8, 9}, {4, 5, 6, 8}}};
jnodes = Union[Flatten[jedges, 1]];


(* Generate diagram with explicit PlotRange,ImageSize and \
AbsoluteThickness *)
plotHL[verts_, color_] := (
   coords = verts /. vcoords;
   obj = JoinedCurve[Line[coords], 
     CurveClosed -> Not[collinear[coords]]];

   (* Figure out PlotRange and ImageSize needed to respect scale *)

    pr = getPlotRange[verts /. vcoords];
   {{xmin, xmax}, {ymin, ymax}} = pr;
   imsize = scale*{xmax - xmin, ymax - ymin};
   lineForm = {Opacity[.3], color, JoinForm["Round"], 
     CapForm["Round"], AbsoluteThickness[scale*lineThickness]};
   g = Graphics[{Directive[lineForm], obj}];
   gg = GraphPlot[Rule @@@ inducedGraph[verts], 
     VertexCoordinateRules -> vcoords];
   Show[g, gg, PlotRange -> pr, ImageSize -> imsize]
   );

(* Initialize all graph plot images *)
SeedRandom[1]; colors = 
 RandomChoice[ColorData["WebSafe", "ColorList"], Length[jnodes]];
Clear[bags];
MapThread[(bags[#1] = plotHL[#1, #2]) &, {jnodes, colors}];

(** Ploting parent graph of subgraphs **)

(* figure out coordinates of subgraphs close to edges of bounding \
box, use them to anchor parent GraphPlot *)

bagCentroid[bag_] := Mean[bag /. vcoords];
findExtremeBag[vec_] := (vertList = First /@ vcoords;
   coordList = Last /@ vcoords;
   extremePos = 
    First[Ordering[jnodes, 1, 
      bagCentroid[#1].vec > bagCentroid[#2].vec &]];
   jnodes[[extremePos]]);

extremeDirs = {{1, 1}, {1, -1}, {-1, 1}, {-1, -1}};
extremeBags = findExtremeBag /@ extremeDirs;
extremePoses = bagCentroid /@ extremeBags;

(* figure out new plot range needed to contain all objects *)

fullPR = getPlotRange[verts /. vcoords];
fullIS = getImageSize[fullPR];

(*** Show bags together merged ***)
image1 = 
 Show[values[bags], PlotRange -> fullPR, ImageSize -> fullIS]

(*** Show bags as vertices of another GraphPlot ***)
GraphPlot[
 Rule @@@ jedges,
 EdgeRenderingFunction -> ({Gray, Thick, Arrowheads[.05], 
     Arrow[#1, 0.22]} &),
 VertexCoordinateRules -> 
  Thread[Thread[extremeBags -> extremePoses]],
 VertexRenderingFunction -> (Inset[bags[#2], #] &),
 PlotRange -> fullPR,
 ImageSize -> 3*fullIS
 ]

(*** Show bags as 3d slides ***)
makeSlide[graphics_, pr_, h_] := (
  Graphics3D[{
    Texture[raster2texture[Rasterize[graphics, Background -> None]]],
    EdgeForm[None],
    Polygon[lift[h, pr2verts[pr]], 
     VertexTextureCoordinates -> pr2verts[{{0, 1}, {0, 1}}]]
    }]
  )
yoffset = 1/2;
slides = MapIndexed[
   makeSlide[bags[#], getPlotRange[# /. vcoords], 
     yoffset*First[#2]] &, jnodes];
Show[slides, ImageSize -> 3*fullIS]

(*** Show 3d slides in orthographic projection ***)
image2 = 
 Show[slides, ViewPoint -> {0, 0, Infinity}, ImageSize -> fullIS, 
  Boxed -> False]

(*** Check that 3d and 2d images rasterize to identical resolution ***)
Dimensions[Rasterize[image1][[1, 1]]] == 
 Dimensions[Rasterize[image2][[1, 1]]]

+1 非常好...我建议在代码头部添加“Mathematica 8”警告。你可以毫不羞耻地接受你的答案 :D - Dr. belisarius

2

好的,在您对我之前的回答中(这是一种不同的方法),您说问题在于GraphPlot/Inset/PlotRange之间的交互。如果您没有为Inset指定大小,则它将从嵌入的Graphics对象的ImageSize继承其大小。

这是我对您第一个示例的最终部分进行的编辑,这次考虑了Inset图形的大小。

(*visualize*)
vrfInner = Inset[Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black, 
      Text[#2, {0, 0}]}, ImageSize -> 15], #, Center] &;
vrfOuter = Module[{edges = Rule @@@ induced[#2], prange, psize},
    prange = Union /@ Transpose[Union[Flatten[List @@@ edges]] /. vcoords];
    prange = {Min[#] - .5, Max[#] + .5} & /@ prange;
    psize = Subtract @@@ Reverse /@ prange;
    Inset[GraphPlot[edges, VertexRenderingFunction -> vrfInner, 
       VertexCoordinateRules -> vcoords, SelfLoopStyle -> None, 
       Frame -> True, ImageSize -> 100, PlotRange -> prange, 
       PlotRangePadding -> None], #, Center, Scaled[psize {.05, .04}],
       Background -> None ]] &;
TreePlot[edgesOuter, Automatic, nodes, 
 EdgeRenderingFunction -> ({Red, Arrow[#1, 0.25]} &), 
 VertexRenderingFunction -> vrfOuter, ImageSize -> 500]

alt text

注意: {.05, .04} 需要根据外部图的大小和布局进行修改... 为了自动化整个过程,您可能需要一种良好的方式让内部和外部图形对象相互检查...


不错,看起来它适用于这个图形。我认为检查内部/外部图形会使它变得太复杂。问题实际上是 - 如何在给定比例尺下在Inset内呈现GraphPlots的内部。也就是说,我希望GraphPlot图像的10个像素对应于x个逻辑距离单位,其中x是全局变量。 - Yaroslav Bulatov

2
您可以通过以下方式更改vrfOuter来修复您的第一个示例:
vrfOuter =
  Inset[
    Framed@GraphPlot[
      Rule@@@induced[#2],
      VertexRenderingFunction -> vrfInner,
      VertexCoordinateRules -> vcoords,
      SelfLoopStyle -> None,
      ImageSize -> {100, 100},
      AspectRatio -> 1,
      PlotRange -> {{1, 3}, {1, 3}}
    ],
    #
  ] &;

我删除了Frame->All选项,并添加了对Framed的包装调用。这是因为我发现我无法充分控制前者生成的边距。也许我错过了某个选项,但Framed可以按照我想要的方式工作,没有麻烦。
我在ImageSize选项中添加了显式高度。如果没有它,Mathematica会尝试使用一些算法来选择高度,大多数情况下会产生令人满意的结果,但有时(如此处)会感到困惑。
出于同样的原因,我添加了AspectRatio选项--Mathematica会尝试选择一个“令人愉悦”的纵横比(通常是黄金比例),但我们不想在这里使用它。
我添加了PlotRange选项,以确保每个子图都使用相同的坐标系。如果没有它,Mathematica通常会选择显示所有节点的最小范围。
结果如下所示。我把调整箭头、边距等留给读者自己练习吧。 ;) 编辑: 根据@Yaroslav Bulatov的评论,添加了PlotRange选项。

还不错,但比例尺仍然不均匀,即“2,3”部分相对于顶部图形呈现为拉伸状态。 - Yaroslav Bulatov
@Yaroslav Bulatov:我更新了我的答案,通过添加PlotRange选项来解决您的评论。 - WReach
谢谢,这解决了“非均匀比例”问题,虽然它带来了浪费空间的问题(而以前的解决方案则相反)。 - Yaroslav Bulatov

1
作为一个快速的解决方案,您可以引入一个幽灵图来强制所有子图显示在同一网格上。这是我对您第一个示例的最后部分进行修改的结果——我的幽灵图是您原始图形的副本,但顶点编号变为负数。
(*visualize*)

ghost = GraphData[gname, "EdgeRules"] /. HoldPattern[a_ -> b_] :> -a -> -b;
vrfInner = If[#2 > 0, 
    Inset[Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black, 
       Text[#2, {0, 0}]}, ImageSize -> 15], #], {}] &;
erfInner = {If[TrueQ[#2[[1]] > 0], Blue, White], Line[#1]} &;
vrfOuter = Inset[GraphPlot[Join[Rule @@@ induced[#2], ghost],
     VertexRenderingFunction -> vrfInner, 
     VertexCoordinateRules -> (Join[#,#/.HoldPattern[a_->b_]:>-a -> b]&[vcoords]), 
     EdgeRenderingFunction -> erfInner, SelfLoopStyle -> None, 
     Frame -> True, ImageSize -> 100], #] &;
TreePlot[edgesOuter, Automatic, nodes, 
 EdgeRenderingFunction -> ({Red, Arrow[#1, 0.2]} &), 
 VertexRenderingFunction -> vrfOuter, ImageSize -> 500]

alt text

你可以对第二个例子做同样的事情。 此外,如果您不想浪费垂直空间,可以编写一个快速函数来检查哪些节点需要显示,并仅保留所需行上的幽灵。 编辑:通过为内部图设置PlotRange -> {{1, 3}, {1, 3}},可以获得相同的输出...

我以为在vrfOuter中使用"PlotRange->{0,4}"可以达到相同的效果,但结果更奇怪了。目标是 1) 没有浪费的空间和 2) 一致的大小。你提出的方法可能有效,我想我真正想要的是理解GraphPlot/Inset/PlotRange如何共同工作。 - Yaroslav Bulatov

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接