r - 在 R 中切换绘图时缩放（panZoom）不起作用

Question

我可以对单个图像使用缩放，并且效果很好。但是，在一个更复杂的应用程序中，我有一个动态 UI，其绘图取决于selectInput()这样的：

output$all <- renderUI({

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

问题是当用户切换到新的可视化时，缩放功能停止工作。（我试过改变 100ms 但这不是问题）

这是一个可重现的示例：

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)

Answer 1

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

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)