使用 Plotly 自动创建下拉菜单按钮

Question

我有一个数据框，列出了 5 年来与 49 个不同委员会进行的个人参与的数量。下面提供了类别数量减少的示例：

library(dplyr)
df <- data.frame(Year = c(2019, 2020, 2021, 2022, 2023),
                 Committees = c("House Foreign Affairs",
                                "House Foreign Affairs",
                                "House Foreign Affairs",
                                "House Foreign Affairs",
                                "House Foreign Affairs",
                                "House Judiciary",
                                "House Judiciary",
                                "House Judiciary",
                                "House Judiciary",
                                "House Judiciary",
                                "Senate Appropriations",
                                "Senate Appropriations",
                                "Senate Appropriations",
                                "Senate Appropriations",
                                "Senate Appropriations",
                                "Senate Oversight",
                                "Senate Oversight",
                                "Senate Oversight",
                                "Senate Oversight",
                                "Senate Oversight"), 
                 n = c(4,8,4,6,2,7,4,8,2,8,1,4,3,6,4,8,4,3,8,7))

df <- df %>% 
  mutate(across(c(1:2), factor)) %>%
  arrange(Year)

我用下面的代码绘制了一个图表来可视化这五年总参与度的变化：

library(ggplot2)
plot <- df %>%
ggplot(aes(Year, n, group = Committees, color = Committees)) +
  geom_line() +
  geom_point() +
  theme_bw ()

这看起来已经相当混乱了，有 49 个类别，原始数据的图看起来像这样。

因此，我试图将绘图转换为绘图，以使线条更加明显，将图例压缩为下拉列表，并为我的用户提供一定程度的交互性。

library(plotly)
plot %>%
  ggplotly(x = ~date, y = ~median,
           split = ~city,
           frame = ~frame,  
           type = 'scatter',
           mode = 'lines')

现在的问题是，使用here提供的代码制作 4 个类别的按钮非常简单。另外，这个答案解决了必须为每个类别创建 49 个不同按钮的问题，并且这个答案进一步扩展了它。然而，我不太熟悉情节，我基于这些答案构建的代码只是输出：

Error in df[, var_name] : incorrect number of dimensions

这就是我最终的结果。如果您有更好的方法使图形具有交互性并允许选择单条线，请随时提出建议。

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

y_axis_var_names <- c("House Foreign Affairs",
                        "House Judiciary",
                        "Senate Appropriations",
                        "Senate Oversight")

plot %>%
  ggplotly(x = ~date, y = ~median,
           split = ~city,
           frame = ~frame,  
           type = 'scatter',
           mode = 'lines') %>%
  layout(xaxis = list(domain = c(0.1, 1)),
         yaxis = list(title = "y"),
         updatemenus = list(
      list(
        y = 0.7,
        buttons = create_buttons(plot, y_axis_var_names))))

Answer 1

一般问题

您的代码存在一个重大问题，特别是您对

ggplotly

的使用：

这个想法是，你将一个

ggplot

对象传递给它，它会将其转换为

plotly

对象。

函数

plot_ly

另一方面从数据创建一个

plotly

对象，您必须指定什么映射到什么。

您的用法看起来像后者（即自己映射），但这里使用

ggplotly

是错误的。顺便说一句，这就是为什么尽管缺少一些所需的列却可以重现该示例的原因，因为

ggplotly

拥有来自

ggplot

对象所需的所有信息，并选择忽略无论如何都无法解析的其他参数（

city

、

frame

、

median

在您的示例中没有定义）

潜在的解决方案

据我了解：您想要一个下拉菜单，您可以用它来选择要绘制的线？如果是这种情况，您确实可以使用一些自定义 UI 元素来执行此操作，以下是如何执行此操作的示例：

library(plotly)

set.seed(29022024)
ex <- expand.grid(year = 2019:2023, cat = LETTERS)
ex$n <- rpois(nrow(ex), 10)


## All categories look cramped

plot_ly(ex) %>%
    add_trace(x = ~ year, y = ~ n, color = ~ cat, type = "scatter", mode = "line",
              colors = "viridis")

## Add Buttons to Toggle Traces
ply <- plot_ly(ex) %>%
    add_trace(x = ~ year, y = ~ n, color = ~ cat, type = "scatter", mode = "line",
              colors = "viridis", visible = ~ cat %in% LETTERS[1:5])
 
btns <- lapply(levels(ex$cat), \(.x) {
  list(method = "restyle",
       label = paste("Toggle", .x),
       args = list(list(visible = !.x %in% LETTERS[1:5]), 
                        list(which(levels(ex$cat) == .x) - 1L)),
       args2 = list(list(visible = .x %in% LETTERS[1:5]), 
                         list(which(levels(ex$cat) == .x) - 1L)))
})

ply %>%
  layout(
    updatemenus = list(
      list(
        y = 0.8,
        yanchor = "top",
        buttons = btns
      )
    )
  )

单击相应按钮即可隐藏/显示轨迹。一开始我只显示前 5 条痕迹，以便从头开始整理。然后，使用按钮我可以决定添加删除痕迹。