ggplot2 + gridExtra: cómo asegurar geom_bar en diferentes tamaños grobs de la gráfica resultado en la misma barra de ancho

Question

Esta pregunta está motivada por explorar más a fondo este question. El problema con la solución aceptada se vuelve más obvio cuando hay una mayor disparidad en el número de barras por faceta. Echar un vistazo a estos datos y la trama resultante utilizando esa solución:

# create slightly contrived data to better highlight width problems 
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))), 
        TYPE=factor(rep(1:3,length(ID)/3)), 
        TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)), 
        VAL=runif(27)) 

# implement previously suggested solution 
base.width <- 0.9 
data$w <- base.width 
# facet two has 3 bars compared to facet one's 5 bars 
data$w[data$TIME==2] <- base.width * 3/5 
# facet 3 has 1 bar compared to facet one's 5 bars 
data$w[data$TIME==3] <- base.width * 1/5 
ggplot(data, aes(x=ID, y=VAL, fill=TYPE)) + 
    facet_wrap(~TIME, ncol=1, scale="free") + 
    geom_bar(position="stack", aes(width = w),stat = "identity") + 
    coord_flip() 

Se dará cuenta de los anchos se ven exactamente la derecha, pero el espacio en blanco en la faceta 3 es bastante evidente. No hay una manera fácil de solucionar esto en ggplot2 que he visto aún (facet_wrap no tiene una opción space).

El siguiente paso es tratar de solucionar esto usando gridExtra:

# create each of the three plots, don't worry about legend for now 
p1 <- ggplot(data[data$TIME==1,], aes(x=ID, y=VAL, fill=TYPE)) + 
    facet_wrap(~ TIME, ncol=1) + 
    geom_bar(position="stack", show_guide=FALSE) + 
    coord_flip() 
p2 <- ggplot(data[data$TIME==2,], aes(x=ID, y=VAL, fill=TYPE)) + 
    facet_wrap(~ TIME, ncol=1) + 
    geom_bar(position="stack", show_guide=FALSE) + 
    coord_flip() 
p3 <- ggplot(data[data$TIME==3,], aes(x=ID, y=VAL, fill=TYPE)) + 
    facet_wrap(~ TIME, ncol=1) + 
    geom_bar(position="stack", show_guide=FALSE) + 
    coord_flip() 

# use similar arithmetic to try and get layout correct 
require(gridExtra) 
heights <- c(5, 3, 1)/sum(5, 3, 1) 
print(arrangeGrob(p1 ,p2, p3, ncol=1, 
      heights=heights)) 

Se dará cuenta utilicé la misma aritmética sugerido previamente basa fuera el número de barras por las facetas, pero en este caso acabe horriblemente mal Esto parece ser porque hay elementos adicionales de "altura constante" que debo tener en cuenta en las matemáticas.

Otra complicación (creo) es que el resultado final (y si el ancho coincide o no) también dependerá del ancho y alto de donde estoy obteniendo el grob final, ya sea en un R/RStudio entorno, o a un archivo PNG.

¿Cómo puedo lograr esto?

Answer 1

Cambio de la GTABLE no ayuda, por desgracia, ya que el ancho de la barra está en unidades relativas,

g = ggplot_gtable(ggplot_build(p)) 
panels = which(sapply(g$heights, attr, "unit") == "null") 
g$heights[[panels[1]]] <- unit(5, "null") 
g$heights[[panels[2]]] <- unit(3, "null") 
g$heights[[panels[3]]] <- unit(1, "null") 
grid.draw(g) 

Answer 2

Algo como esto parece funcionar, pero no - no del todo . Parece que funciona porque los niveles del factor de ID son secuenciales. Cualquier otra cosa, y scale = "free" falla. Pero podría ser posible desarrollar más. El método usa facet_grid, y por lo tanto space = "free" se puede usar. El método usa geom_rect para superponer rectángulos de colores diferentes uno encima del otro. Necesita calcular sumas acumulativas para poder posicionar el borde derecho de cada rectángulo.

data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))), 
        TYPE=factor(rep(1:3,3)), 
        TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)), 
        VAL=runif(27)) 

library(ggplot2) 
library(plyr) 

# Get the cumulative sums 
data = ddply(data, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL)) 

ggplot(data, aes(x=VAL, y = as.numeric(ID), fill=TYPE)) + 
    geom_rect(data = subset(data, TYPE == 3), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) + 
    geom_rect(data = subset(data, TYPE == 2), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) + 
    geom_rect(data = subset(data, TYPE == 1), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) + 
    facet_grid(TIME~., space = "free", scale="free") + 
    scale_y_continuous(breaks = c(1:5), expand = c(0, 0.2)) 

EDIT: o realmente líneas gruesas funcionan un poco mejor (creo)

ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) + 
     geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
     geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
     geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
     facet_grid(TIME~., space = "free", scale="free") 

Editar adicional Tomando los datos de su earleir publicar y modificarlo un poco.
Actualizadoopts está en desuso; usando theme en su lugar.

df <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("a", 
"b", "c", "d", "e", "f", "g"), class = "factor"), TYPE = structure(c(1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 
1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 
5L, 6L, 1L, 2L, 3L), .Label = c("1", "2", "3", "4", "5", "6", 
"7", "8"), class = "factor"), TIME = structure(c(2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 
1L, 1L, 1L), .Label = c("One", "Five", "Fifteen"), class = "factor"), VAL = c(0.937377670081332, 
0.522220720537007, 0.278690102742985, 0.967633064137772, 0.116124767344445, 
0.0544306698720902, 0.470229141646996, 0.62017166428268, 0.195459847105667, 
0.732876230962574, 0.996336271753535, 0.983087373664603, 0.666449476964772, 
0.291554537601769, 0.167933790013194, 0.860138458199799, 0.172361251665279, 
0.833266809117049, 0.620465772924945, 0.786503327777609, 0.761877260869369, 
0.425386636285111, 0.612077651312575, 0.178726130630821, 0.528709076810628, 
0.492527724476531, 0.472576208412647, 0.0702785139437765, 0.696220921119675, 
0.230852259788662, 0.359884874196723, 0.518227979075164, 0.259466265095398, 
0.149970305617899, 0.00682218233123422, 0.463400925742462, 0.924704828299582, 
0.229068386601284)), .Names = c("ID", "TYPE", "TIME", "VAL"), row.names = c(NA, 
-38L), class = "data.frame") 

library(ggplot2) 
library(plyr) 

data = ddply(df, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL)) 

ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) + 
      geom_segment(data = subset(data, TYPE == 6), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      geom_segment(data = subset(data, TYPE == 5), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      geom_segment(data = subset(data, TYPE == 4), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) + 
      facet_grid(TIME~., space = "free", scale="free") + 
      theme(strip.text.y = element_text(angle = 0))