r - 在智能手机上使用， Shiny 的交互式情节无法理解手指的运动

Question

我有一个 R-Shiny 应用程序，其中包含一个实现交互式操作的图:单击、悬停(悬停是将鼠标悬停在图上，可以通过 Shiny 检测到)。为了提供一个想法，我在下面发布了一个简化的 Shiny 应用程序，其功能对我来说是有问题的，即交互式绘图图。 (它取自我的旧答案 here )
它实际上工作正常，但是我需要人们从他们的 使用它智能手机 .问题:我们在智能手机中进行的手指移动被手机解释为在页面上缩放或在页面上滚动，而不是鼠标选择或鼠标在绘图上的移动(悬停)。
我可以在应用程序上实现将触摸事件转换为鼠标事件的代码(java？CSS？)，或者智能手机上的选项/手势以启用类似鼠标的移动？
非常感谢;编码:

library(shiny)
ui <- fluidPage(
  h4("Click on plot to start drawing, click again to pause"),
  sliderInput("mywidth", "width of the pencil", min=1, max=30, step=1, value=10),
  actionButton("reset", "reset"),
  plotOutput("plot", width = "500px", height = "500px",
             hover=hoverOpts(id = "hover", delay = 100, delayType = "throttle", clip = TRUE, nullOutside = TRUE),
             click="click"))
server <- function(input, output, session) {
  vals = reactiveValues(x=NULL, y=NULL)
  draw = reactiveVal(FALSE)
  observeEvent(input$click, handlerExpr = {
    temp <- draw(); draw(!temp)
    if(!draw()) {
      vals$x <- c(vals$x, NA)
      vals$y <- c(vals$y, NA)
    }})
  observeEvent(input$reset, handlerExpr = {
    vals$x <- NULL; vals$y <- NULL
  })
  observeEvent(input$hover, {
    if (draw()) {
      vals$x <- c(vals$x, input$hover$x)
      vals$y <- c(vals$y, input$hover$y)
    }})
  output$plot= renderPlot({
    plot(x=vals$x, y=vals$y, xlim=c(0, 28), ylim=c(0, 28), ylab="y", xlab="x", type="l", lwd=input$mywidth)
  })}
shinyApp(ui, server)

Answer 1

您可以使用 touch-action 在绘图上禁用平移/缩放手势。 CSS 属性:

#plot {
  touch-action: none;
}

将触摸事件转换为鼠标事件有点棘手，但您可以收听诸如 touchstart 之类的触摸事件。 , touchmove , touchend并在 JavaScript 中模拟等效的鼠标事件。见 https://developer.mozilla.org/en-US/docs/Web/API/Touch_events/Using_Touch_Events和 https://javascript.info/dispatch-events了解更多信息。

这并不完美，但我试了一下。我禁用了绘图上的触摸手势并添加了一个脚本来转换 touchmove至 mousemove ，并告诉服务器何时开始绘图(在 touchstart 上)和停止绘图(在 touchend 上)。

library(shiny)

ui <- fluidPage(
  h4("Click on plot to start drawing, click again to pause"),
  sliderInput("mywidth", "width of the pencil", min=1, max=30, step=1, value=10),
  actionButton("reset", "reset"),
  plotOutput("plot", width = "400px", height = "400px",
             hover=hoverOpts(id = "hover", delay = 100, delayType = "throttle", clip = TRUE, nullOutside = TRUE),
             click="click"),
  tags$head(
    tags$script("
      $(document).ready(function() {
        var plot = document.getElementById('plot')

        plot.addEventListener('touchmove', function (e) {
          var touch = e.changedTouches[0];
          var mouseEvent = new MouseEvent('mousemove', {
            view: window,
            bubbles: true,
            cancelable: true,
            screenX: touch.screenX,
            screenY: touch.screenY,
            clientX: touch.clientX,
            clientY: touch.clientY
          })
          touch.target.dispatchEvent(mouseEvent);
          e.preventDefault()
        }, { passive: false });

        plot.addEventListener('touchstart', function(e) {
          Shiny.onInputChange('draw', true)
          e.preventDefault()
        }, { passive: false });

        plot.addEventListener('touchend', function(e) {
          Shiny.onInputChange('draw', false)
          e.preventDefault()
        }, { passive: false });
      })
    "),
    tags$style("#plot { touch-action: none; }")
    )
)

server <- function(input, output, session) {
  vals = reactiveValues(x=NULL, y=NULL)
  draw = reactiveVal(FALSE)

  observeEvent(input$click, {
    draw(!draw())
    vals$x <- append(vals$x, NA)
    vals$y <- append(vals$y, NA)
  })

  observeEvent(input$draw, {
    draw(input$draw)
    vals$x <- append(vals$x, NA)
    vals$y <- append(vals$y, NA)
  })

  observeEvent(input$reset, handlerExpr = {
    vals$x <- NULL; vals$y <- NULL
  })

  observeEvent(input$hover, {
    if (draw()) {
      vals$x <- c(vals$x, input$hover$x)
      vals$y <- c(vals$y, input$hover$y)
    }
  })

  output$plot= renderPlot({
    plot(x=vals$x, y=vals$y, xlim=c(0, 28), ylim=c(0, 28), ylab="y", xlab="x", type="l", lwd=input$mywidth)
  })
}

shinyApp(ui, server)