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)
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)