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)

Answer 2

允许辅助轴（from version 2.2 on）的ggplot功能主要是标记优势。您仍然必须将辅助数据投影到适当的范围内。我认为最简单，最安全的方法是最小到最大转换，使用范围为：

将第二个系列投影到第一个系列的范围以绘制点。
以其他方式投影标签。

请注意，有许多方法会以自己的方式误导您，包括即使第二变量将使用整个范围作为第二变量的事实绝对不应该。保重。

没有功能的简单代码

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 here的详细信息。

欢迎发表评论。

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

2 个答案:

没有功能的简单代码

使用tidyeval函数的动态代码

示例输出