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

Ответ 1

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

Для достижения согласованного масштаба необходимо явно указать диапазон входных координат (регулярные координаты) и диапазон выходных координат (абсолютные координаты). Обычный диапазон координат зависит от PlotRange, PlotRangePadding (и, возможно, других опций?). Абсолютный диапазон координат зависит от ImageSize, ImagePadding (и, возможно, других опций?). Для GraphPlot достаточно указать PlotRange и ImageSize.

Чтобы создать графический объект, который рендерит в заранее определенном масштабе, вам нужно выяснить PlotRange, необходимый для полного включения объекта, соответствующего ImageSize, и вернуть объект Graphics с указанными настройками. Чтобы определить необходимый PlotRange, когда задействованы толстые линии, легче иметь дело с AbsoluteThickness, назовите его abs. Чтобы полностью включить эти строки, вы можете взять наименьшее PlotRange, которое включает в себя конечные точки, затем сместить минимальные x и максимальные y границы на abs/2, и сместить максимальные x и минимальные y границы на (abs/2 + 1). Обратите внимание, что это выходные координаты.

При объединении нескольких графических объектов scale-calibrated вам необходимо пересчитать PlotRange/ImageSize и установить их явно для объединенного графического объекта.

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

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

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

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

Первый дополнительный 1 предназначен для избежания "ошибки столба", а второй дополнительный 1 - это дополнительный пиксель, необходимый для добавления справа, чтобы убедиться, что толстые линии не обрезаны

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

Ответ 2

Хорошо, в вашем комментарии к моему предыдущему ответу (это другой подход), вы сказали, что проблема заключалась в взаимодействии между 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]

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

Ответ 3

Вы можете исправить свой первый пример, изменив vrfOuter следующим образом:

vrfOuter =
  Inset[
    [email protected][
      [email protected]@@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 пытается выбрать "приятное" соотношение сторон (как правило, Golden Ratio), но мы этого не хотим.

Я добавил параметр PlotRange, чтобы гарантировать, что каждый подграф использует одну и ту же систему координат. Без него Mathematica обычно выбирает минимальный диапазон, который показывает все узлы.

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

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

Ответ 4

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

(*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}} для внутренних графиков...