在智能手机上使用，闪亮的交互式图表无法理解手指动作。

Question

在智能手机上使用，闪亮的交互式图表无法理解手指动作。

26

我有一个使用R-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)

- agenis

在 GitHub 上，有一个与 plotly.js（而不是 R API）相关的心愿单，希望实现移动端交互。 - ismirsehregal

2个回答

6

虽然我不能完全解决这个问题，但也许一个“不太规矩”的解决方法对您也有一定的价值。或者其他人可以在此基础上进一步发展。

我能重现移动端无法捕获图表点击事件的错误。但我注意到可以使用JavaScript/ShinyJS添加额外的点击事件。

一种方法是：

  onevent(event = "click", id = "plot", function(e){
    global$clickx = c(global$clickx, e$pageX - 88)
    global$clicky = c(global$clicky, 540 - e$pageY)
  })

它有一些缺点：

图形仅使用线条绘制，无法捕捉出所有在图中悬停的内容。
定位相当不精确，因为您必须考虑边框和边距（非常麻烦但这里具有潜力）。

我尝试了几个小时，但时间有限，肯定可以改进，但也许对您有兴趣。

测试链接：（链接可能会在下周内更改）

http://ec2-3-121-215-255.eu-central-1.compute.amazonaws.com/shiny/rstudio/sample-apps/mobile/

可重复使用代码：（在智能手机Mi A2上测试通过）

library(shiny)
library(shinyjs)
ui <- fluidPage(
  useShinyjs(),
  h4("Click on plot to start drawing, click again to pause"),

  plotOutput(outputId = "plot", width = "500px", height = "500px")
)


server <- function(input, output, session) {

  onevent(event = "click", id = "plot", function(e){
    global$clickx = c(global$clickx, e$pageX - 88)
    global$clicky = c(global$clicky, 540 - e$pageY)
  })

  global <- reactiveValues(clickx = NULL, clicky = NULL)

  output$plot= renderPlot({
    plot(x = NULL, y = NULL, xlim=c(0, 440), ylim=c(0, 440), ylab="y", xlab="x", type="l")
    len <- length(global$clickx)
    lines(x = global$clickx, y = global$clicky, type = "p")      
    if(len > 1){
      for(nr in 2:len){
        lines(x = global$clickx[(nr - 1):nr], y = global$clicky[(nr - 1):nr], type = "l")
      }
    }
  })
}
shinyApp(ui, server)

- Tonio Liebrand

你好，非常感谢你的回答；确实我需要解决这个问题以进行公开演示。如果我理解正确，你是用点击替换了悬停？我没有想到这个解决方法，很好的主意，虽然它会使绘图变得更加困难和不够平滑。但是如果我没有其他解决方案，我会采用这种方法。我将你的代码应用到了我的初始应用程序中，并添加了一个“断线”按钮（抬起笔）和一个升级版本，在第一次点击时显示一个点：https://agenis.shinyapps.io/handwriting-v2/ - agenis

好吧，我并没有真正替换它。原始功能似乎在移动设备上无法正常工作，因此我将其删除了。如果您能使其正常工作，那将是更好的解决方案，但我不是移动设备专家。因此，我只添加了另一个点击事件。我不确定如何在移动设备上捕获悬停，我猜可能是mousedown，但在mousedown时我会得到一个上下文菜单，但它无法阻止默认行为。 - Tonio Liebrand

我有另一个解决原始问题的答案，所以我把赏金给了他。不管怎样，感谢@BigDataScientist的贡献和宝贵时间！ - agenis

完全值得。下班后我非常有兴趣深入研究他的答案。我在移动端方面没有太多经验，很兴奋能学习他是如何解决这个问题的 :)。 - Tonio Liebrand

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- greg L · Accepted Answer

您可以使用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)