I have an R-Shiny application, and inside the server function I fetch data to use within. Because I want to re-fetch this data after every 20 seconds or so, I have added the following function at the end of the server function as below:
server <- function(input, output, session) {
# Process data
# ...
# Reload data
counter <- reactiveVal(0)
observe({
invalidateLater(20000, session)
if (counter() > 0) {
session$reload()
} else{
counter(isolate(counter()) + 1)
}
})
}
The problem is that session reload seems to be called immediately the server function has finished execution, that is, way quicker that indicated in the by invalidateLater().
Is there a way to make this work, would be grateful for any other approach.
Related
I am quite new to R. I tried to use reactivePoll to update my dashboard data. All my data is drawn from the database. The code shows no error. But the dashboard is not updated by day as I set it. Here is my code:
log_db <- reactivePoll(60000*60*24, session,
# Check for maximum month
checkFunc = function() {
#connect to the database
#check for maximum month in the database. If there's a change, the value function will run.
maxmonth <- paste("SQL code")
month <- dbGetQuery(maxmonth)
return(month)
},
# Pull new table if value has changed
valueFunc = function() {
#connect to db
#pull new dataframe,
return(oldnew_combined)
}
)
}
I think the format is fine since there are no error shows. I also tried to see the maximum month in the console. However, it says object not found which basically means the checkFunc didn't run. I wonder what goes wrong here. Thank you!
Steps:
1-You need to create the reactivepoll inside the server. log_db
2-
Create a rendering object inside the server (in your case: renderTable) with reactivePoll inside with parentheses: output$idforUi<- renderTable( { log_db() })
3-Create the output for your render object in the ui.
ui=fluidPage(tableOutput("idforUi"))
library(shiny) # good practices
library(RMariaDB) #good practices
server <- function(input, output,session) {
#The connection to SQL does not need to be inside the checkfunction or valuefunction,
#if you put it inside the checkfunction it will connect every milliseconds argument.
#If you place the connection inside the server but outside the reactivePoll, when you open the app it connects, and updates every milliseconds inside the reactivePoll
localuserpassword="yourpassword"
storiesDb<- dbConnect(RMariaDB::MariaDB(), user='YOUR_USER', password=localuserpassword, dbname='DBNAME', host='YOURHOST')
#your database will be checked if it changes every 60000 * 60 * 24 milliseconds (24 hours)
log_db <- reactivePoll(60000*60*24, session, #reactivePoll inside the server
# Check for maximum month
checkFunc = function() {
query2= "SELECT * FROM YOURTABLE"
rs = dbSendQuery(storiesDb,query2)
dbFetch(rs)# visualize
},
# Pull new table if value has changed
valueFunc = function() {
query2= "SELECT * FROM YOURTABLE"
rs = dbSendQuery(storiesDb,query2)
dbFetch(rs)# visualize
}
)
#log_db is a function dont forget the () inside renderTable()
output$idforUi<- renderTable( { log_db() }) # renderTable
#create a object to send the result of your reactivepoll for User Interface
}
# table output
ui=fluidPage(tableOutput("idforUi"))
# Receive the result of your reactivepoll in the User Interface
shinyApp(ui, server)
You are unable to access it from the console does not mean that checkFunc did not run,you will not be able to access the "month" object on the console because it exists only in the reactivepoll function(local variable), not in global environment. See this
Is there a way to undo callModule? The use case is I have a variable number of modules - the number responds to user selection. Let's say the user chooses 10, then a different 10 - is there a way to remove the original 10? Does it happen automatically? I'm worried that memory is being occupied and not released.
It's a bit tricky creating an reprex, here's a snippet of what I mean though:
observeEvent(
input$people
, {
input$people %>%
walk(
~callModule(people_info_server, .x)
)
}
)
Every time the vector input$people changes, the module with people_info_server gets called on each element of input$people and generates a page of information for each person.
What I'd like to do is something like this:
observeEvent(
input$people
, {
remove_existing_calls(people_info_server) # Not sure how to define this function
input$people %>%
walk(
~callModule(people_info_server, .x)
)
}
)
I suppose you would have to create a "destructor" for your module and make sure that the client of the module (the "main app") calls the destructor at the right time. For example, let us suppose the module returns the destructor as a closure.
library(shiny)
## module definition
module_with_destructor <- function(input, output, session) {
output$plot <- renderPlot({
plot(1:input$n)
})
destructor <- function() {
# add more cleanup logic here
output$plot <- NULL
}
return(destructor)
}
We now need to make sure that the main app executes the destructor when memory should be freed.
## main app (client)
myenv <- new.env()
observeEvent(input$create_module, {
if (is.null(myenv$destructor))
myenv$destructor <- callModule(module_with_destructor, "module_id")
})
observeEvent(input$destroy_module, {
if (!is.null(myenv$destructor))
myenv$destructor()
})
Of course, you will have to implement some extra logic in order to use this idea with a dynamic number of modules. However, in your case you could just create a list that collects all the individual destructors and then iterate over them.
I have developed a Shiny app that allows the user conditional selection of some dependent events. A very simplified toy example is below to help illustrate my question/problem.
In my real problem, the server code contains multiple computationally expensive procedures that are optional to run. There is a "baseline" function that must run to produce output and then firstObject or secondObject take that as input and produce more output if it is selected by the user to do so.
Each function can take upwards of 30 to 40 minutes. So, I wrote the code to allow the user to select using the checkInputBox which functions they want to run and then after selecting them, there is a single action button that runs them all allowing the user to leave and let the process take its course over many hours. This was more convenient than having an actionButton associated with each possible event.
The code below is successful in yielding all the desired output. But, I am not sure from a design point of view if it is "right". In my toy example, the code is simple, but suppose the code for baseObject takes 30 minutes to run. While baseObject is running, the code for firstObject and secondObject were also executed because they depend on the same action button. But, they cannot do anything until the function for baseObject is done. Similarly secondObject cannot do anything until firstObject is done.
Again, this all works and yields the correct output (in my real code as well as in the toy code). But, is there a way to maintain the single action button, but for firstObject to not do anything UNTIL baseline Object has produced its output and then secondObject would wait for firstObject to yield its output if the user selected it.
My worry is that I am creating additional computational overhead in the firstObject is trying to do something it cannot do until baseObject is done and it is cycling over and over until it can properly execute.
I know I can create different action buttons. For instance I could create an action button for baseline and then the user could wait until it is done and then click the action button for firstObject and so on. But, functionally this would not work as in the real problem this allows the entire selected process to run, which can take hours and the user does not need to be in front of their machine.
Thank you and I hope this code helps illustrate the problem as I have described it.
ui <- {
fluidPage(
h3('Run Stuff'),
checkboxInput("runModel1", "Model 1"),
checkboxInput("runModel2", "Model 2"),
actionButton('runAll', 'Run Models'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
}
server <- function(input, output, session) {
baseObject <- eventReactive(input$runAll, {
if(input$runModel1){
runif(100)
}
})
firstObject <- eventReactive(input$runAll, {
if(input$runModel1){
runif(100) + baseObject()
}
})
secondObject <- eventReactive(input$runAll, {
if(input$runModel2){
runif(100) + firstObject()
}
})
output$out1 <- renderPrint({
if (input$runModel1)
firstObject()
})
output$out2 <- renderPrint({
if (input$runModel2)
secondObject()
})
} # end server
shinyApp(ui, server) #run
Two things to remember about reactive expressions:
Reactive expressions are lazy and only execute when called by something else. This is different from observers, which execute immediately any time their dependencies change.
Reactive expression results are cached. As long as their dependencies have not changed, subsequent calls won't cause the expression to re-execute, but instead retrieve the cached value.
Based on these two points, I don't think you have a problem and your example does what you're looking for. With both checkboxes ticked, each reactive expression would only run once per action button click.
Although I can suggest removing the unnecessary if statements in the eventReactives. That would allow the user to only check runModel2 and have all its dependencies run properly. Modified example below - I also added some message(...) statements so you can see the execution flow in the R console.
library(shiny)
ui <- fluidPage(
h3('Run Stuff'),
checkboxInput("runModel1", "Model 1"),
checkboxInput("runModel2", "Model 2"),
actionButton('runAll', 'Run Models'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
server <- function(input, output, session) {
baseObject <- eventReactive(input$runAll, {
message("calculating baseObject...")
result <- runif(100)
message("...baseObject done")
return(result)
})
firstObject <- eventReactive(input$runAll, {
message("calculating firstObject...")
result <- runif(100) + baseObject()
message("...firstObject done")
return(result)
})
secondObject <- eventReactive(input$runAll, {
message("calculating secondObject...")
result <- runif(100) + firstObject()
message("...secondObject done")
return(result)
})
output$out1 <- renderPrint({
if (input$runModel1)
firstObject()
})
output$out2 <- renderPrint({
if (input$runModel2)
secondObject()
})
}
shinyApp(ui, server)
I'm having trouble creating a sequence of events in a Shiny app. I know there are other ways of handling parts of this issue (with JS), and also different Shiny functions I could use to a similar end (e.g. withProgress), but I'd like to understand how to make this work with reactivity.
The flow I hope to achieve is as follows:
1) user clicks action button, which causes A) a time-consuming calculation to begin and B) a simple statement to print to the UI letting the user know the calculation has begun
2) once calculation returns a value, trigger another update to the previous text output alerting the user the calculation is complete
I've experimented with using the action button to update the text value, and setting an observer on that value to begin the calculation (so that 1B runs before 1A), to ensure that the message isn't only displayed in the UI once the calculation is complete, but haven't gotten anything to work. Here is my latest attempt:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("run", "Pull Data")
mainPanel(
textOutput("status")
)
)
)
server <- function(input, output, session) {
# slow function for demonstration purposes...
test.function <- function() {
for(i in seq(5)) {
print(i)
Sys.sleep(i)
}
data.frame(a=c(1,2,3))
}
report <- reactiveValues(
status = NULL,
data = NULL
)
observeEvent(input$run, {
report$status <- "Pulling data..."
})
observeEvent(report$status == "Pulling data...", {
report$data <- test.function()
})
observeEvent(is.data.frame(report$data), {
report$status <- "Data pull complete"
}
)
observe({
output$status <- renderText({report$status})
})
}
Eventually, I hope to build this into a longer cycle of calculation + user input, so I'm hoping to find a good pattern of observers + reactive elements to handle this kind of ongoing interaction. Any help is appreciated!
Note : I have read almost all the discussions on this object in shiny googlegroups and here in SO.
I need an indicator that shows the shiny server is busy. I have tried shiny-incubator, however, the problem is that I can't set a max for progress bar.
I don't want something like this : https://shiny.rstudio.com/gallery/progress-bar-example.html
What I need is something that:
shows a busy indicator message and bar (i.e just a simple animated bar, do not need to show a filling bar) as long as the server is calculating
it is shown in no matter which tab you are viewing. (not only in the related tab, but on top of the tabset)
Update 2018: Currently there is a great package to help you display loaders: shinycssloaders (source: https://github.com/andrewsali/shinycssloaders)
I've been looking for this as well. Most people suggest a conditional panel like so:
conditionalPanel(
condition="!($('html').hasClass('shiny-busy'))",
img(src="images/busy.gif")
)
You could always give yourself more control and create the conditional handling (maybe depending on more stuff) like this in your ui.R:
div(class = "busy",
p("Calculation in progress.."),
img(src="images/busy.gif")
)
where some JavaScript handles the showing and hiding of that div:
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
$('div.busy').show()
} else {
$('div.busy').hide()
}
},100)
with some extra css you could make sure your animated busy image gets a fixed postion where it will always be visible.
In any of the above cases i found that the "shiny-busy" condition is somewhat imprecise and unreliable: the div shows for a split second and disappears while computations are still going on...
I found a dirty solution to fix that problem, at least in my apps. Feel free to try it out and maybe someone could give an insight to how and why this solves the issue.
In your server.R you'll need to add two reactiveValues:
shinyServer(function(input, output, session) {
# Reactive Value to reset UI, see render functions for more documentation
uiState <- reactiveValues()
uiState$readyFlag <- 0
uiState$readyCheck <- 0
then, in your renderPlot function (or other output function where computations go on), you use these reactive values to reset the function:
output$plot<- renderPlot({
if (is.null(input$file)){
return()
}
if(input$get == 0){
return()
}
uiState$readyFlag
# DIRTY HACK:
# Everytime "Get Plot" is clicked we get into this function
# In order for the ui to be able show the 'busy' indicator we
# somehow need to abort this function and then of course seamlessly
# call it again.
# We do this by using a reactive value keeping track of the ui State:
# renderPlot is depending on 'readyFlag': if that gets changed somehow
# the reactive programming model will call renderPlot
# If readyFlag equals readyCheck we exit the function (= ui reset) but in the
# meantime we change the readyFlag, so the renderHeatMap function will
# immediatly be called again. At the end of the function we make sure
# readyCheck gets the same value so we are back to the original state
isolate({
if (uiState$readyFlag == uiState$readyCheck) {
uiState$readyFlag <- uiState$readyFlag+1
return(NULL)
}
})
isolate({plot <- ...})
# Here we make sure readyCheck equals readyFlag once again
uiState$readyCheck <- uiState$readyFlag
return(plot)
})
Alternatively, you can use shinycssloaders package https://github.com/andrewsali/shinycssloaders
library(shiny)
library(dplyr)
library(shinycssloaders)
ui <- fluidPage(
actionButton("plot","plot"),
plotOutput("Test") %>% withSpinner(color="#0dc5c1")
)
server <- function(input, output, session) {
data <- eventReactive(input$plot,{
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
Using waiter
library(shiny)
library(waiter)
ui <- fluidPage(
use_waiter(),
actionButton("plot","plot"),
plotOutput("Test")
)
server <- function(input, output, session) {
w <- Waiter$new(id = "Test")
data <- eventReactive(input$plot,{
w$show()
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
I found using fadeIn() as opposed to show() helps mitigate this blinking occurence:
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
setTimeoutConst = setTimeout(function(){
$('#loading-page').fadeIn(500);
}, delay);
} else {
clearTimeout(setTimeoutConst );
$('#loading-page').hide();
}
},10)
The busy div also appears for split seconds for the latest versions of shiny, even though no apparent calculations are going on (it was not an issue in older versions). Shiny seems to be regularly in its busy-mode for a short time. As a solution (complementing the above discussion), one can include another 2nd delayed validation of the shiny-busy html class for the conditional handling. The JavaScript-part would look something like that (example also includes check for two different div.busy-states depending on the reactive textit):
if( ($('html').attr('class')=='shiny-busy') ){
setTimeout(function() {
if ($('html').attr('class')=='shiny-busy') {
if($('#textit').html()!='Waiting...' ){
$('div.busy1').show()
}
if($('#textit').html()=='Waiting...'){
$('div.busy2').show()
}
}
},1000)
} else {
$('div.busy1').hide()
$('div.busy2').hide()
}
},100)