在 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)
我可以对单个图像使用缩放功能,效果很好。然而,在一个更复杂的应用程序中,我有一个动态的 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)