Согласованный размер для GraphPlots

Обновление 10/27 : Я подробно описал шаги для достижения согласованного масштаба в ответе. В основном для каждого графического объекта вам нужно установить все отступы / поля на 0 и вручную указать plotRange и imageSize так, чтобы 1) plotRange включал всю графику 2) imageSize = scale * plotRange

Теперь вы знаете, как это сделать 1) полностью В общем, дается решение, которое работает для графики, состоящей из точек и толстых линий (AbsoluteThickness)

Я использую «Inset» в VertexRenderingFunction и «VertexCoordinates», чтобы гарантировать единообразное отображение среди подграфов графа. Эти подграфы рисуются как вершины другого графа с помощью «Inset». Есть две проблемы: одна состоит в том, что результирующие прямоугольники не обрезаются вокруг графа (т. Е. Граф с одной вершиной все еще помещается в большой прямоугольник), а другая заключается в том, что есть странные различия между размерами (вы можете видеть, что одно поле вертикальное) . Может ли кто-нибудь найти способ обойти эти проблемы?

Это связано с более ранним вопросом о том, как сохранить одинаковые размеры вершин, и в то время как предложение Майкла Пилата об использовании 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]]]

Приветствуются любые другие предложения по эстетически приятной визуализации операций с графами.