在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，我们可以在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)