used on a smartphone, shiny interactive plot doesn't understand finger movements
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)
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)