Strange behavior of R Shiny reactiveValues() and invalidateLater() - r

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; }"
)

Related

Tracking Response Time in Shiny

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)

Using reactiveFileReader in Shiny app to update a dataframe upon change to underlying CSV

I'm working on a complex (for me) Shiny app ~2500 lines of code. The basic structure is as follows, though I can't necessarily share a reproducible example since most of the information is confidential.
Right now, I am using df1 <- read.csv() etc to read in several CSV files as dataframes. I want to use reactiveFileReader() to make it such that the dataframes automatically update when the source CSV file is modified. I think my problem may be related to the fact that I am not doing this in a reactive context, but there is a reason for this. I am using the dataframes df1 etc to perform many calculations and to create new variables throughout the app (UI and server sections).
It also might be important to note that I am doing these file imports in the UI part of the Shiny app, since I need to rely on the factor levels of these dataframes to populate drop down selectInput in my UI. This might not be necessary.
Here is what I have tried (although I am pretty lost):
reader <- reactiveFileReader(intervalMillis = 1000, filePath =
"Data_Record.csv", readFunc = read.csv)
data_record <- reactive({
data_df <- reader()
return(data_df)
})
What I was expecting was for data_record to be a dataframe containing the information from the CSV, but it ends up being a "reactive expression". When I try to perform operations on data_record, like subsetting, I receive errors since that variable is not a dataframe.
Is there any way for me to update these dataframes upon modification to the underlying CSV outside of a reactive context? Even a scheduled update like every 10 seconds or so would work as well. My ultimate goal are dataframes that update when a CSV is modified, but scheduled updates are fine as well.
Thanks in advance for all the help and I apologize for not being able to supply a reproducible example! I will try to add more information as needed.
So if you want the data to be reactive, it has to be imported in the server section of the app as a 'reactive'. In shiny, 'reactives' become functions so to do anything with them you have to reference them their name followed by parenthesis inside a reactive function (reactive, observe, render etc).
For example, with your code above, reader becomes a reactive data frame. You can perform normal data manipulation on reader if you follow the rules of reactives outlined above.
# server.R
reader <- reactiveFileReader(intervalMillis = 1000, filePath =
"Data_Record.csv", readFunc = read.csv)
filtered_reader_df <- reactive({
reader() %>% filter(x > 100)
})
Where filtered_reader_df becomes a reactive filtered version of the reactive csv file. Again, to use filtered_reader_df in subsequent reactive function it must be referenced as filtered_reader_df() as it is a reactive function itself.
Finally, you can still use the reactive csv file to populate UI elements with the updateSelectInput() function inside an observer in the server. For example:
ui <- fluidPage(
selectInput("mySelectInput", "Select")
)
server <- function(input, output, session) {
reader <- reactiveFileReader(intervalMillis = 1000, filePath =
"Data_Record.csv", readFunc = read.csv)
observe({
select_input_choices <- unique(reader()$factor_column)
updateSelectInput(session, inputId = "mySelectInput", choices = select_input_choices)
})
}
The code above will update the choices of the select input every time the reader() data frame changes with the reactiveFileReader where unique(reader()$factor_column) are the reactive unique values of the factor column you want to populate the input with.

Re-submit MySQL Calls, then refresh data when app is refreshed

I have written an app that calls a stored procedure to update a table in MySQL, then queries the new table (both using RMySQL), does some data manipulation and plots a bunch of graphs.
I designed the app to include a refresh button, with the assumption that when the page is refreshed shiny would re-query the database and re-calculate all the values for the outputs. After testing this, however, it is not doing so (and keeps the old values from pre- refresh). I've tried closing the connection to the database when the refresh button is pressed, then re-opening it, but this just causes the app to disconnect.
My question is why does it remember the old values rather than update them, and is there some way i can tell it to re-do all of it after a refresh? Apologies if this is a really basic question, anything that could point me in the right direction would be great.
I've included an example of the relevant chunks below, although not sure how useful that will be!
library(RMySQL)
library(shiny)
library(shinyjs)
con = dbConnect(RMySQL::MySQL(), dbname="abfd",
username="abc",password="abc123", host='blah, port=3306))
con2 = dbConnect(RMySQL::MySQL(), dbname="abfd",
username="abc",password="abc123", host='blah, port=3306))
frfr<-dbGetQuery(con2, 'CALL Updatedata();' )
Data<-as.data.frame(dbGetQuery(con,'SELECT Date, Age,Name FROM Results
WHERE Date >= DATE(NOW()) - INTERVAL 7 DAY ORDER BY Date Asc;'))
jsResetCode <- "shinyjs.reset = function() {history.go(0)}"
ui <- fluidPage(
shinyjs::useShinyjs(),
extendShinyjs(text = jsResetCode),
actionButton('Refresh','Refresh Data')
)
server <- function(input, output,session) {
observeEvent(input$Refresh,{
{js$reset()}
})
}
shinyApp(ui=ui, server=server)

shiny DT _row_last_clicked

I am having an issue with the _row_last_clicked option provided for tables created in shiny interfaces with the rstudio DT library. I am trying to select a row in a datatable, make modifications to it and output it to the shiny ui.r. It works for the first-time selection, but when I again click on the same table row which I just selected previously, the _row_last_clicked seems to remain unresponsive (=NULL?). Here is a mininmal example (ui.r likely irrelevant) of what I am trying to achieve:
# server.r-side:
table_x<-# ... loads the dataframe
redo_cal<-reactiveValues()
redo_cal$a<-1
observe({
redo_cal$a
output$some_table <- DT::renderDataTable(
table_x,
server = TRUE, # same problem with FALSE
selection =c('single')
)
})
observeEvent(
input$some_table_row_last_clicked,{
s<-input$some_table_row_last_clicked
table_x[s,]<- # some reversible modifications based on the row selection ...
redo_cal$a<-(redo_cal$a+1) # trigger above renderDataTable
})
The issue persists for both the latest github version of DT as well as the release found on CRAN. I have read several related posts but couldn`t figure out a satisfying solution. Thank you very much for your help!
If i understand you right you need some_table_row_selected
and table_x(dd$d - in my example) be reactiveValues
See example where
# some reversible modifications based on the row selection == log of x
Every time you select row value of x in this row log-ed
library(shiny)
library(DT)
data=data.frame(x=1:10,y=2:11)
ui=shinyUI(
fluidPage(
DT::dataTableOutput("tt")
)
)
server=shinyServer(function(input, output) {
dd=reactiveValues(d=data)
output$tt=DT::renderDataTable(
datatable(
dd$d,selection =c('single')
)
)
observeEvent(input$tt_rows_selected,{
dd$d[input$tt_rows_selected,1]<-log(dd$d[input$tt_rows_selected,1])
})
})
shinyApp(ui,server)
In each session your data refreshed
PS
Best minimal example its something which anyone can copy\paste and test.

force Shiny's updateDateRangeInput to send a message to the client immediately (or how to initialize dateRangeInput with data values from the 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).

Resources