0

I am able to use zoom on a single image, and that works well. However, in a more complex app, I have a dynamic UI that the plotting depends on a selectInput() like this:

output$all <- renderUI({

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

The problem is that when the user switches to the new visualisation, the zooming function stops working. (I have tried changing the 100ms but that's not the issue)

Here is a reproducible example:

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)

CodingBiology
  • 262
  • 4
  • 13

1 Answers1

1

Since you used renderUI, we can add panzoom after grVizoutput, like this

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)

lz100
  • 6,990
  • 6
  • 29
  • Thanks a lot, it solved it. Do you know why my version was not working? I can't understand why It doesn't. – CodingBiology Feb 09 '22 at 08:36
  • @CodingBiology your code works on the first time, and then the `clearInterval` delete the listener, but when you change select, the output is recalculated, so you need to apply the `panzoom` again. However, your listener is no longer there to do the job. My code above add a script tag to apply the `panzoom` every time new UI is rendered. – lz100 Feb 12 '22 at 07:25