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

我需要编写一个函数，使我可以使用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是反向的(函数在减少，绘制的函数在增加，反之亦然)，因此会产生误导。

最佳答案

这是在两个斜率之间设置最小可接受比率的方法。如果比率较小，则不会对斜率进行变换，而只会对水平进行变换，从而避免像您描述的那样过度误导图表。

我将阈值设置为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)

关于r - 在ggplot2中具有自动计算的sec_axis公式的双轴图，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/56426472/