javascript - R Shiny：如何在输入更改时保持 svgPanZoomOutput 的缩放和平移？

Question

我有一个Shiny应用程序，我在其中显示一些图像。对于我拥有的选定图像pan和zoom（使用svgPanZoom包）和亮度变化（使用sliderInput）。同样在按钮单击时，我将移至下一个图像。不幸的是，每当我单击按钮或更改滑块上的值zoom并pan正在重置时（这并不奇怪）。请参见下面的示例：

示例应用

有什么方法可以保持pan和zoom值的inputs变化？我正在考虑使用 javascript 代码保存这些值并使用 将它们发送到新输入Shiny.setInputValue，但现在我什至无法获取当前pan和zoom.

这是我尝试运行的示例应用程序代码和 JS：

# global.R
library(tidyverse)
library(shiny.semantic)
library(semantic.dashboard)
library(svgPanZoom)
library(SVGAnnotation)

# Some image data
imgs <- 1:2 %>% map(~ array(runif(1080 * 680 * 3), dim = c(1080, 680, 3)))

# Zoom script
zoom_script <-   tags$script(HTML(
  'window.onload = function() {
var rtg_plot = document.getElementById("picture");
var btn_next = document.getElementById("next_pic");
btn_next.addEventListener("click", printZoom, false);
function printZoom() {
    x = rtg_plot.getPan()
    console.log(x)
}
}'
))

# ui.R
semanticPage(
  tags$head(
    tags$link(
      rel = "stylesheet", type = "text/css", id = "bootstrapCSS",
      href = "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
    ),
    tags$script(src = "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js")
  ),
  zoom_script,
  div(style = "height: 900px; overflow-y: scroll; padding: 10px;", class = "ui grid",
      box(
        title = "Picture", color = "blue", ribbon = TRUE, title_side = "top left", collapsible = FALSE, width = 16,
        div(class = "ui grid", style = "max-height: 920px; padding: 10px;",
            fluidRow(style = "text-align: center;",
                     column(8, sliderInput("slider", "slider", min = -100, max = 100, step = 1, value = 0)),
                     column(8, actionButton(inputId = "next_pic", label = "Next image")))
        ),
        fluidRow(style = "text-align: center;",
                 column(16, svgPanZoomOutput("picture", height = "100%", width = "100%"))
        )
      )
  )
)

# server.R
shinyServer(function(input, output, session) {
  # Image indicator
  indicator <- reactiveVal(1)

  # Image output
  img <- reactive({
    ind <- indicator() %% 2 +1
    (imgs[[ind]])^(1 - input$slider / 100)
  }) %>% debounce(20)

  output$picture <- renderSvgPanZoom(svgPanZoom(svgPlot(grid::grid.raster(img(), interpolate = FALSE)), viewBox = FALSE))

  observeEvent(input$next_pic, {
    new_ind <- indicator() + 1
    indicator(new_ind)
  })

})

标签： javascriptrshinysvgpanzoom