R Shiny:如何在输入更改时保持svgPanZoomOutput的缩放和平移?

Maj*_*116 8 javascript r shiny svgpanzoom

我有一个Shiny正在显示一些图像的应用程序。对于选定的图像,我有panzoom(使用svgPanZoom包装)和亮度更改(使用sliderInput)。同样在按钮上单击我将移至下一张图像。不幸的是,每当我单击按钮或更改滑块上的值zoompan重置时(这不足为奇)。请参见下面的示例:

实例应用

有什么方法可以使panzoom值保持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)
}
}'
))
Run Code Online (Sandbox Code Playgroud)
# 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%"))
        )
      )
  )
)
Run Code Online (Sandbox Code Playgroud)
# 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)
  })

})
Run Code Online (Sandbox Code Playgroud)