合并多个情节图并保持交互性

Question

我有一个包含多个组的曲线图。每个组由一条线和一种颜色表示。由于有很多组，我只想在默认情况下显示一些行。其余的行应该默认隐藏，但用户应该能够通过图例激活它们来使它们可见。

我设法创建了一个完全符合我所描述的情节。不幸的是，生成该图需要大量冗余代码，因为我必须单独添加每一行。

我正在寻找的是一种使用更少冗余代码生成相同情节（保持交互性）的方法。我正在考虑lapply 解决方案，但我不知道如何将生成的图再次合并为一个图。

这是我到目前为止所做的......如果有人可以给我一个提示，我将不胜感激:)

# Init
"%>%" <- magrittr::"%>%"

# some data
dat <- dplyr::tibble(CAT=rep(LETTERS[1:3],each=10),
                     DATE=rep(1:10,length.out=30) %>%
                         lubridate::as_date(),
                     PCT=runif(30,min=0,max=1))

# transform tibble into list (by group)
dat_list <- dat %>%
    dplyr::group_by(CAT) %>%
    dplyr::group_split()

# plot data: what I am doing 
plotly::plot_ly(type="scatter",
                mode="line+marker") %>%
plotly::add_trace(data=dat %>%
                      dplyr::filter(CAT=="A"),
                  x=~DATE,
                  y=~PCT,
                  color=~CAT,
                  visible=TRUE)  %>%
    plotly::add_trace(data=dat %>%
                          dplyr::filter(CAT=="B"),
                      x=~DATE,
                      y=~PCT,
                      color=~CAT,
                      visible="legendonly")  %>%
    plotly::add_trace(data=dat %>%
                          dplyr::filter(CAT=="B"),
                      x=~DATE,
                      y=~PCT,
                      color=~CAT,
                      visible="legendonly") 
    
# plot data: what I want to do 
    lapply(dat_list, function(f){
        if (f$CAT=="A"){
            vis <- TRUE
        } else {
            vis <- "legendonly"
        }
        plotly::plot_ly(type="scatter",
                        mode="line+marker") %>%
        plotly::add_trace(data=f,
                          x=~DATE,
                          y=~PCT,
                          color=~CAT,
                          visible=vis)
    }) %>% 
    magic_merge_plots_function()

Answer 1

您不需要magic_merge_plots_function。如果您将最初的 plot_ly 部分放在 lapply 函数之外并将跟踪添加到该图中，这就足够了。

让我们试试这个。

p <- plotly::plot_ly(type="scatter",
                     mode="line+marker")


lapply(dat_list, function(f) {
  
  vis <- ifelse(unique(f[, "CAT"]) == "A", TRUE, "legendonly")
  
  p <<- get("p") %>% 
    add_trace(p, data = f, 
              x = ~DATE,
              y = ~PCT,
              color = ~CAT,
              visible = vis)  
})