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

Posted 2023-05-08

【中文标题】在智能手机上使用，闪亮的交互式情节无法理解手指动作

【英文标题】：used on a smartphone, shiny interactive plot doesn't understand finger movements

【发布时间】：2019-11-10 05:48:25

【问题描述】：

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

【问题讨论】：

在 GitHub 上有一个 wishlist 用于关于 plotly.js（不是 R api）的移动交互

【参考方案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)

【讨论】：

发布了您的代码链接以进行测试：agenis.shinyapps.io/handwriting-v3

您好，谢谢，太棒了。我在服务器中添加了一些代码，以便在 touchend 之后在 data.frame 中添加 NA 以打破线条（举起铅笔）。我还减少了一点绘图大小，这样它就可以适应大多数屏幕而无需滚动。阻止情节运动（平移/缩放）在 iphone/Safari 上并不总是有效的，我发现双击是有效的。有没有办法阻止整个网页上的所有缩放和滚动（不阻止按钮......）？喜欢这个答案吗？ ***.com/q/17596938/3871924

哎呀，当然 Safari 和 ios 不支持 touch-action: none :( caniuse.com/#search=touch-action。我无法真正对此进行测试，但您可以尝试在每个触摸事件处理程序中添加 preventDefault()完全禁用滚动/缩放。我编辑了答案。

谢谢。现在似乎页面不再移动了，但是在android和ios中都禁用了actionbutton的副作用......好吧，你在这方面提供了足够的帮助，我现在会尝试自己改进它，非常感谢！这是最后一个版本agenis.shinyapps.io/handwriting-v4

宾果游戏！它有效，值得所有尝试！谢谢。 agenis.shinyapps.io/handwriting-v5

【参考方案2】：

虽然我不能完全解决这个问题，但也许一个肮脏的解决方法对你也有一些价值。或者其他人可以在该答案的基础上再接再厉。

我可以重现在移动设备上未捕获绘图点击的错误。但我注意到我可以使用 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)

【讨论】：

您好，非常感谢您的回答；确实，我真的需要为公开演示解决这个问题。如果我理解得很好，您只需单击即可替换悬停？我还没有想到这个解决方法，好主意，嗯，这是一个简化，因为绘图变得更难绘制，并且不太平滑。但如果我没有其他解决方案，我会选择这个。我将您的代码修改为我的初始应用程序，使用按钮“断”线（举起铅笔）并升级以在第一次点击时显示右侧的点：agenis.shinyapps.io/handwriting-v2

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

我有另一个答案解决了原来的问题，所以我将赏金奖励给了他。无论如何感谢@BigDataScientist 的贡献和宝贵的时间！

当之无愧。下班后我很有兴趣深入研究他的答案。我在移动方面没有太多经验，很高兴知道他是如何解决这个问题的:)。