rshinyhoverclicksmartphone

used on a smartphone, shiny interactive plot doesn't understand finger movements


I have a R-Shiny application with a plot that implements interactive actions: click, hovering (hovering is passing the mouse over the plot, which can be detected by shiny). To give an idea, I post below a simplified shiny-app with the functionality that is problematic to me, the interactive drawing plot. (it's taken from an old answer of mine here)

It's actually working fine, however I need people to use it from their smartphones. The problem: the finger movements we do in the smartphone are interpreted by the phone as zooming on the page or scrolling on the page, and not as mouse selection or mouse movement over the the plot (hovering).

Is there a modification of the code (java? CSS?) that I can implement on the app to turn touch events into mouse events, or an option/gesture on the smartphone to enable a mouse-like movement?

Thanks a lot; the code:

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)

Solution

  • You can disable panning/zoom gestures on the plot using the touch-action CSS property:

    #plot {
      touch-action: none;
    }
    

    Turning touch events into mouse events is a little trickier, but you could listen to touch events like touchstart, touchmove, touchend and simulate equivalent mouse events in JavaScript. See https://developer.mozilla.org/en-US/docs/Web/API/Touch_events/Using_Touch_Events and https://javascript.info/dispatch-events for more info.

    It's not perfect, but I gave it a shot. I disabled touch gestures on the plot and added a script that converts touchmove to mousemove, and tells the server when to start drawing (on touchstart) and stop drawing (on 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)