我可以在 Shiny plot_ly 中“配對”跡線，以便在單擊圖例時出現/消失兩條跡線？

Question

我正在創建一個應用程序，其中有幾個變量的區域數據。 該應用程序允許您通過選擇輸入用戶想要可視化的區域來 select。 出於比較/信息的目的，我希望用戶在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