R Shiny: как сохранить масштабирование и панорамирование от svgPanZoomOutput при изменении ввода? - PullRequest
Новая
       30

R Shiny: как сохранить масштабирование и панорамирование от svgPanZoomOutput при изменении ввода?

5 голосов
/ 20 сентября 2019

У меня есть приложение 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("rtg");
var btn_next = document.getElementById("nastepny");
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)
  })

})
...