2010-11-20 19 views
9

Actualización 10/27: He detallado los pasos para lograr una escala consistente en una respuesta. Básicamente para cada objeto Graphics necesita corregir todos los rellenos/márgenes a 0 y especificar manualmente plotRange y imageSize que 1) plotRange incluye todos los gráficos 2) imageSize = scale * plotRangeTamaño consistente para GraphPlots

Todavía estoy seguro de cómo hacerlo 1) en generalidad completa, una solución que funciona para los gráficos que consiste de los puntos y las líneas gruesas (AbsoluteThickness) se da


estoy usando "Inset" en VertexRenderingFunction y "VertexCoordinates" para garantizar apariencia consistente entre subgraphs de un gráfico. Esos subgrafos se dibujan como vértices de otro gráfico, usando "Inserción". Hay dos problemas, uno es que los cuadros resultantes no se recortan alrededor del gráfico (es decir, el gráfico con un vértice todavía se coloca en un cuadro grande), y otro es que hay una variación extraña entre los tamaños (se puede ver que un cuadro es vertical) . ¿Alguien puede encontrar una solución a estos problemas?

Esto se relaciona con un anterior question de cómo mantener los tamaños de los vértices con el mismo aspecto, y aunque la sugerencia de Michael Pilat de usar Inset funciona para mantener la representación de los vértices en la misma escala, la escala general puede ser diferente. Por ejemplo en la rama izquierda, la gráfica que consiste en vértices 2,3 se estira en relación con el subgrafo "2,3" en el gráfico superior, a pesar de que estoy usando posicionamiento absoluto vértice tanto para

http://yaroslavvb.com/upload/bad-graph.png

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

Aquí hay otro ejemplo, el mismo problema que antes, pero la diferencia en las escalas relativas es más visible. El objetivo es que las partes de la segunda imagen coincidan exactamente con las partes de la primera imagen.

http://yaroslavvb.com/upload/bad-plot2.png

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

¿Alguna otra sugerencia para la visualización estéticamente agradable de las operaciones con gráficos son bienvenidos.

+1

nunca logró un dimensionamiento de imagen consistente, no sólo con los gráficos, sino también cuando la superposición de imágenes y tramas. Espero que alguien sostenga la varita mágica y nos la preste ... –

+0

Le están dando algunos gráficos muy bonitos. Cuando hayas terminado este proyecto en el que estás trabajando, ¿vas a lanzar un paquete para el resto de la plebe? – Simon

+0

Por curiosidad, ¿por qué escribiste tu propia versión de 'Intersección'? – Simon

Respuesta

5

Estos son los pasos necesarios para lograr un control preciso sobre las escalas relativas de los objetos gráficos.

Para lograr una escala uniforme, se necesita especificar explícitamente el rango de coordenadas de entrada (coordenadas normales) y el rango de coordenadas de salida (coordenadas absolutas). El rango de coordenadas normal depende de PlotRange, PlotRangePadding (¿y posiblemente otras opciones?). El rango de coordenadas absolutas depende de ImageSize, ImagePadding (¿y posiblemente otras opciones?). Para GraphPlot, es suficiente especificar PlotRange y ImageSize.

Para crear objetos gráficos que hace a una escala predeterminada, es necesario averiguar PlotRange necesaria para incluir plenamente el objeto, lo que corresponde ImageSize y volver Graphics objeto con estos parámetros especificados.Para averiguar el PlotRange necesario cuando se trata de líneas gruesas, es más fácil tratar con AbsoluteThickness, llámelo abs. Para incluir completamente esas líneas, puede tomar el PlotRange más pequeño que incluya los puntos finales, luego compensar los límites x mínimo y máximo y por abs/2, y compensar los límites máximos xy mínimo por (abs/2 + 1). Tenga en cuenta que estas son las coordenadas de salida.

Al combinar varios objetos de gráficos scale-calibrated debe recalcular PlotRange/ImageSize y establecerlos explícitamente para el objeto de gráficos combinado.

Para insertar objetos scale-calibrated en GraphPlot debe asegurarse de que las coordenadas utilizadas para el posicionamiento automático GraphPlot estén en el mismo rango. Para eso, puedes elegir varios nodos de esquina, arreglar sus posiciones manualmente y dejar que el posicionamiento automático haga el resto.

Primitives Line/JoinedCurve/FilledCurve rinden une/tapas de manera diferente dependiendo de si la línea es colineal (casi), por lo que se necesita para detectar manualmente colinealidad.

Con este enfoque, las imágenes renderizadas debe tener anchura igual a

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

Primera adicional 1 es evitar el "error poste de cerca" y segundo extra 1 es el píxel adicional necesario añadir sobre el derecho a hacen que las líneas gruesas seguro que no se cortan-off

he verificado esta fórmula al hacer Rasterize el combinado Show y rasterizar una parcela 3D con objetos mapeados usando Texture y ver con Orthographic proj ección y coincide con el resultado predicho. Al hacer 'Copiar/Pegar' en los objetos Inset en GraphPlot, y luego Rasterizar, obtengo una imagen que es un píxel más delgado de lo previsto.

http://yaroslavvb.com/upload/graphPlots.png

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

+1 muy agradable ... Sugiero agregar un "Mathematica 8" advertencia en el encabezado del código. Podrías aceptar tu respuesta sin vergüenza: D –

1

Como hackeo rápido, puede introducir un gráfico fantasma para forzar a todos los subgrafos a mostrarse en la misma cuadrícula. Aquí está mi modificación de la última parte de tu primer ejemplo: mi gráfico de fantasmas es una copia de tu gráfico original, pero con los números de los vértices negativos.

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

que podría hacer lo mismo para su segundo ejemplo. Además, si no desea el espacio vertical desperdiciado, podría escribir una función rápida que verifique qué nodos se mostrarán y solo conservará los fantasmas en las filas necesarias.

Editar: El mismo resultado se puede obtener simplemente fijando PlotRange -> {{1, 3}, {1, 3}} para los gráficos interiores ...

+0

Pensé que podría obtener el mismo efecto con " PlotRange -> {0,4} "en vrfOuter, pero los resultados son aún más extraños. El objetivo es tener 1) espacio no desperdiciado y 2) tamaño constante. Lo que está proponiendo podría funcionar, creo que lo que realmente quiero es una comprensión de cómo GraphPlot/Inset/PlotRange funcionan juntos –

2

bien, en su comentario a mi respuesta anterior (este es un enfoque diferente), se dijo que el problema fue la interacción entre GraphPlot/Inset/PlotRange. Si no especifica un tamaño para Inset, hereda su tamaño del ImageSize del objeto de inserción Graphics.

Aquí está mi edición de la sección final en su primer ejemplo, esta vez teniendo en cuenta el tamaño de los gráficos 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

n.b. el {.05, .04} debería modificarse a medida que cambian el tamaño y el diseño del gráfico externo ... Para automatizar todo, es posible que necesite una buena forma de inspeccionar los objetos gráficos internos y externos ...

+0

Bueno, parece que funciona para este gráfico. Creo que inspeccionar gráficos internos/externos lo haría demasiado complicado. La pregunta es realmente: cómo hacer GraphPlots dentro de Inset dentro de VertexRenderingFunction en una escala determinada. IE, quiero que 10 píxeles de la imagen de GraphPlot se correspondan con x unidades de distancia lógica, donde x es una variable global. –

2

Usted puede fijar su primer ejemplo cambiando vrfOuter de la siguiente manera:

vrfOuter = 
    Inset[ 
    [email protected][ 
     [email protected]@@induced[#2], 
     VertexRenderingFunction -> vrfInner, 
     VertexCoordinateRules -> vcoords, 
     SelfLoopStyle -> None, 
     ImageSize -> {100, 100}, 
     AspectRatio -> 1, 
     PlotRange -> {{1, 3}, {1, 3}} 
    ], 
    # 
    ] &; 

quité el marco > Todos opción y añade una llamada de envolver a Enmarcado. Esto es porque me parece que no puedo controlar adecuadamente los márgenes fuera del marco generado por el primero. Me puede faltar alguna opción en alguna parte, pero Enmarcado funciona de la manera que quiero sin problemas.

He añadido una altura explícita a la opción ImageSize. Sin él, Mathematica intenta elegir una altura utilizando algún algoritmo que en su mayoría produce resultados agradables, pero a veces (como aquí) se confunde.

Agregué la opción AspectRatio por la misma razón: Mathematica intenta elegir una relación de aspecto "agradable" (generalmente la relación áurea), pero no queremos eso aquí.

He añadido la opción PlotRange para asegurarme de que cada subgráfico usa el mismo sistema de coordenadas. Sin él, Mathematica normalmente seleccionará un rango mínimo que muestre todos los nodos.

Los resultados se muestran a continuación. Lo dejo como ejercicio para el lector para ajustar las flechas, márgenes, etc.,)

rendered result

Edición: añade la opción PlotRange en respuesta a un comentario de @Yaroslav Bulatov

+0

Es mejor, pero la escala aún no es uniforme, es decir, parte con "2,3" se estira en relación con el gráfico superior –

+0

@Yaroslav Bulatov: actualicé mi respuesta para dirigir su comentario agregando la opción PlotRange. – WReach

+0

Gracias, eso soluciona el problema de "escala no uniforme", aunque agrega un problema de espacio desperdiciado (fue al revés para la solución anterior) –

Cuestiones relacionadas