r - 我可以在 Shiny plot_ly 中设置 "pair"轨迹，以便在单击图例时两条轨迹出现/消失吗？

Question

我正在创建一个应用程序，其中包含一些变量的区域数据。该应用程序允许您通过 selectInput 选择用户想要可视化的区域。出于比较/信息目的，我希望用户在 plot_ly 中可视化所选区域以及全国平均水平。

但是，我希望 plot_ly 图例表现得好像区域数据与国家比较“配对”——即，如果单击区域 Var1 轨迹，国家比较应该也消失了。

有没有办法在 Shiny/plotly 中做到这一点？老实说，除了检查设置“doubleclickedLegendItem”和 clickedLegendItem 之外，我没有发现任何其他内容，但我不知道如何配对痕迹，然后复制典型的图例行为。

或者，如果这不可能，是否可以仅在将鼠标悬停在区域轨迹上时显示国家比较轨迹？这也是一个可以接受的解决方案。

这是我的应用程序的一个非常简单的示例:

(目前正在此处开发完整的应用程序，第二个选项卡:https://iseak.shinyapps.io/_funciona/)

library(shiny)
library(plotly)
library(dplyr)

set.seed(12345)

df <-  data.frame(
  Region = c(rep("National", 3),
             rep("Region1", 3),
             rep("Region2", 3)),
  
  Year   = c(rep(2018:2020,3)),
  
  Var1   = c(rnorm(3),
             rnorm(3,1),
             rnorm(3,2)),
  
  Var2   = c(rnorm(3),
             rnorm(3,3),
             rnorm(3,5))
)

linecolors <- c("blue", "green")

ui = fluidPage(
  
  selectInput("region_sel",
                 label   = "Select a region:",
                 choices = c("Region1", "Region2")
             ),
  
  plotlyOutput("plot")
  
  
  
)

server =  function(input, output, session) {
  
  subset_data_region <- reactive({
    temp_df <- df[df$Region==input$region_sel,]
    return(temp_df)
      
  })
  
  subset_data_nat <- df[df$Region=="National",]
  
  output$plot = renderPlotly({
    
    plot_ly(type = 'scatter',
                  mode = 'lines+markers') %>% 
        #regional traces
            add_trace(data = subset_data_region(),
                      y = ~Var1,
                      x = ~Year,
                      name = "Var1",
                      line = list(color = linecolors[1]),
                      marker = list(color = linecolors[1])
            ) %>%
            add_trace(data = subset_data_region(),
                      y = ~Var2,
                      x = ~Year,
                      name = "Var2",
                      line = list(color = linecolors[2]),
                      marker = list(color = linecolors[2])
            ) %>%
        #national traces for comparison
            add_trace(data = subset_data_nat,
                      y = ~Var1,
                      x = ~Year,
                      name = "Var1",
                      line = list(color = linecolors[1],
                                  dash = "dash"),
                      marker = list(color = linecolors[1]),
                      showlegend = F
            ) %>%
            add_trace(data = subset_data_nat,
                      y = ~Var2,
                      x = ~Year,
                      name = "Var2",
                      line = list(color = linecolors[2],
                                  dash = "dash"),
                      marker = list(color = linecolors[2]),
                      showlegend = F
            )

  })
  
  
}

shinyApp(ui = ui, server = server)

预先感谢您提出任何建议。

Answer 1

以防万一这对某人有帮助，我在这里找到了答案:是的，可以使用 legendgroup 选项:

library(shiny)
library(plotly)
library(dplyr)

set.seed(12345)

df <-  data.frame(
  Region = c(rep("National", 3),
             rep("Region1", 3),
             rep("Region2", 3)),
  
  Year   = c(rep(2018:2020,3)),
  
  Var1   = c(rnorm(3),
             rnorm(3,1),
             rnorm(3,2)),
  
  Var2   = c(rnorm(3),
             rnorm(3,3),
             rnorm(3,5))
)

linecolors <- c("blue", "green")

ui = fluidPage(
  
  selectInput("region_sel",
              label   = "Select a region:",
              choices = c("Region1", "Region2")
  ),
  
  plotlyOutput("plot")
  
  
  
)

server =  function(input, output, session) {
  
  subset_data_region <- reactive({
    temp_df <- df[df$Region==input$region_sel,]
    return(temp_df)
    
  })
  
  subset_data_nat <- df[df$Region=="National",]
  
  output$plot = renderPlotly({
    
    plot_ly(type = 'scatter',
            mode = 'lines+markers') %>% 
      #regional traces
      add_trace(data = subset_data_region(),
                y = ~Var1,
                x = ~Year,
                name = "Var1",
                line = list(color = linecolors[1]),
                marker = list(color = linecolors[1]),
                legendgroup="group1"
      ) %>%
      add_trace(data = subset_data_region(),
                y = ~Var2,
                x = ~Year,
                name = "Var2",
                line = list(color = linecolors[2]),
                marker = list(color = linecolors[2]),
                legendgroup="group2"
      ) %>%
      #national traces for comparison
      add_trace(data = subset_data_nat,
                y = ~Var1,
                x = ~Year,
                name = "Var1",
                line = list(color = linecolors[1],
                            dash = "dash"),
                marker = list(color = linecolors[1]),
                legendgroup="group1",
                showlegend = F
      ) %>%
      add_trace(data = subset_data_nat,
                y = ~Var2,
                x = ~Year,
                name = "Var2",
                line = list(color = linecolors[2],
                            dash = "dash"),
                marker = list(color = linecolors[2]),
                legendgroup="group2",
                showlegend = F
      )
    
  })
  
  
}

shinyApp(ui = ui, server = server)

这是包含更多信息的链接: https://plotly.com/r/legend/#grouped-legend