wolfram-mathematica - GraphPlots 的大小一致

Question

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

现在仍然确定如何做 1) 完全通用，给出了适用于由点和粗线 (AbsoluteThickness) 组成的图形的解决方案

我在 VertexRenderingFunction 和“VertexCoordinates”中使用“Inset”来保证图形子图之间的一致外观。这些子图被绘制为另一个图的顶点，使用“Inset”。有两个问题，一个是生成的盒子没有在图形周围裁剪(即，一个顶点的图形仍然被放置在一个大盒子中)，另一个是尺寸之间存在奇怪的变化(你可以看到一个盒子是垂直的) .任何人都可以找到解决这些问题的方法吗？

这与较早的 question 有关。关于如何保持顶点大小看起来相同，虽然 Michael Pilat 建议使用 Inset 可以保持顶点渲染在相同的比例，但整体比例可能不同。例如在左分支上，由顶点 2,3 组成的图相对于顶部图中的“2,3”子图被拉伸(stretch)，即使我对两者都使用绝对顶点定位


(来源: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]]]

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

Answer 1

以下是实现对图形对象的相对比例进行精确控制所需的步骤。

为了实现一致的比例，需要明确指定输入坐标范围(常规坐标)和输出坐标范围(绝对坐标)。正则坐标范围取决于PlotRange , PlotRangePadding (可能还有其他选择？)。绝对坐标范围取决于ImageSize , ImagePadding (可能还有其他选择？)。对于 GraphPlot , 指定 PlotRange 就足够了和 ImageSize .

要创建以预定比例呈现的 Graphics 对象，您需要弄清楚 PlotRange需要完全包含对象，对应 ImageSize并返回 Graphics指定这些设置的对象。找出必要的PlotRange当涉及粗线时更容易处理AbsoluteThickness ，叫它abs .要完全包含这些行，您可以采用最小的 PlotRange包括端点，然后将最小 x 和最大 y 边界偏移 abs/2，并将最大 x 和最小 y 边界偏移 (abs/2+1)。请注意，这些是输出坐标。

当组合几个 scale-calibrated您需要重新计算的图形对象PlotRange/ImageSize并为组合的 Graphics 对象显式设置它们。

插入 scale-calibrated对象放入 GraphPlot您需要确保用于自动 GraphPlot 的坐标定位在同一范围内。为此，您可以选择几个角节点，手动固定它们的位置，然后让自动定位完成其余的工作。

原语 Line/JoinedCurve/FilledCurve根据线是否(几乎)共线，以不同的方式呈现连接/上限，因此需要手动检测共线。

使用这种方法，渲染图像的宽度应该等于
(inputPlotRange*scale + 1) + lineThickness*scale + 1
第一个额外的1是为了避免“栅栏错误”，第二个额外的 1 是需要在右侧添加的额外像素，以确保粗线不会被截断

我已经通过 Rasterize 验证了这个公式结合 Show并用 Texture 映射对象栅格化 3D 图并通过 Orthographic 查看投影，它与预测结果相匹配。对对象进行“复制/粘贴”Inset进入 GraphPlot ，然后光栅化，我得到的图像比预期的要薄一个像素。


(来源: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]]]