当迹线处于“legendonly”状态时隐藏辅助 Y 轴

Question

我有一个 R Shiny 应用程序，在其中我正在渲染带有几条痕迹的绘图。其中一条迹线使用图右侧的辅助 Y 轴：

library(plotly)
data(mtcars)

ui <- fluidPage( plotlyOutput("scatterPlot"))
server <- function(input, output) {
  
  ay <- list(overlaying = "y", side = "right", title = "Hide me please", automargin = TRUE)
  
  output$scatterPlot <- renderPlotly({
    p <- plot_ly(type = "scatter", mode = "markers") %>% 
      add_trace(data = mtcars, x = ~mpg, y = ~hp) %>%
      add_trace(data = mtcars, x = ~mpg, y = ~wt, yaxis = "y2") %>% 
      layout(legend = list(orientation = "v"),
             yaxis2 = ay)
    
    return(p)
  })
}

shinyApp(ui, server)

期望的结果：通过单击图例条目打开和关闭第二条迹线时，绘图应更新，并且辅助轴应相应地关闭/打开

经过一番研究，我偶然发现了这篇文章。我只有非常基本的 JS 知识，但使用它我成功地创造了我可以观察到的值：

js <- "function(el, x){
    el.on('plotly_legendclick', function(evtData) {
    Shiny.setInputValue('trace', evtData.curveNumber);
    });


    el.on('plotly_restyle', function(evtData) {
    Shiny.setInputValue('visibility', evtData[0].visible);
    });
  }"

在服务器中。R:

p %>% onRender(js)

这样我就知道哪条轨迹 (

input$trace

) 具有哪个可见性 (

input$visibility

)。

有没有一种方法可以根据 R 中的这些值动态切换 Shiny 应用程序中渲染图中的辅助轴的开和关？

Answer 1

在 Jan 发表第一条评论后，我就解决了这个问题。

以下代码生成一个图，其中如果在图例中取消选择第二条迹线，则辅助轴将被删除。

library(plotly)
library(shiny)
library(htmlwidgets)
data(mtcars)

ui <- fluidPage(plotlyOutput("scatterPlot"))

# JS code which listens to events in the plot
js <- "function(el, x){
    # which trace clicked on in legend?
    el.on('plotly_legendclick', function(evtData) {
    Shiny.setInputValue('trace', evtData.curveNumber);
    });

    # is clicked trace now visible or legendonly?
    el.on('plotly_restyle', function(evtData) {
    Shiny.setInputValue('visibility', evtData[0].visible);
    });
  }"

server <- function(input, output, session) {

  # defining secondary axis
  ay <- list(overlaying = "y",
             side = "right",
             title = "Hide me please",
             automargin = TRUE)

  # render the plot with the JS code from above
  output$scatterPlot <- renderPlotly({
    p <- plot_ly(type = "scatter", mode = "markers") %>%
      add_trace(data = mtcars, x = ~mpg, y = ~hp) %>%
      add_trace(data = mtcars, x = ~mpg, y = ~wt, yaxis = "y2") %>%
      layout(legend = list(orientation = "v"),
             yaxis2 = ay)

    p <- p %>% onRender(js)

  })

  # observe the two values from the JS code, use plotlyproxy to toggle axis when condition met
  observeEvent({
                input$trace
                input$visibility
               },
               {
                 if (input$trace == 2) {
                   ay[["visible"]] <- input$visibility == TRUE
                   plotlyProxy("scatterPlot", session) %>%
                     plotlyProxyInvoke("relayout", list(yaxis2 = ay))
                 }
               })
}

shinyApp(ui, server)