我可以在不使用 Shiny 或 Plotly 的情况下在 R 中使用下拉菜单制作线图吗？

Question

我想制作一个简单的销售报告折线图，从下拉菜单中显示给定产品在一段时间内的产品销售情况。我已经使用plotly和shiny做了一个报告，但是我找不到一种方法可以与我的同事分享报告，而不必使用Shiny Server或Shinyapps.IO。理想情况下，我想要一个独立的 html 文件，但我找不到将交互式图形插入 R Markdown 的方法。

这是一个示例数据框：

df = data.frame(month=rep_len(1:12, length.out=12*5), product=rep(1:5, each=12),sales=rnorm(12*5,100,50)) 

以下建议几乎有效，但下拉列表与正确的变量不对应

set.seed(42)
library(plotly)

## Create random data. cols holds the parameter that should be switched
l <- lapply(1:100, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:100)
colnames(df) <- cols
df[["c"]] <- 1:100


p <- plot_ly(df,
      type = "scatter",
      mode = "lines") %>% 
      add_lines(x = ~c, y=~df[[cols[[1]]]], name = cols[[1]])
## Add arbitrary number of traces
for (col in cols) {
  p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = FALSE)
}
p <- p %>%
    layout(
      title = "Dropdown line plot",
      xaxis = list(title = "x"),
      xaxis = list(title = "y"),
      updatemenus = list(
        list(
            y = 0.7,
            ## Add all buttons at once
            buttons = lapply(cols, function(col) {
              list(method="restyle", 
                args = list(
                  "visible", cols == col),
                  label = col)
            })
        )
      )
    )

print(p)

选择变量 b2 显示 a1 和 v100 的行。

选择 c3 时显示 a1 的行，b2 的 d4 行等。似乎顺序移位了 2 列。

Answer 1

以下示例完全符合您的要求，可以嵌入到 RMarkdown 中，然后转换为可以离线查看或托管在服务器上的独立 HTML 页面：

## Create random data. cols holds the parameter that should be switched
l <- lapply(1:100, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:100)
colnames(df) <- cols
df[["c"]] <- 1:100

## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
      type = "scatter",
      mode = "lines",
      x = ~c, 
      y= ~df[[cols[[1]]]], 
      name = cols[[1]])
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[-1]) {
  p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = FALSE)
}

p <- p %>%
    layout(
      title = "Dropdown line plot",
      xaxis = list(title = "x"),
      yaxis = list(title = "y"),
      updatemenus = list(
        list(
            y = 0.7,
            ## Add all buttons at once
            buttons = lapply(cols, function(col) {
              list(method="restyle", 
                args = list("visible", cols == col),
                label = col)
            })
        )
      )
    )

print(p)