Я создаю график, используя facet_grid для фасетки категориальной переменной по оси y. Я решил не использовать facet_wrap, потому что мне нужны space = 'free' и labeller = label_parsed. Мои ярлыки длинные, и у меня есть легенда справа, поэтому я хотел бы переместить ярлыки с правой стороны панели в верхнюю часть панели.

Вот пример, показывающий, где я застрял.

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

Теперь я хотел бы переместить текст полосы с правой стороны каждой панели в верхнюю часть каждой панели. Могу хранить гробницы для полосовых этикеток и убирать их с участка:

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

Но теперь я застрял, когда дело доходит до rbind - убирать грибы обратно, чтобы метки доходили до верхней части панелей.

Другим возможным решением было бы использовать facet_wrap и затем изменить размер панелей , как описано в другом вопросе , но в этом случае мне пришлось бы вручную изменить метки на фасетах, потому что нет labeller = label_parsed для facet_wrap.

Буду признателен за предложения по любому из подходов!

Спасибо за прочтение,

Том

9
Tom Harrop 12 Мар 2015 в 14:35

2 ответа

Лучший ответ

Это ваш первый подход. Он вставляет строку над каждой из панелей, захватывает полосы (справа) и вставляет их в новые строки.

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.spacing = 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, grepl("panel", gt$layout$name), 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, grepl("panel", gt$layout$name), se=t:r))
strips <- c(subset(gt$layout, grepl("strip-r", gt$layout$name), se=t:r))

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

# Insert the strip grobs into the new rows
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]]$grobs[[1]],  t=panels$t[i]-1, l=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] = unit(0.8, "lines")
   gt$heights[i-2] = unit(0.2, "lines")
   }

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

enter image description here

ИЛИ вы можете реализовать второй подход, используя функцию facet_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

enter image description here

8
Sandy Muspratt 20 Июн 2018 в 06:24

Я боролся с аналогичной проблемой, но наклеивал ярлыки внизу. Я использовал кодовую адаптацию этого ответа. И недавно обнаружил, что

Ggplot2 ver.2.2.1.0 ( http://docs.ggplot2.org/current/facet_grid.html < / а>)

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

Вариант, который прекрасно сработал для меня.

1
zazu 4 Май 2016 в 17:44