Постоянный размер для графиков

Вот шаги, необходимые для точного управления относительными масштабами графических объектов.

Для достижения согласованного масштаба необходимо явно указать диапазон входных координат (обычные координаты) и диапазон выходных координат (абсолютные координаты). Обычный диапазон координат зависит от 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 Graphics необходимо пересчитать PlotRange/ImageSize и задать их явно для объединенного объекта Graphics.

Чтобы вставить объекты scale-calibrated в GraphPlot, необходимо убедиться, что координаты, используемые для автоматического GraphPlot позиционирования, находятся в том же диапазоне. Для этого вы можете выбрать несколько угловых узлов, зафиксировать их положение вручную и позволить автоматическому позиционированию сделать все остальное.

Примитивы Line/JoinedCurve/FilledCurve отображают соединения/замыкания по-разному в зависимости от того, является ли линия (почти) коллинеарной, поэтому необходимо вручную определять коллинеарность.

Используя этот подход, визуализированные изображения должны иметь ширину, равную

(inputPlotRange*scale + 1) + lineThickness*scale + 1

Первый дополнительный 1 предназначен для того, чтобы избежать «ошибки столба забора», а второй дополнительный 1 — это дополнительный пиксель, необходимый для добавления справа, чтобы убедиться, что толстые линии не обрезаются.

Я проверил эту формулу, выполнив Rasterize на комбинированном Show и растеризовав 3D-график с объектами, нанесенными на карту с использованием Texture и просматриваемыми с проекцией 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]]]

Хорошо, в своем комментарии к моему предыдущему ответу (это другой подход) вы сказали, что проблема заключается во взаимодействии между GraphPlot/Inset/PlotRange. Если вы не укажете размер для Inset, то он наследует свой размер от ImageSize вложенного объекта Graphics.

Вот мое редактирование последнего раздела вашего первого примера, на этот раз с учетом размера 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]

н.б. {.05, .04} придется модифицировать по мере изменения размера и компоновки внешнего графа... Чтобы автоматизировать все это, вам может понадобиться удобный способ проверки друг друга внутренними и внешними графическими объектами...

Вы можете исправить свой первый пример, изменив 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 обычно выбирает минимальный диапазон, показывающий все узлы.

Результаты показаны ниже. Я оставляю читателю упражнение по настройке стрелок, полей и т. д. ;)

Редактировать: добавлена ​​опция PlotRange в ответ на комментарий @Yaroslav Bulatov.

В качестве быстрого хака вы можете ввести граф-призрак, чтобы все подграфы отображались в одной сетке. Вот моя модификация последней части вашего первого примера: мой призрачный граф является копией вашего исходного графа, но с отрицательными номерами вершин.

(*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]

Вы можете сделать то же самое для второго примера. Кроме того, если вы не хотите тратить вертикальное пространство впустую, вы можете написать быструю функцию, которая проверяет, какие узлы должны отображаться, и сохраняет призраки только в необходимых строках.

Изменить: тот же результат можно получить, просто установив PlotRange -> {{1, 3}, {1, 3}} для внутренних графиков...