Как использовать грани с двойной осью ggplot

Ответ 1

EDIT: ОБНОВЛЕНО ДЛЯ GGPLOT 2.2.0
Но ggplot2 теперь поддерживает вторичные оси y, поэтому нет необходимости в манипулировании с grob. См. Решение @Axeman.

facet_grid и facet_wrap генерируют разные наборы имен для панелей сюжетов и левых осей. Вы можете проверить имена, используя g1$layout, где g1 <- ggplotGrob(p1), а p1 сначала нарисован с помощью facet_grid(), затем второй с facet_wrap(). В частности, при facet_grid() панели сюжетов называются "панель", тогда как facet_wrap() имеют разные имена: "панель-1", "панель-2" и т.д. Итак, такие команды:

pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[which(g2$layout$name == "panel")], pp$t,
                     pp$l, pp$b, pp$l)

завершится с использованием графиков, созданных с помощью facet_wrap. Я бы использовал регулярные выражения для выбора всех имен, начинающихся с "panel". Аналогичные проблемы с "осью-1".

Кроме того, ваши команды по настройке оси работали для более старых версий ggplot, но с версии 2.1.0 метки не совсем соответствуют правому краю графика, а метки и метки метки тоже Близко к друг другу.

Вот что я сделал бы (рисуя код из здесь, который, в свою очередь, рисует код из здесь и из пакет cowplot).

# Packages
library(ggplot2)
library(gtable)
library(grid)
library(data.table)
library(scales)

# Data 
dt.diamonds <- as.data.table(diamonds)
d1 <- dt.diamonds[,list(revenue = sum(price),
                        stones = length(price)),
                  by=c("clarity", "cut")]
setkey(d1, clarity, cut)

# The facet_wrap plots
p1 <- ggplot(d1, aes(x = clarity, y = revenue, fill = cut)) +
  geom_bar(stat = "identity") +
  labs(x = "clarity", y = "revenue") +
  facet_wrap( ~ cut, nrow = 1) +
  scale_y_continuous(labels = dollar, expand = c(0, 0)) + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1),
        axis.text.y = element_text(colour = "#4B92DB"), 
        legend.position = "bottom")

p2 <- ggplot(d1, aes(x = clarity, y = stones, colour = "red")) +
  geom_point(size = 4) + 
  labs(x = "", y = "number of stones") + expand_limits(y = 0) +
  scale_y_continuous(labels = comma, expand = c(0, 0)) +
  scale_colour_manual(name = '', values = c("red", "green"), labels = c("Number of Stones"))+
  facet_wrap( ~ cut, nrow = 1) +
  theme(axis.text.y = element_text(colour = "red")) +
  theme(panel.background = element_rect(fill = NA),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_rect(fill = NA, colour = "grey50"),
        legend.position = "bottom")


# Get the ggplot grobs
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

# Get the locations of the plot panels in g1.
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r))

# Overlap panels for second plot on those of the first plot
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)], 
      pp$t, pp$l, pp$b, pp$l)


# ggplot contains many labels that are themselves complex grob; 
# usually a text grob surrounded by margins.
# When moving the grobs from, say, the left to the right of a plot,
# Make sure the margins and the justifications are swapped around.
# The function below does the swapping.
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R 

hinvert_title_grob <- function(grob){

  # Swap the widths
  widths <- grob$widths
  grob$widths[1] <- widths[3]
  grob$widths[3] <- widths[1]
  grob$vp[[1]]$layout$widths[1] <- widths[3]
  grob$vp[[1]]$layout$widths[3] <- widths[1]

  # Fix the justification
  grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust 
  grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust 
  grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
  grob
}

# Get the y axis title from g2
index <- which(g2$layout$name == "ylab-l") # Which grob contains the y axis title?   EDIT HERE
ylab <- g2$grobs[[index]]                # Extract that grob
ylab <- hinvert_title_grob(ylab)         # Swap margins and fix justifications

# Put the transformed label on the right side of g1
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], max(pp$r))
g <- gtable_add_grob(g, ylab, max(pp$t), max(pp$r) + 1, max(pp$b), max(pp$r) + 1, clip = "off", name = "ylab-r")

# Get the y axis from g2 (axis line, tick marks, and tick mark labels)
index <- which(g2$layout$name == "axis-l-1-1")  # Which grob.    EDIT HERE
yaxis <- g2$grobs[[index]]                    # Extract the grob

# yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
# The relevant grobs are contained in axis$children:
#   axis$children[[1]] contains the axis line;
#   axis$children[[2]] contains the tick marks and tick mark labels.

# First, move the axis line to the left
# But not needed here
# yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))

# Second, swap tick marks and tick mark labels
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)

# Third, move the tick marks
# Tick mark lengths can change. 
# A function to get the original tick mark length
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R 
plot_theme <- function(p) {
  plyr::defaults(p$theme, theme_get())
}

tml <- plot_theme(p1)$axis.ticks.length   # Tick mark length
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml

# Fourth, swap margins and fix justifications for the tick mark labels
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])

# Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks

# Put the transformed yaxis on the right side of g1
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], max(pp$r))
g <- gtable_add_grob(g, yaxis, max(pp$t), max(pp$r) + 1, max(pp$b), max(pp$r) + 1, 
   clip = "off", name = "axis-r")

# Get the legends
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]

# Combine the legends
g$grobs[[which(g$layout$name == "guide-box")]] <-
    gtable:::cbind_gtable(leg1, leg2, "first")

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

Ответ 2

Теперь, когда ggplot2 имеет поддержку вторичной оси, во многих (но не во всех) случаях это стало намного проще. Никаких манипуляций с grob не требуется.

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

library(tidyverse)

max_stones <- max(d1$stones)
max_revenue <- max(d1$revenue)

d2 <- gather(d1, 'var', 'val', stones:revenue) %>% 
  mutate(val = if_else(var == 'revenue', as.double(val), val / (max_stones / max_revenue)))

ggplot(mapping = aes(clarity, val)) +
  geom_bar(aes(fill = cut), filter(d2, var == 'revenue'), stat = 'identity') +
  geom_point(data = filter(d2, var == 'stones'), col = 'red') +
  facet_grid(~cut) +
  scale_y_continuous(sec.axis = sec_axis(trans = ~ . * (max_stones / max_revenue),
                                         name = 'number of stones'),
                     labels = dollar) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1),
        axis.text.y = element_text(color = "#4B92DB"),
        axis.text.y.right = element_text(color = "red"),
        legend.position="bottom") +
  ylab('revenue')

Он также отлично работает с facet_wrap:

Другие осложнения, такие как scales = 'free' и space = 'free', также легко выполняются. Единственное ограничение состоит в том, что соотношение между двумя осями равно для всех граней.