在 R shiny 中切换绘图时缩放(panZoom)不起作用

Zoom (panZoom) not working when switching plots in R shiny

我可以对单个图像使用缩放功能,效果很好。然而,在一个更复杂的应用程序中,我有一个动态的 UI 绘图依赖于 selectInput() 像这样:

output$all <- renderUI({

    if (input$choice == 'two nodes') {
        uiOutput("two")
    }else{
        uiOutput("three")
    }
})

问题是当用户切换到新的可视化时,缩放功能停止工作。 (我试过更改 100 毫秒,但这不是问题所在)

这是一个可重现的例子:

library(shiny)
library(DiagrammeR)
library(magrittr)

js <- '
$(document).ready(function(){
  var instance;
  var myinterval = setInterval(function(){
    var element = document.getElementById("grr");
    if(element !== null){
      clearInterval(myinterval);
      instance = panzoom(element);
    }
  }, 100);
});
'

js2 <- '
$(document).ready(function(){
  var instance;
  var myinterval = setInterval(function(){
    var element = document.getElementById("grr2");
    if(element !== null){
      clearInterval(myinterval);
      instance = panzoom(element);
    }
  }, 100);
});
'

ui <- fluidPage(

    selectInput('choice',
                'choices:',choices = c('two nodes','three nodes')),
    tags$head(
        tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js"),
        tags$script(HTML(js)),
        tags$script(HTML(js2))
    ),

    uiOutput("all")


)

server <- function(input, output) {

    output$two_nodes <- renderUI({
        div(
            grVizOutput("grr", width = "100%", height = "90vh")
        )

    })

    output$three_nodes <- renderUI({
        div(
            grVizOutput("grr2", width = "100%", height = "90vh")
        )

    })

    output$all <- renderUI({

        if (input$choice == 'two nodes') {
            uiOutput("two_nodes")
        }else{
            uiOutput("three_nodes")
        }
    })

    output$grr <- renderGrViz(render_graph(
        create_graph() %>%
            add_n_nodes(n = 2) %>%
            add_edge(
                from = 1,
                to = 2,
                edge_data = edge_data(
                    value = 4.3
                )
            )
    ))

    output$grr2 <- renderGrViz(render_graph(
        create_graph() %>%
            add_n_nodes(n = 3) %>%
            add_edge(
                from = 1,
                to = 2,
                edge_data = edge_data(
                    value = 4.3
                )
            )
    ))

}

shinyApp(ui, server)

既然你用了renderUI,我们可以在grVizoutput后面加上panzoom,像这样

library(shiny)
library(DiagrammeR)
library(magrittr)
library(shinyWidgets)

ui <- fluidPage(
    
    selectInput('choice',
                'choices:',choices = c('two nodes','three nodes')),
    tags$head(
        tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js"),
        # tags$script(HTML(js))
    ),
    
    uiOutput("all")
    
    
)

server <- function(input, output) {
    
    output$two_nodes <- renderUI({
        div(
            grVizOutput("grr", width = "100%", height = "90vh"),
            tags$script(HTML('panzoom($(".grViz").get(0))')),
            actionGroupButtons(
                inputIds = c("zoomout", "zoomin", "reset"),
                labels = list(icon("minus"), icon("plus"), "Reset"),
                status = "primary"
            )
        )
        
    })
    
    output$three_nodes <- renderUI({
        div(
            grVizOutput("grr2", width = "100%", height = "90vh"),
            tags$script(HTML('panzoom($(".grViz").get(0))')),
            actionGroupButtons(
                inputIds = c("zoomout", "zoomin", "reset"),
                labels = list(icon("minus"), icon("plus"), "Reset"),
                status = "primary"
            )
        )
        
    })
    
    output$all <- renderUI({
        
        if (input$choice == 'two nodes') {
            uiOutput("two_nodes")
        }else{
            uiOutput("three_nodes")
        }
    })
    
    output$grr <- renderGrViz(render_graph(
        create_graph() %>%
            add_n_nodes(n = 2) %>%
            add_edge(
                from = 1,
                to = 2,
                edge_data = edge_data(
                    value = 4.3
                )
            )
    ))
    
    output$grr2 <- renderGrViz(render_graph(
        create_graph() %>%
            add_n_nodes(n = 3) %>%
            add_edge(
                from = 1,
                to = 2,
                edge_data = edge_data(
                    value = 4.3
                )
            )
    ))
    
}

shinyApp(ui, server)