ggplot2: Utilizzo di gtable per spostare le etichette delle strisce nella parte superiore del pannello per facet_grid

Question

Sto creando un grafico utilizzando facet_grid per sfaccettare una variabile categoriale sull'asse y. Ho deciso di non utilizzare facet_wrap perché ho bisogno di space = 'free' e labeller = label_parsed. Le mie etichette sono lunghe e ho una legenda sulla destra, quindi vorrei spostare le etichette dalla parte destra del pannello alla parte superiore del pannello.

Ecco un esempio per mostrare dove mi sto bloccando.

library(ggplot2) 
library(gtable) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_grid(manufacturer ~ ., scales = 'free', space = 'free') + 
    theme_minimal() + 
    theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0)) 

Ora vorrei spostare il testo striscia da destra di ogni pannello alla parte superiore di ogni pannello. Posso memorizzare i grobs per le etichette nastri e rimuoverli dal terreno:

grob <- ggplotGrob(mt) 
strips.y <- gtable_filter(grob, 'strip-right') 
grob2 <- grob[,-5] 

Ma ora mi sono bloccato quando si tratta di rbind -ing le grobs indietro in modo le etichette vanno alla parte superiore dei pannelli.

Un'altra possibile soluzione potrebbe essere quella di utilizzare facet_wrap e poi ri-size pannelli as discussed in another question, ma in quel caso dovrebbe cambiare manualmente le etichette sulle sfaccettature perché non c'è labeller = label_parsed per facet_wrap.

Gradirei suggerimenti su entrambi gli approcci!

Grazie per la lettura,

Tom

Answer 1

Questo prende il vostro primo approccio. Inserisce una riga sopra ciascuno dei pannelli, afferra i solchi delle strisce (a destra) e li inserisce nelle nuove file.

library(ggplot2) 
library(gtable) 
library(grid) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_grid(manufacturer ~ ., scales = 'free', space = 'free') + 
    theme(panel.margin = unit(0.5, 'lines'), 
     strip.text.y = element_text(angle = 0)) 

# Get the gtable 
gt <- ggplotGrob(mt) 

# Get the position of the panels in the layout 
panels <-c(subset(gt$layout, name=="panel", se=t:r)) 

# Add a row above each panel 
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i) 

# Get the positions of the panels and the strips in the revised layout 
panels <-c(subset(gt$layout, name=="panel", se=t:r)) 
strips <- c(subset(gt$layout, name=="strip-right", se=t:r)) 

# Get the strip grobs 
stripText = gtable_filter(gt, "strip-right") 

# Insert the strip grobs into the new rows 
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]], t=panels$t[i]-1, l=4, r=4) 

# Remove the old strips 
gt = gt[,-5] 

# For this plot - adjust the heights of the strips and the empty row above the strips 
for(i in panels$t) { 
    gt$heights[i-1] = list(unit(0.8, "lines")) 
    gt$heights[i-2] = list(unit(0.2, "lines")) 
    } 

# Draw it 
grid.newpage() 
grid.draw(gt) 

O, è possibile ottenere il secondo approccio utilizzando una funzione available from herefacet_wrap_labeller.

library(ggplot2) 
library(gtable) 

mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() + 
    facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) + 
    theme(panel.margin = unit(0.2, 'lines')) 


facet_wrap_labeller <- function(gg.plot, labels=NULL) { 
    require(gridExtra) 

    g <- ggplotGrob(gg.plot) 
    gg <- g$grobs  
    strips <- grep("strip_t", names(gg)) 

    for(ii in seq_along(labels)) { 
    modgrob <- getGrob(gg[[strips[ii]]], "strip.text", 
         grep=TRUE, global=TRUE) 
    gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii]) 
    } 

    g$grobs <- gg 
    class(g) = c("arrange", "ggplot",class(g)) 
    return(g) 
} 

## Number of y breaks in each panel 
g <- ggplot_build(mt) 
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length) 

# Some arbitrary strip texts 
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4]) 

# Apply the facet_wrap_labeller function 
gt = facet_wrap_labeller(mt, StripTexts) 

# Get the position of the panels in the layout 
panels <- gt$layout$t[grepl("panel", gt$layout$name)] 

# Replace the default panel heights with relative heights 
gt$heights[panels] <- lapply(N, unit, "null") 

# Draw it 
gt 

Answer 2

ero alle prese con un problema simile, ma mettere le etichette sulla parte inferiore. Ho usato un adattamento del codice di questa risposta. E di recente ha scoperto che

ggplot2 ver.2.2.1.0 (http://docs.ggplot2.org/current/facet_grid.html)

~facet_grid(.~variable,switch='x')

opzione che ha lavorato splendidamente per me.