ggplot2 + gridExtra: come garantire che geom_bar in trame di dimensioni diverse corrisponda esattamente alla stessa larghezza della barra

Question

Questa domanda è motivata esplorando ulteriormente questo question. Il problema con la soluzione accettata diventa più evidente quando c'è una maggiore disparità nel numero di barre per faccetta. Date un'occhiata a questi dati e la trama risultante utilizzando tale soluzione:

# 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() 

noterete le larghezze apparire esattamente a destra, ma gli spazi in sfaccettatura 3 è abbastanza lampante. Non c'è un modo semplice per risolvere questo problema in ggplot2 che ho già visto (facet_wrap non ha un'opzione space).

passo successivo è quello di cercare di risolvere questo utilizzando 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)) 

si noterà che ho usato lo stesso aritmetica già suggerito in base al largo il numero di barre per sfaccettatura, ma in questo caso finisce male orribilmente. Questo sembra essere dovuto al fatto che ci sono elementi extra "di altezza costante" che devo prendere in considerazione in matematica.

Un'altra complicazione (credo) è che l'output finale (e se le larghezze corrispondano o meno) dipenderà anche dalla larghezza e dall'altezza di dove sto emettendo il grob finale, sia esso in un R/RStudio ambiente, o in un file PNG.

Come posso realizzare questo?

Answer 1

La modifica della gtable non aiuta, purtroppo, come la larghezza della barra è in unità relative,

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

Qualcosa di simile sembra funzionare, ma non - non del tutto . Ha l'aspetto di lavorare perché i livelli del fattore ID sono sequenziali. Qualsiasi altra cosa e scale = "free" non riesce. Ma potrebbe essere possibile sviluppare ulteriormente. Il metodo utilizza facet_grid e pertanto è possibile utilizzare space = "free". Il metodo usa geom_rect per sovrapporre rettangoli di colori diversi uno sopra l'altro. Ha bisogno di somme cumulative da calcolare in modo che il bordo destro di ciascun rettangolo possa essere posizionato.

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 linee spesse funzionano un po 'meglio (credo)

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") 

Modifica aggiuntive Prendendo i dati dal vostro earleir pubblicare e modificarlo un po '.
aggiornatoopts è deprecato; utilizzando invece theme.

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))