2015-03-12 15 views
6

Tworzę grafikę przy użyciu facet_grid, aby wymusić zmienną kategoryczną na osi Y. Zdecydowałem się nie używać facet_wrap, ponieważ potrzebuję space = 'free' i labeller = label_parsed. Moje etykiety są długie i mam legendę po prawej, więc chciałbym przenieść etykiety z prawej strony panelu na górę panelu.ggplot2: Używanie gtable do przesuwania etykiet paska do górnej części panelu dla facet_grid

Oto przykład pokazujący, gdzie utknąłem.

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

mt.png

Teraz chciałbym, aby przenieść tekst paska z prawej strony każdego panelu na górze każdego panelu. Mogę zapisać grobs dla etykiet paskowych i usunąć je z działki:

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

Ale teraz utknąłem, jeśli chodzi o rbind -ing z grobs powrotem więc etykiety iść do górnej części paneli.

Innym możliwym rozwiązaniem byłoby wykorzystanie facet_wrap a następnie re-size panele as discussed in another question, ale w takim razie będę musiał ręcznie zmienić etykiety na ścianach, ponieważ nie ma labeller = label_parsed dla facet_wrap.

Byłbym wdzięczny za sugestie na temat obu metod!

Dzięki za czytanie,

Tom

Odpowiedz

8

Dzieje swoje pierwsze podejście. Wstawia wiersz nad każdym z paneli, chwyta paski (po prawej) i wstawia je do nowych rzędów.

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) 

enter image description here

OR, można osiągnąć drugie podejście przy użyciu facet_wrap_labeller funkcję available from here.

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 

enter image description here

+3

To jest fantastyczne, dziękuję.Właśnie wprowadziłem kilka drobnych zmian w twoim pierwszym podejściu, dzięki czemu mogłem go przekształcić w funkcję: 'for (i in 1: length (strips $ t)) gt = gtable_add_grob (gt, stripText $ grobs [[i ]], t = panele $ t [i] -1, l = 4, r = 4) ' -> ' for (i in 1: length (strips $ t)) gt = gtable_add_grob (gt, stripText $ grobs [[i]], t = panele $ t [i] -1, l = min (panele $ l), r = max (panele $ r)) ' aby wstawić nowy pasek grobs i ' gt = gt [ , -5] ' -> ' gt <- gt [, - c (min (paski $ l), max (paski $ r))] ' , aby usunąć stare paski. –

1

Miałem problemy z podobnym problemem, ale umieszczenie etykiety na dole. Użyłem adaptacji kodu tej odpowiedzi. A niedawno okazało się, że

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

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

opcja, która pracowała pięknie dla mnie.

Powiązane problemy