r - 如何在闪亮的应用程序中平移和缩放 svg 文件

Question

我有下面的闪亮应用程序，我想在其中平移和缩放 .svg。

library(shiny)
library(DiagrammeR)
library(tidyverse)
# probably don't need all of these:
library(DiagrammeRsvg)
library(svglite)
library(svgPanZoom)
library(rsvg)
library(V8)# only for svg export but also does not work
library(xml2)

ui <- fluidPage(
  grVizOutput("grr",width = "100%",height = "90vh")
)

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

# Run the application
shinyApp(ui = ui, server = server)

我试过这个svgPanZoom包，但可以让它工作。这是如何运作的？还是另一种选择？

ui <- fluidPage(
  svgPanZoomOutput("grr")
)

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 <-
    renderSvgPanZoom({
      svgPanZoom(reactives$graph)
      
    })
  
}

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

您可以使用panzoom JavaScript 库。

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)