I'd like to know when a user clicks on an image in a Shiny app. My full app displays images in a kind of "Photo Hunt" game and I want to capture how long it takes the user to click on a relevant place in each image. However, I'm having a hard time capturing client-side time, which is important because server-side times can be delayed for various reasons. I think I would need something like the following javascript, but I do not know how to integrate it in the app.
var image = document.getElementById('img');
addEventListener("click", true,
click_time = new Date().getTime();)
Shiny.onInputChange("new_click_time",click_time);
observeEvent(input$new_click_time,{
# This should be the time the user clicked on the image:
input$new_click_time
})
Here's an example shiny app that gets server-time, but not client-time:
library(shiny)
library(shinyjs)
options(digits.secs = 3) # Modify default global time to show milleseconds
shinyApp(
ui = fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
p("When clicking on the histogram, I'd like to capture the client-side computer's time"),
actionButton(inputId="new_image", label= "New Image")
),
mainPanel(
imageOutput("img", click = "photo_click"),
textOutput("client_time"),
textOutput("server_time")
)
)
),
server = function(input, output) {
output$img <- renderImage({
input$new_image
outfile <- tempfile(fileext='.png')
png(outfile, width=400, height=400)
hist(rnorm(100))
dev.off()
list(src = outfile,
alt = "This is alternate text")
},
deleteFile = TRUE)
output$server_time <- renderText({
req(input$photo_click)
server.time <- as.character(strptime(Sys.time(), "%Y-%m-%d %H:%M:%OS")) # Time with milliseconds
paste("SERVER TIME:", server.time)
})
output$client_time <- renderText({
# cat("\nI'd like to capture click-time, possibly here -- the time on the client's machine when a click is made")
req(input$photo_click)
client.time <- "???" # Time with milliseconds
paste("CLIENT TIME:", client.time)
})
}
)
You could use the javascript function Shiny.setInputValue supplied by Shiny to the client. Example:
library(shiny)
ui <- shiny::fluidPage(
img(id = 'trigger_image',
src = 'notfound.jpg',
height = '100px',
width = '100px'
),
tags$script('
document.getElementById("trigger_image").onclick = function(){
var the_time = new Date().getTime();
// set input$client_time to the_time:
Shiny.setInputValue("client_time", the_time)}
')
)
server <- function(input, output) {
observeEvent(input$client_time,{
## do stuff with input$client_time
})
}
shinyApp(ui, server)
Note that Javascript getTime returns milliseconds elapsed since 1970/1/1.
Shiny: Communicating with Javascript
Edit
If you have to measure the time elapsed between updating the image at the client and the user responding (clicking on the fresh image), you can capture and calculate the duration between both events at the client side like this:
library(shiny)
ui <- shiny::fluidPage(
tags$script('
// ------ javascript code ------
// $(document).ready(...) ensures execution only after document is fully rendered
// so that events like .onclick can be attached
$(document).ready(function(){
// function to set Shiny input value to current time:
const clockEvent = function(inputName){Shiny.setInputValue(inputName, new Date().getTime())}
// trigger when the value of output id "trigger_image" changes:
$(document).on("shiny:value",
function(event){
if (event.target.id === "trigger_image") {clockEvent("displayed_at")}
}
)
// trigger when the image, after being sent or refreshed, is clicked:
document.getElementById("trigger_image")
.onclick = function(){clockEvent("reacted_at")}
})
// ------------------------------
'),
shiny::imageOutput('trigger_image'),
actionButton('show_new', 'show new image'),
textOutput('reaction_time')
)
server <- function(input, output) {
observeEvent(input$show_new,{
output$trigger_image <- shiny::renderImage(list(id = 'trigger_image',
'src' = 'image001.png'
), deleteFile = FALSE)
output$reaction_time <- renderPrint(paste('reaction time (ms)', input$reacted_at - input$displayed_at))
})
}
shinyApp(ui, server)
The below seems to capture the client's time, but I don't see how it can be correct, because the client's time is AFTER the server's time.
library(shiny)
library(shinyjs)
options(digits.secs = 3) # Modify and save default global time options
click.time.image.js <- "
document.getElementById('img').onclick = function(){
var the_time = new Date().getTime();
console.log(the_time);
// set input$client_time to the_time:
Shiny.setInputValue('client_time', the_time)
}
"
shinyApp(
ui = fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
p("When clicking on the histogram, I'd like to capture the client-side computer's time"),
actionButton(inputId="new_image", label= "New Image")
),
mainPanel(
imageOutput("img", click = "photo_click"),
textOutput("client_time"),
textOutput("server_time")
)
)
),
server = function(input, output) {
output$img <- renderImage({
input$new_image
outfile <- tempfile(fileext='.png')
png(outfile, width=400, height=400)
hist(rnorm(100))
dev.off()
shinyjs::runjs(click.time.image.js)
list(src = outfile,
alt = "This is alternate text")
},
deleteFile = TRUE)
output$server_time <- renderText({
req(input$photo_click)
server.time <- as.character(strptime(Sys.time(), "%Y-%m-%d %H:%M:%OS")) # Time with milliseconds
paste("SERVER TIME:", server.time)
})
output$client_time <- renderText({
req(input$photo_click)
req(input$client_time)
client.time <- input$client_time # Time with milliseconds
client.time <- as.POSIXct(client.time/1000, origin="1970-01-01")
paste("CLIENTs TIME:", client.time)
})
}
)