在闪亮的不同情节之间链接图例

Linking legends between separate plotly plots in shiny

是否可以 link 来自 Shiny 中不同情节的图例?我知道您可以 link 使用点击事件绘图,例如点击图表中的某些数据点,但我没有找到任何关于 linking 图例的信息。

我将有一个动态数量的地块,它们都具有相同的图例项,因此用户最好将 click/unclick 一个图例项 show/hide 所有link编辑情节。我最初有一个很好的 linked 使用情节子图的单一图例,但我无法在页面上很好地安排情节的位置、它们的标题和单一图例,因此我要回到有单独的地块。

我在下面插入了一个闪亮的应用程序示例,作为有关如何 link 传奇的建议的基础:

library(shiny)
library(plotly)

ui <- fluidPage(
    plotlyOutput("plot1"),
    plotlyOutput("plot2")  
)

server <- function(input, output) {
    
    output$plot1 <- renderPlotly({
       
        trace_0 <- rnorm(100, mean = 5)
        trace_1 <- rnorm(100, mean = 0)
        trace_2 <- rnorm(100, mean = -5)
        x <- c(1:100)
        
        data <- data.frame(x, trace_0, trace_1, trace_2)
        
        fig <- plot_ly(data, x = ~x) 
        fig <- fig %>% add_trace(y = ~trace_0, name = 'trace 0',mode = 'lines') 
        fig <- fig %>% add_trace(y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
        fig <- fig %>% add_trace(y = ~trace_2, name = 'trace 2', mode = 'markers')

    })
    
    output$plot2 <- renderPlotly({
        
        trace_0 <- rnorm(100, mean = 5)
        trace_1 <- rnorm(100, mean = 0)
        trace_2 <- rnorm(100, mean = -5)
        x <- c(1:100)
        
        data <- data.frame(x, trace_0, trace_1, trace_2)
        
        fig <- plot_ly(data, x = ~x) 
        fig <- fig %>% add_trace(y = ~trace_0, name = 'trace 0',mode = 'lines') 
        fig <- fig %>% add_trace(y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
        fig <- fig %>% add_trace(y = ~trace_2, name = 'trace 2', mode = 'markers')
        
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

您可以从其中一个地块(使用 plotly_restyle)访问 event_data,并通过 plotlyProxyInvoke 在另一个地块上重复它们,以下是一般性的 restyle解决方案,它也适用于跟踪可见性以外的其他参数:

library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2")
)

server <- function(input, output, session) {
  
  output$plot1 <- renderPlotly({
    
    trace_0 <- rnorm(100, mean = 5)
    trace_1 <- rnorm(100, mean = 0)
    trace_2 <- rnorm(100, mean = -5)
    x <- c(1:100)
    
    data <- data.frame(x, trace_0, trace_1, trace_2)
    
    fig <- plot_ly(data, type = "scatter", mode = 'markers', source = "p1Source") 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers') %>%
      event_register('plotly_restyle')
  })
  
  output$plot2 <- renderPlotly({
    
    trace_0 <- rnorm(100, mean = 5)
    trace_1 <- rnorm(100, mean = 0)
    trace_2 <- rnorm(100, mean = -5)
    x <- c(1:100)
    
    data <- data.frame(x, trace_0, trace_1, trace_2)
    
    fig <- plot_ly(data, type = "scatter", mode = 'markers', showlegend = FALSE) 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
    fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers')
    
  })
  
  plot2Proxy <- plotlyProxy("plot2", session)
  
  observe({
    restyle_events <- event_data(source = "p1Source", "plotly_restyle")
    plotlyProxyInvoke(plot2Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
    # plotlyProxyInvoke(plot2Proxy, "restyle", list(visible = FALSE), 1) # example usage
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)


如果您不想隐藏任何图例,您也可以将两个图的重新样式化事件提供给同一个源,这会导致相互更改:

library(shiny)
library(plotly)

ui <- fluidPage(
  plotlyOutput("plot1"),
  plotlyOutput("plot2")
)

server <- function(input, output, session) {
  
  trace_0 <- rnorm(100, mean = 5)
  trace_1 <- rnorm(100, mean = 0)
  trace_2 <- rnorm(100, mean = -5)
  x <- c(1:100)
  
  data <- data.frame(x, trace_0, trace_1, trace_2)
  
  fig <- plot_ly(data, type = "scatter", mode = 'markers', source = "mySource") 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_0, name = 'trace 0', mode = 'lines') 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_1, name = 'trace 1', mode = 'lines+markers') 
  fig <- fig %>% add_trace(x = ~x, y = ~trace_2, name = 'trace 2', mode = 'markers') %>%
    event_register('plotly_restyle')
  
  output$plot1 <- renderPlotly({
    fig
  })
  
  output$plot2 <- renderPlotly({
    fig
  })
  
  plot1Proxy <- plotlyProxy("plot1", session)
  plot2Proxy <- plotlyProxy("plot2", session)
  
  observe({
    restyle_events <- event_data(source = "mySource", "plotly_restyle")
    plotlyProxyInvoke(plot1Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
    plotlyProxyInvoke(plot2Proxy, "restyle", restyle_events[[1]], restyle_events[[2]])
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

以上是建立在跟踪 curveNumbers 匹配的假设之上的。如果跟踪需要按名称 plotly_legendclickplotly_legenddoubleclick 匹配,或者需要