I am wanting to write a program in Shiny that will keep up with the response time taken to interact with various objects. The simplest analogue would be something like a timed matching game wherein the user must select a specific object/stimulus, and I want to be able to find out later (i.e., after the application is finished) how long each response took and whether it was correct.
I already know how to do most of this program; however, I cannot find anyway within Shiny to keep up with response time let alone as a function of interaction with a reactive element. Based on preliminary searches, it seems like Javascript may have a solution; however, I know zero Javascript experience and also don't have any experience integrating it with Shiny.
Does anyone know of a way of using existing R/Shiny language to perform a count-up timer that could be used to time responses to multiple objects? Alternatively, does anyone have a potentially better solution to timing responses that I may be missing?
EDIT: ABOVE ISSUE ADDRESSED, BUT NEW ONE HAS COME UP IN AN EXTENSION OF THE ANSWER
I initially left this as a comment, but it was too long to fit in the length requirements. I've come up with a new issue. This time, I want to keep a running tab of how long it has taken between any two clicks but without knowing how many clicks a user may submit. I've played around some with the code given, but I can't get it to work (relevant pieces below, nothing else was changed):
if(total_timestamps == 2){
duration <- rbind(duration, as.numeric(difftime(new_val[2],new_val[1],units = "secs")))
new_val[1] <- new_val[2]
new_val <- new_val[-2, ]
click_timestamps(new_val)
### other things to do
}
My thought was to switch the old and new values and then delete the oldest value to make room for a new one to continue the cycle, but it's not working as I had hoped. Thoughts or help?
You don't need JavaScript for this. You can create a reactive value, and append value to it each time an element is clicked. If you need to observe multiple different elements, then just write more observers.
library(shiny)
ui <- fluidPage(
actionButton("button","Click"),
tags$h2("Response Time"),
tags$div(id = "duration")
)
server <- function(input, output, session) {
click_timestamps <- reactiveVal(NULL)
observeEvent(input$button,{
new_val <- append(click_timestamps(),Sys.time())
# set click timestamp
click_timestamps(new_val)
total_timestamps <- length(new_val)
if(total_timestamps == 2){
duration <- as.numeric(difftime(new_val[2],new_val[1],units = "secs"))
insertUI(
selector = "#duration",
ui = tags$p(paste0("Seconds between clicks: ", duration))
)
# reset click timestamp
click_timestamps(NULL)
}
})
}
shinyApp(ui, server)
Related
I have the following issue with the behaviour of R shiny's numeric input behaviour. Consider the following snippet:
ui <- basicPage(
numericInput("example","Example",value=0),
verbatimTextOutput("changelog")
)
server <- function(input,output){
output$changelog <- renderPrint(input$example)
}
shinyApp(ui,server)
Suppose that I want to update the example input field to 12345. My issue is that the default event listener would react to every keystroke. Thus the input field would be set to 1, 12,123 and 1234 before I finally get the desired value of 12345. Each numeric input set would be followed by an expensive computation - so this is a very undesirable behaviour.
What I am after is modifying this behaviour so that the event listener only reacts to the numeric input when the user hits enter or leaves the input field. I have currently two approaches to this:
Use a reactiveValue with an update actionButton so that the input is updated only when the user clicks update. I find this an inelegant solution and only shirks the original problem without solving it.
Modify the local shiny.js file directly and remove the keyup.textInputBinding event. That creates another issue with running the shiny app on other computers and it would make this modified behaviour uniform for all numericInput.
I'm wondering if anyone has a solution/suggestion to this? Preferably something that does not involve changing the local shiny.js file. I'm guessing a solution would involve using shinyjs::runjs to manually unsubscribe the keyup.textInputBinding event - but I don't know enough JavaScript to execute it.
You can slow frequent invalidation down with debounce or throttle. In your case, my first guess would be debounce: Debouncing means that invalidation is held off for millis milliseconds.
The reactive expression will only be validated until that time window has passed without a subsequent invalidation which may have an effect like this: ooo-oo-oo---- => -----------o-
In your case:
library(shiny)
ui <- basicPage(
numericInput("example","Example",value=0),
verbatimTextOutput("changelogImmediate"),
verbatimTextOutput("changelog")
)
server <- function(input,output){
exampleInput <- reactive(input$example) %>% debounce(1000)
# debouncedExampleInput <- exampleInput
output$changelogImmediate <- renderPrint(input$example)
output$changelog <- renderPrint(exampleInput())
}
shinyApp(ui,server)
I made a Shiny App which basically teaches students about simple statistic tests and plots. However, because (an while) I have a free account on shiny, I have a limited amount of time to make it available per month. Therefore, I'm going to set specific windows of time for it to run every week. The thing is I can't manually do it every time, not only because I'd likely forget, but because I'm not available during the closing time (17h) to do it. Also, I'm not sure how I'd do that.
Therefore, I wanted to know if there was a way to automate available times for the Shiny App to be open and possibly running, and to have the link be useless at any other time.
I realise I've only written things here, so if I forgot any important information, please ask and I'll edit this question.
You could use a reactiveTimer to check regularly time, use a modalDialog if the time is over to warn the user, and stop the App after a few seconds:
library(shiny)
ui <- shinyUI(fluidPage(actionButton("run", "Do something")))
server <- shinyServer(function(input, output, session) {
# Check time every minute
time <- reactiveTimer(60000)
observe({
currenthour <- as.numeric(format(time(), '%H'))
if (currenthour >= 17) {
showModal(modalDialog(title = "App not available after 17h",
paste("it's", format(time(), '%H:%M'), "h, please try again tomorrow")))
Sys.sleep(5)
stopApp()
}
})
})
shiny::shinyApp(ui, server)
I have a little shiny app that uses a dateRangeInput to plot only a subset of the data.
I was trying to initialize the values of the dateRangeInput (max, min, start, end) to match those of the data set (plot the whole range by default).
One way to do that is to use updateDateRangeInput. It works, but only after an error that gets briefly displayed on the UI. (I also tried the solution discussed here, here and here, which is using uiOutput in the UI and renderUI on the server side, but I found basically the same problem).
Here's my (hopefully minimal) reproducible example (if you have shiny installed, you should be able to just copy and paste the code to see what I mean):
library(shiny)
library(dplyr)
get_data <- function(){
set.seed(1234567)
data.frame(
date = sort(sample(seq(as.Date('2014/01/01'), as.Date('2017/01/01'), by = "day"), 200)),
value = runif(200)
)
}
# Here's my UI
ui <- fluidPage(
dateRangeInput("dateRange", label = "Date range"),
plotOutput(outputId = "thePlot", height = "520px")
)
# And here's my server
server <- function(input, output, clientData, session) {
the_data <- reactive({
# Get the data
my_data <- get_data()
# And update the date range values to match those of the dataset
updateDateRangeInput(
session = session,
inputId = "dateRange",
start = min(my_data$date),
end = max(my_data$date)
)
my_data
})
output$thePlot <- renderPlot({
# I need to subset the data, using the user input (dateRangeInput)
data_subset <- dplyr::filter(the_data(),
date >= input$dateRange[[1]],
date <= input$dateRange[[2]]
)
str(data_subset)
# And plot the subset of data
plot(x = data_subset$date,
y = data_subset$value)
})
}
shinyApp(ui, server)
So this app basically loads a dataset, which I do not know in advance, therefore, I do not know the date range to hard code it on the UI.
The UI only has the dateRangeInput and a plotOutput. The server side defines a reactive expression to load the data and a renderPlot that only subsets the data using the range given by the dateRangeInput on the UI.
Note that the dateRangeInput on UI does not have max, min, start or end dates defined (therefore, the default NULL values are used). That's is because at this point I have no clue on the values, only at run time when the data is loaded I know what would be the appropriate values (the whole range of the data). Of course I can set some arbitrary values on UI, but they will be just that, arbitrary values that may or may not work.
So what I wanted to do is for my app to load the data and update the dateRangeInput with appropriate values. I am doing this just after loading the data. It works, but after stumbling on an error on the renderPlot.
What happens is that renderPlot gets executed before the dateRangeInput values are updated, therefore, renderPlot is using NULL values to subset the data and this leads to an error. This error is briefly displayed to the user. Then, the dateRangeInput values do get updated and the plot rendered properly.
I checked the flow and updateDateRangeInput is indeed executed before renderPlot. However, the values are actually updated lated on.
This behaviour is actually described on the help page of updateDateRangeInput:
The input updater functions send a message to the client, telling it
to change the settings of an input object. The messages are collected
and sent after all the observers (including outputs) have finished
running.
So, even though updateDateRangeInput get executed before renderPlot, it only collects the message which is only sent to the client after renderPlot finished running.
Is there any way to force updateDateRangeInput to send the messages to the client immediately?
Or how can I initialize the values of a dateRangeInput from the server side before other outputs are executed?
Thanks in advance, and sorry for such a long message (as the saying goes, I did not have time to write a short message, but I hope the reproducible example is as short as it gets to illustrate my problem).
Previously, I had built a shiny dashboard with chart outputs that worked just fine and looked like the following:
output$someName <- renderGvis({
input$inputButton
data <- isolate(myData(function here))
donut <- gvisDonut({...})
return(donut)
})
Since the addition of observeEvent and eventReactive, I've not been able to get it to work the same as before. Essentially, the output$someName is a chart that is dependent on multiple inputs, and each time the user clicks on the inputButton, I need renderGvis to re-evaluate. The function should NOT re-evaluate when any of the other inputs change, just when the button is pressed.
I've had some luck getting observeEvent to run on input$inputButton click, however, each time I change any of my input parameters, the query is quickly rerun without having to press the button. Any takers here?
More detailed below:
output$someName <- renderGvis({
input$inputButton
data <- isolate(dataGrabber({})) # function that takes input and returns data frame using RMySQL
isolate(simpleChart(data = data)) # simpleChart is a function to produce a gvisCalendar chart.
OK...found an answer to this if anyone ever has this problem. The issue, which for some reason I had not encountered in the past, is that the isolate function now runs regardless of whether or not the value for actionButton is 0 or not. I believe in the past, it wouldn't run until actionButton had a value greater than 0.
The simple fix was:
output$someName <- renderGvis({
input$inputButton
if (input$inputButton == 0)
return()
isolate({ code to isolate})
})
I have a use case where am visualizing operational data for a dashboard. I would like it to be such that the visualization is updated periodically as data is added to the database. The logic in my mind is to first check if the number of rows in the live database table is equal to the number of rows in the corresponding dataframe within R. If yes, then no need to pull data, if no, then pull data from database. What I want to avoid is to just pull data (actual database table has over 5 million rows) periodically regardless of whether there is new data or not.
I have created a subset of the data here. The code below I wrote as a proof of concept to first wrap my head around how invalidateLater() and reactiveValues() work in R and how I could possibly use them. It simply reads the number of rows in the database table and displays it to the user. If the number of rows changes, the user interface is updated with the new number of rows. Note that to reproduce you may want to put data into a database so you can simulate adding and deleting rows to see reaction of the "app". I used postgres, and an ODBC connection. If you run the code as-is, you will notice that when rows are added to the db, when the app is doing the checking, the user interface (textOutput() widget) grays out for a few seconds and appears to be in a state of meditation before eventually correctly displaying the new number of rows. This is using the code which first checks if there are differences in row numbers between database and value held in R.
However if I comment out that part of the code which check for differences (comment out the block below)
sharedValues$data <- if(!is.null(sharedValues$data)){
if(nrow(sqlFetch(conn2,"test2")) == sharedValues$data){
return(sharedValues$data)
}
}
else{
sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
return(sharedValues$data)
}
and instead just pull data periodically regardless if there is a change or not (uncomment this line)
#sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
the interface reacts superbly, there is no lag (graying out of the widget text) and the new row value is displayed on the user interface.
My question is what causes the "lag-like" behavior when running the first alternative (which is the desired alternative) of first checking for database changes before making an expensive database select query), yet when the code is amended to pull data regardless of database changes (which seems to me inefficient) this lag-like behavior rears its ugly head? The entire code is below:
library(shiny)
library(shinydashboard)
library(rCharts)
library(curl)
library(RODBC)
conn2 <- odbcConnect("postgres") # database connection object
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(textOutput("text1"),width = 6)
)
)
)
server <- function(input, output, session) {
sharedValues <<- reactiveValues()
observe({
invalidateLater(30000,session)
cat("updating data...\n")
sharedValues$data <- if(!is.null(sharedValues$data)){
if(nrow(sqlFetch(conn2,"test2")) == sharedValues$data){
return(sharedValues$data)
}
}
else{
sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
return(sharedValues$data)
}
#sharedValues$data <- nrow(sqlFetch(conn2,"test2"))
})
output$text1 <- renderText({
y <- sharedValues$data
return(y)
})
}
shinyApp(ui, server)
Any help greatly appreciated.
According to this answer, this can be fixed by manipulating the CSS in ui.R
tags$style(type="text/css",
".recalculating { opacity: 1.0; }"
)