[英]How to add controls in pan&zoom functionality in shiny app?
I have used panzoom
package in order to pan and zoom on my svg file in my shiny app.我使用panzoom
package 来平移和缩放 shiny 应用程序中的 svg 文件。 Is there a way to have controls like this ?有没有办法拥有这样的控件?
library(shiny)
library(DiagrammeR)
library(magrittr)
ui <- fluidPage(
tags$head(
tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js")
),
grVizOutput("grr", width = "100%", height = "90vh"),
tags$script(
HTML('panzoom($("#grr")[0])')
)
)
server <- function(input, output) {
reactives <- reactiveValues()
observe({
reactives$graph <- render_graph(create_graph() %>%
add_n_nodes(n = 2) %>%
add_edge(
from = 1,
to = 2,
edge_data = edge_data(
value = 4.3)))
})
output$grr <- renderGrViz(reactives$graph)
}
shinyApp(ui, server)
Here is a way, but if you click too quickly on the +/- buttons, there's an undesirable effect.这是一种方法,但如果您在 +/- 按钮上单击太快,则会产生不良影响。
library(shiny)
library(shinyWidgets)
library(DiagrammeR)
library(magrittr)
js <- '
$(document).ready(function(){
var element = document.getElementById("grr");
var instance = panzoom(element);
$("#zoomout").on("click", function(){
instance.smoothZoom(0, 0, 0.9);
});
$("#zoomin").on("click", function(){
instance.smoothZoom(0, 0, 1.1);
});
});
'
ui <- fluidPage(
tags$head(
tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js"),
tags$script(HTML(js))
),
grVizOutput("grr", width = "100%", height = "90vh"),
actionGroupButtons(
inputIds = c("zoomout", "zoomin"),
labels = list(icon("minus"), icon("plus")),
status = "primary"
)
)
server <- function(input, output) {
reactives <- reactiveValues()
observe({
reactives$graph <- render_graph(
create_graph() %>%
add_n_nodes(n = 2) %>%
add_edge(
from = 1,
to = 2,
edge_data = edge_data(
value = 4.3
)
)
)
})
output$grr <- renderGrViz(reactives$graph)
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.