如何在R的Plotly下拉联动柱状图中添加动态参考线？

使用R语言的Plotly库生成带下拉菜单的多组柱状图，数据集包含数百个变量，已通过自定义create_buttons函数实现自动下拉菜单，但切换变量时无法同步更新对应参考线。现有代码、示例数据集及参考线数据如下：

自定义按钮函数 #

create_buttons <- function(df, y_axis_var_names) {
  lapply(
    y_axis_var_names,
    FUN = function(var_name, df) {
      button <- list(
        method = 'restyle',
        args = list('y', list(df[, var_name])),
        label = sprintf(var_name)
      )
    },
    df
  )
}

示例数据集 #

test <- structure(list(YW = structure(1:58, .Label = c("47-2021", "48-2021", 
"49-2021", "50-2021", "51-2021", "52-2021", "1-2022", "2-2022", 
"3-2022", "4-2022", "5-2022", "6-2022", "7-2022", "8-2022", "9-2022", 
"10-2022", "11-2022", "12-2022", "13-2022", "14-2022", "15-2022", 
"16-2022", "17-2022", "18-2022", "19-2022", "20-2022", "21-2022", 
"22-2022", "23-2022", "24-2022", "25-2022", "26-2022", "27-2022", 
"28-2022", "29-2022", "30-2022", "31-2022", "32-2022", "33-2022", 
"34-2022", "35-2022", "36-2022", "37-2022", "38-2022", "39-2022", 
"40-2022", "41-2022", "42-2022", "43-2022", "44-2022", "45-2022", 
"46-2022", "47-2022", "48-2022", "49-2022", "50-2022", "51-2022", 
"52-2022"), class = "factor"), X1 = c(0, 0, 0, 2, 0, 2, 0, 6, 
3, 2, 2, 4, 0, 0, 0, 0, 2, 2, 2, 5, 2, 3, 2, 2, 2, 2, 0, 2, 0, 
0, 2, 4, 4, 2, 2, 0, 0, 0, 2, 0, 6, 4, 4, 6, 6, 13, 2, 2, 0, 
4, 2, 0, 3, 6, 4, 4, 0, 2), X2 = c(0, 0, 0, 2, 0, 2, 0, 6, 3, 
2, 2, 4, 0, 0, 0, 4, 10, 2, 2, 5, 2, 3, 2, 2, 2, 2, 0, 2, 0, 
0, 2, 4, 4, 2, 2, 0, 0, 2, 2, 0, 6, 6, 4, 6, 6, 13, 2, 2, 0, 
4, 2, 0, 3, 6, 4, 4, 0, 2), X3 = c(0, 0, 0, 2, 0, 2, 0, 6, 2, 
2, 2, 4, 2, 0, 0, 0, 2, 2, 2, 5, 2, 3, 2, 2, 2, 2, 0, 2, 0, 0, 
2, 4, 4, 4, 2, 0, 0, 0, 2, 0, 6, 4, 4, 6, 6, 13, 2, 2, 0, 4, 
4, 0, 3, 6, 4, 4, 0, 2), X4 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 
0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 2, 0, 0, 2, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0)), class = "data.frame", row.names = c(NA, -58L
))

初始绘图代码 #

p = plot_ly(data = test, x=~YW, y= ~X1 ,type ="bar", width = 1500, height = 500 )%>%
  config(locale = 'fr')%>%
  layout(autosize=T,
         title = "",
         xaxis = list(title = "Weeks"),
         yaxis = list(title = "Frequency"),
         updatemenus = list(
           list(y = 0.7,
                buttons = create_buttons(test, names(test[,!names(test) %in% "YW"])))))

参考线数据框 #

lines_x = data.frame(X1 = 5, X2 = 3, X3 = 4, X4 = 1)

期望实现下拉切换变量时，柱状图和参考线同步更新，效果类似：

plot_ly(data = test, x=~YW, y= ~X1 ,type ="bar", width = 1500, height = 500 )%>%
  add_lines(y= lines_x$X1)

要实现柱状图与参考线的同步切换，需修改按钮函数的更新逻辑，让每个按钮同时更新柱状图和参考线的y值，同时初始化图表时添加参考线图层。

1. 修改create_buttons函数 #

调整按钮的args参数，指定同时更新第0个trace（柱状图）和第1个trace（参考线）的y值：

create_buttons <- function(df, y_axis_var_names, lines_df) {
  lapply(
    y_axis_var_names,
    FUN = function(var_name, df, lines_df) {
      # 将参考线值重复成与x轴长度一致的向量
      line_val <- rep(lines_df[[var_name]], nrow(df))
      button <- list(
        method = 'restyle',
        # 依次更新柱状图（trace 0）和参考线（trace 1）的y值
        args = list('y', list(df[, var_name], line_val)),
        label = var_name
      )
    },
    df, lines_df
  )
}

2. 初始化包含参考线的图表 #

初始绘图时先添加柱状图，再添加初始参考线，确保trace顺序正确：

# 初始化图表，先添加柱状图
p <- plot_ly(data = test, x = ~YW, y = ~X1, type = "bar", width = 1500, height = 500) %>%
  # 添加初始参考线，对应X1的参考值
  add_lines(y = rep(lines_x$X1, nrow(test)), 
            name = "Reference Line",
            line = list(color = "red", dash = "dash")) %>%
  config(locale = 'fr') %>%
  layout(autosize = T,
         title = "",
         xaxis = list(title = "Weeks"),
         yaxis = list(title = "Frequency"),
         updatemenus = list(
           list(y = 0.7,
                buttons = create_buttons(test, names(test[,!names(test) %in% "YW"]), lines_x))))

现在运行代码，切换下拉菜单时，柱状图和红色虚线参考线会同步更新为对应变量的数据和参考值。

内容的提问来源于stack exchange，提问作者AnonX