在ggplot2中自动计算sec_axis公式的双轴图表

Question

我需要编写一个函数，使用ggplot2可以快速地绘制双轴图。我知道双轴图通常已经被弃用了，但如果你想观察时间序列中的相似模式，它仍然可能会有用（对于所有不同意的人，请严格技术对待这个问题）。实际上，使用ggplot2的sec_axis()函数是可行的，但需要定义公式。因此，这是我尝试自动计算的结果：

dual_plot <- function(data, x, y_left, y_right){
  x <- ensym(x)
  y_left <- ensym(y_left)
  y_right <- ensym(y_right)

  ratio_model <- lm(eval(y_left) ~ eval(y_right), data = data)

  data %>% 
    select(!!x, !!y_left, !!y_right) %>% 
    mutate(!!y_right := predict(ratio_model)) %>% 
    gather(k, v, -!!x) %>% 
    ggplot() + 
    geom_line(aes(!!x, v, colour = k)) +
    scale_y_continuous(sec.axis = sec_axis(~ . / ratio_model$coefficients[[2]] -
                                             ratio_model$coefficients[[1]],
                                           name = rlang::as_string(y_right))) + 
    labs(y = rlang::as_string(y_left))
}

然而， lm 可能适合一个反向趋势系数，使趋势相反，这真的很误导。因此，我需要另一种方法来计算这个公式 - 要么使用带有系数限制的线性回归，要么使用巧妙的方法来拟合公式。如何在 R 中实现？或者替代 sec_axis 的选择，可以自动绘制双轴图？

@编辑：一个例子是：

df <- structure(list(date = structure(c(17167, 17168, 17169, 17170, 
17171, 17172, 17173, 17174, 17175, 17176, 17177, 17178, 17179, 
17180, 17181), class = "Date"), y_right = c(-107073.90734625, 
-633197.630546488, -474626.43291613, -306006.801458608, 56062.072352192, 
522580.236751187, 942796.389093215, -101845.73678439, -632658.677118481, 
-479257.088784885, -303439.231633988, 50273.2477880417, 521669.062954895, 
948127.92455586, -107073.90734625), y_left = c(1648808.16, 3152543.07, 
2702739.91, 2382616.25, 1606089.88, 1592465.75, 1537283.99, 2507221.61, 
3049076.19, 3125424.4, 2774215.1, 2356412.98, 1856506.41, 1477195.08, 
2485713.2)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-15L))

df %>% 
  dual_plot(date, y_left, y_right)

计算出的比率模型具有方向系数-1.02，因此y_right被反转（在函数下降时，绘制的函数上升，反之亦然），从而会产生误导。

- jakes

Answer 1

这里有一种方法，它设定了两个斜率之间的最小可接受比率；如果比率较小，则不会转换斜率而只是调整水平，从而避免出现过于误导的图表，就像您描述的那个一样。

我将阈值设置为0.1，但如果您只想避免这里特定的情况，则可以将其设置为0，即不希望翻转第二个系列以使其对齐。

dual_plot <- function(data, x, y_left, y_right){
  x <- ensym(x)
  y_left <- ensym(y_left)
  y_right <- ensym(y_right)

  min_slope_ratio <- 0.1
  ratio_model <- lm(eval(y_left) ~ eval(y_right), data = data)
  ratio_slope <- ratio_model$coefficients[[2]]

  if (ratio_model$coefficients[[2]] < min_slope_ratio) {
    ratio_model <- lm(eval(y_left) ~ 1, data = data)
    ratio_slope <- min_slope_ratio
  }
  ratio_intercept <- ratio_model$coefficients[[1]]


  data %>%
    select(!!x, !!y_left, !!y_right) %>%
    mutate(!!y_right := !!y_right * ratio_slope + ratio_intercept) %>%
    # mutate(!!y_right := predict(ratio_model)) %>%
    gather(k, v, -!!x) %>%
    ggplot() +
    geom_line(aes(!!x, v, colour = k)) +
    scale_y_continuous(sec.axis = sec_axis(~ . / ratio_slope -
                                             ratio_intercept,
                                           name = rlang::as_string(y_right))) +
    labs(y = rlang::as_string(y_left))
}

在这里，触发了限制条件，我们避免了第二个系列的翻转

df %>% 
  dual_plot(date, y_left, y_right)

df %>%
  mutate(y_right = -1 * y_right) %>%
  dual_plot(date, y_left, y_right)

- Jon Spring

Answer 2

从版本2.2开始，ggplot拥有允许使用次要轴的功能（），但这主要是用来标注的。你仍然需要将你的次要数据投影到正确的范围上。我认为最简单最安全的方法是进行极差转换，使用下列范围：

1. 将第二个系列投射到第一个系列的范围以绘制点。
2. 向另一个方向重新投射以获得标签。

请注意，这种方法有很多误导性，包括它将使用次要变量的全部范围，即使它明显不应该。小心谨慎。

不带函数的简单代码

df %>%
  select(date, y_left, y_right) %>%
  mutate(y_right = scales::rescale(y_right, to=range(df$y_left))) %>%
  gather(key, value, -date) %>%
  ggplot() +
  geom_line(aes(x = date, y = value, color = key)) +
  scale_y_continuous(sec.axis = sec_axis(~ scales::rescale(., to=range(df$y_right)),
                              name = "Right side")) +
  labs(y = "Left side",
       color = "Series")

使用tidyeval函数的动态代码

我尝试保留您的代码，并专注于使用 scales::rescale 将一个范围映射到另一个范围。

library(scales)
library(tidyverse)

dual_plot <- function(data, x, y_left, y_right) {
  x <- ensym(x)
  y_left <- ensym(y_left)
  y_right <- ensym(y_right)

  # Introducing ranges
  left_range <- range(data %>% pull(!!y_left))
  right_range <- range(data %>% pull(!!y_right))

  data %>%
    select(!!x, !!y_left, !!y_right) %>%
    # Transform
    mutate(!!y_right := scales::rescale(!!y_right, to=left_range)) %>%
    gather(k, v, -!!x) %>%
    ggplot() +
    geom_line(aes(!!x, v, colour = k)) +
    # Change secondary axis scaling and label
    scale_y_continuous(sec.axis = sec_axis(~ scales::rescale(., to=right_range),
                                           name = rlang::as_string(y_right))) +
    labs(y = rlang::as_string(y_left),
         color = "Series")
}

示例输出

我认为这个输出与其他答案不同，保留了数据和主要变量及其轴以及次要变量和其轴的范围的本质。

df %>%
  dual_plot(date, y_left, y_right)

有关SO更详细的信息，请查看这里。

欢迎评论。

- ravic_

---

我喜欢这个方法。但是有没有办法将这种方法扩展到使用 facets 呢？就像 y_left 是稳定的，但是 y_right 在不同的 facets 中会发生变化。我们可以使用 mutate_at(vars(!!!y_right), ~scales::rescale(.x, to = left_range)) 来缩放 y_right 变量，但是在 sec_axis 内进行相反的缩放并不那么清晰。 - jakes

我认为这个在facets中还不太适用。首先，当scales = "free_y"时，次要轴没有更新的bug存在（将进行研究，然后提交）。然后有像你描述的控制问题，你可能只想释放次要轴。在这种方法中，我会为每个组创建一个图，并使用ggarrange或类似的工具将它们放在单个图中。肯定不是理想的解决方案。我会在我的答案中更新这个注意事项。 - ravic_