r - ggplot2 中自动计算 sec_axis 公式的双轴图

Question

我需要编写一个函数，让我可以使用 ggplot2 快速绘制双轴图。我知道双轴图通常已被弃用，但我仍然认为如果您在时间序列中观察到类似的模式后它可能会有用(对于所有不同意的人，请严格从技术上处理这个问题)。实际上可以使用 sec_axis() 函数来自 ggplot2 ，但它需要一个定义的公式。所以这是我尝试自动计算:

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 允许自动绘制双轴图的替代方法是什么？

@Edit:一个例子是:

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 是反向的(函数正在减少，绘制的函数正在增加，反之亦然)，因此会产生误导。

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)