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 shinyapp with the functionnality 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. 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)
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)
While I can't solve the question completely, maybe a dirty workaround could also have some value to you. Or someone else can build on that answer.
I could reproduce the error that the clicks on the plot are not captured on mobile. But I noticed that I can add additional clickevents with javascript/shinyjs.
One way would be:
onevent(event = "click", id = "plot", function(e){
global$clickx = c(global$clickx, e$pageX - 88)
global$clicky = c(global$clicky, 540 - e$pageY)
})
It has a few drawbacks:
- shapes are drawn with lines only, it does not capture all hovering on the plot
- the position is quite imprecise since you have to account for borders and margins (very dirty but potential here)
I ran a bit out of time after a few hours, one can for sure improve it, but maybe its of interest for you anyway.
Test here: (link might change within next weeks)
http://ec2-3-121-215-255.eu-central-1.compute.amazonaws.com/shiny/rstudio/sample-apps/mobile/
Reproducible code: (tested on smartphone: 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)
