двойная ось Y вместе с facet_wrap

На странице Как я могу поместите преобразованную шкалу в правую часть ggplot2? было показано, как добавить две оси Y в один и тот же график, манипулируя и объединяя объекты ggplot2 с gtable. Из приведенного здесь примера мне удалось расширить его для работы с facet_wrap. См. Пример ниже.

Однако есть три вещи, которые не идеальны.

  1. Шкала всегда ставится крайним правым. Было бы лучше, если бы это было связано с сюжетом в последней строке
  2. Это не сработает, если ось Y есть на всех графиках отдельно (т.е. вы помещаете scales="free_y" в facet_wrap)
  3. Если я оставлю линии сетки (закомментированная линия), линии сетки из вторых графиков появятся перед первым графиком.

Есть идеи, есть ли умный способ исправить эти, по общему признанию, небольшие проблемы?

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

p1 <- ggplot(diamonds, aes(y=carat,x=price))
p1 <- p1 + geom_point(color="red")
p1 <- p1 + facet_wrap(~ color)
p1 <- p1 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA)) # use white theme and set bg to transparent so they can merge nice
#p1 <- p1 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) # remove gridlines
p1


p2 <- ggplot(diamonds, aes(x=price))
p2 <- p2 + geom_histogram( binwidth = 1000)
p2 <- p2 +  facet_wrap(~ color)
p2 <- p2 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA))
#p2 <- p2 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())

p2



## Putting plots together ##################
# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, grepl("panel",name) , se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grep("panel",g2$layout$name)], pp$t, 
                     pp$l, pp$b, pp$l)



# axis tweaks
ia <- which(grepl("axis_l",g2$layout$name) |  grepl("axis-l",g2$layout$name)     )
ga <- g2$grobs[ia]


axis_idx <- as.numeric(which(sapply(ga,function(x) !is.null(x$children$axis))))

for(i in 1:length(axis_idx)){
  ax <- ga[[axis_idx[i]]]$children$axis
  ax$widths <- rev(ax$widths)
  ax$grobs <- rev(ax$grobs)
  ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
  g <- gtable_add_cols(g, g2$widths[g2$layout[ia[axis_idx[i]], ]$l], length(g$widths) - 1)
  g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}



# Plot!
grid.newpage()
grid.draw(g)

facet_wrap с двойной осью


r ggplot2 gtable
person Jan Stanstrup    schedule 07.05.2015    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Вот твик, который вы сможете настроить дальше, чтобы вам было удобно. На разработку чего-то более точного и общего у меня ушло бы больше времени, чем у меня осталось на данный момент. Но я думаю, вам не составит труда сделать дополнительный шаг.

Первые несколько шагов остались без изменений.

Здесь я копирую вашу процедуру для двух верхних рядных панелей, не добавляя обратно настроенные оси внизу:

# do not add back the bottom lhs axis
for(i in 1:(length(axis_idx)-1)) {
    ax <- ga[[axis_idx[i]]]$children$axis
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
    g <- gtable_add_cols(g, 
        g2$widths[g2$layout[ia[axis_idx[i]], ]$l], length(g$widths) - 1)
    g <- gtable_add_grob(g, 
        ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}

Здесь я рассматриваю нижний ряд отдельно. Это то место, где я не стал обобщать. Вам нужно будет немного настроить расстояние между отметками и вертикальной осью. Вам также необходимо обобщить индексацию для случаев, когда есть только один график внизу, 2 графика и т. Д.

# Here I fix the index ``i`` to 3, to cater for your example.
i <- length(axis_idx)
    ax <- ga[[axis_idx[i]]]$children$axis
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
    g <- gtable_add_cols(g, g2$widths[3], 12)
    g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - 9, pp$b[axis_idx[i]])

Биты, которые необходимо обобщить, - это числа 12 и 9. Бит, который, вероятно, необходимо настроить, - это строка с unit(0.15, "cm"), чтобы получить больше места, чем кажется на данный момент.

Начнем с того, что ваш g объект имеет ширину 12, которая представляет собой панель 3 на 3 плюс 3 вертикальные оси. Затем вы добавляете столбец для второй оси и получаете ширину 15. Число 12 выбрано так, чтобы оно было справа на нижнем графике. Число 9 выбрано, чтобы разместить там вторую ось. Я думаю.

введите описание изображения здесь

person PatrickT    schedule 08.05.2015