ggplot2: Verwenden von gtable zum Verschieben von Strip-Labels an den Anfang des Panels für facet_grid

Question

Ich erstelle eine Grafik mit facet_grid, um eine kategorische Variable auf der y-Achse zu facettieren. Ich entschied mich, facet_wrap nicht zu verwenden, weil ich space = 'free' und labeller = label_parsed benötige. Meine Etiketten sind lang und ich habe eine Legende auf der rechten Seite, also möchte ich die Etiketten von der rechten Seite des Panels an die Oberseite des Panels verschieben.

Hier ist ein Beispiel, um zu zeigen, wo ich stecken bleibe.

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

Nun würde Ich mag den Streifen Text von rechts jeder Platte an der Oberseite jeder Platte zu bewegen. Ich kann die Grobs für die Streifenetiketten speichern und sie vom Grundstück entfernen:

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

Aber jetzt bin ich stecken, wenn es um rbind kommt wieder die Grobs -ing so die Etiketten an die Spitze der Platten gehen.

Eine andere mögliche Lösung wäre facet_wrap zu verwenden und dann die Platten as discussed in another question die Größe neu, aber in diesem Fall würde ich manuell die Etiketten auf den Facetten ändern, weil es keine labeller = label_parsed für facet_wrap ist.

Ich würde Vorschläge auf beiden Ansatz schätzen!

Dank für das Lesen,

Tom

Answer 1

Ist dies Ihre erste Ansatz nimmt. Es fügt eine Reihe über jedem der Tafeln ein, ergreift die Streifenlöcher (rechts) und fügt sie in die neuen Reihen ein.

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) 

OR, können Sie den zweiten Ansatz mit einer facet_wrap_labeller Funktion available from here erreichen können.

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

ich mit einem ähnlichen Problem zu kämpfen hatte, aber die Etiketten auf den Boden setzen. Ich habe eine Codeanpassung dieser Antwort verwendet. Und vor kurzem festgestellt, dass

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

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

Option, die sehr schön für mich gearbeitet hat.