I have a shiny App that queries data from SQL. I'm running it on an internal server and want the data to refresh automatically every hour or so.
So far this only works whenever I put the shinApp files newly on the server and run it for the first time. Afterwards, whenever I reload the link, the data is not changing.
I tried using invalidate as below, but it does not refresh the data.
shinyServer(function(input, output, session) {
sourceData <- reactive({
invalidateLater(3000000,session)
return(sourceData())
})
.
.
.
})
where sourceData() is defined
sourceData<-function(){
data1 <<- get_data1( 'query here' )
data2 <<- get_data2( 'query here' )
}
Has anyone had this issue?
I saw reactivepoll() is another option. The valueFunc would be my sourceData, but wasn't sure how to integrate the checkFunc in my context.
If you're not looking to use sourceData() to return anything as this is the way it looks for me you can do one of the following:
1
# sourceData() shouldn't return anything but it will still write into data1 and data2
sourceData <- reactive({
invalidateLater(3000000,session)
data1 <<- get_data1( 'query here' )
data2 <<- get_data2( 'query here' )
})
2
# This is the preferred option as it seems to me you don't want to use sourceData() but rather the data1 and data2
sourceData <- observe({
invalidateLater(3000000,session)
data1 <<- get_data1( 'query here' )
data2 <<- get_data2( 'query here' )
})
Also do look into reactivePoll and there are examples of how to structure it in the reactivePoll and reactiveFileReader
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
I have a problem that has been discussed in different ways here but apparently not to face my quite simple need.
I have a simple app that makes a call to an SQL database. I use a button to launch the query.
I would simply need a text showing "click on button" to download at the very beginning.
Once a user clicks on the button, I would need this output text to show "Downloading the data, please wait".
Once the query is completed and the data has been fully received, I would need the output text to show "Data downloaded successfully."
I've seen some solutions based off the progress bar but I cannot use it since I'm not going through a data.frame. I query the database and I don't know how long this could take.
I've seen other solutions based off reactive values but the text output in this case should react based on the size of the dataframe (0 rows and button clicked -> still downloading the data; >0 rows and button clicked "data downloaded successfully").
Hence, I'm stuck here.
This is my simple code but that ideally does what I would need.
ui <- fluidPage(
fluidRow(actionButton("download_btn", "Download Data")),
fluidRow(textOutput(outputId = "load_data_status")),
fluidRow(dataTableOutput("output_table"))
)
server <- function(input, output) {
cat("\n output$output_table = \n", output$output_table)
data <- eventReactive(input$download_btn,{
output$load_data_status <- renderText({ "Downloading data from Server. Please wait..." })
# here I actually download the data from a database and this could take several seconds
df <- data.frame(mtcars)
output$load_data_status <- renderText({ "Data downloaded succesfully." })
df
})
output$output_table <- renderDataTable({
data()
})
}
shinyApp(ui, server)
Option A:
Here is a pretty good solution by Dean Attali: https://github.com/daattali/advanced-shiny/tree/master/busy-indicator
Option B:
You can listen to JavaScript events to:
Change text when the button is clicked
Change the text again when the output is rendered
I also added Sys.sleep() to simulate some loading time.
Code:
library(shiny)
ui <- fluidPage(
tags$head(tags$script(HTML('
// 1. Change text to "Downloading..." when button is clicked
$(document).on("shiny:inputchanged", function(event) {
if (event.name === "download_btn") {
$("#download_btn").html("Downloading data from Server. Please wait...");
}
});
//. 2. Change text to "Success" when output table is changed
$(document).on("shiny:value", function(event) {
if (event.name === "output_table") {
$("#download_btn").html("Data downloaded succesfully.");
}
});
'))),
fluidRow(actionButton("download_btn", "Download Data")),
fluidRow(DT::dataTableOutput("output_table"))
)
server <- function(input, output) {
data <- eventReactive(input$download_btn,{
df <- data.frame(mtcars)
Sys.sleep(3) # Simulate some loading time
df
})
output$output_table <- renderDataTable({
data()
})
}
shinyApp(ui, server)
Output:
I have a dynamic interface that gets created in a huge function. The function spits out a taglist with all the input features and other stuff too. Among this is a DT table. That's all good and works fine. Now I want to be able to replaceData() in the DT, however while creating the taglist i can assign an elementID to the datatable() but the renderDT overwrites that.
If I leave out the renderDT() the table still shows but the replaceData() fails with a
DataTables warning: table id=DataTables_Table_0 - Invalid JSON response.
For more information about this error, please see http://datatables.net/tn/1
error message.
Current working but really bad solution: If I have the renderDT(), some hashed ID is created which starts "out". This can be catched in an observe() and used to create the datatableProxy() object which can then be used to replaceData(). A problem with this is that you can only have one tabel and it is terrible.
there is already an issue on DT git: https://github.com/rstudio/DT/issues/567 but no solution.
library(shiny)
ui <- fluidPage(
uiOutput("inputs")
)
server <- function(input, output, session) {
output$inputs <- renderUI({
tagList( h1("a table has no id")
,renderDT(datatable(mtcars,elementId = "thisDoesHaveAnID"))
,actionButton("replaceDataGo","Replace data go!")
)
})
observeEvent(input$replaceDataGo,{
tableid <- gsub("_.*","",names(input)[grep("out.*",names(input))][1])
tableProxy <- dataTableProxy(tableid,session = session)
replaceData(tableProxy,mtcars[1:input$replaceDataGo,])
})
}
shinyApp(ui, server)
Is there any was to apply an ID maybe already in the taglist to this render?
I'm trying to debug my shiny dashboard
For several render* function, I need to debug them with some log (with print or cat) but I can't use those function inside a renderDataTable() / renderText()
for example:
output$selectedData = renderDataTable(
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
)
I would like to print something to the console before and after the instruction of renderDataTable() but
output$selectedData = renderDataTable(
cat("rendering...")
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
cat("rendered")
)
How can I do this ?
Here is a possible solution to the problem. First I use a variable called data to assingn any calculations to, in your case
data<-myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]. This is used inside the render function and will be created when the output is rendered since it relies on this. I then use an observe function that requires the variable data to be created before printing the second "rendered" to the console. That works once on startup, and will work fine if your data is constant. If you have changing data, for my example the data changes with a user selection, we will have to re-render the table. Since the render function is reactive and you are using input$process_tokens, the render function will re-run when the input changes. In this example it runs when input$select changes. When it runs it resets the variable data to NULL, and we trigger a separate observeEvent that monitors changes to input$select(input$process_tokens). This observeEvent also requires data before continuing, and since the render function set it to null it will not print the second "rendered" until data is created, just as in the first case.
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("select","select",choices=(c(1,2,3,4)))
),
mainPanel(
dataTableOutput("selectedData")
)
))
server <- function(input, output, session) {
data<-reactive({data.frame(input$select,4,5)})
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<-datatable(data())
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$select,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Specific code for you:
server <- function(input, output, session) {
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<- myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$process_tokens,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Note that you will get two "rendered" printouts when the program initially starts, this is b/c both the observe and observeEvent run since both conditions are met. If your data does change with input$process_tokens, then you can get rid of the observe function, and only use the observeEvent. If your data does not change and the table is only rendered once, then get rid of the observeEvent. I was trying to cover all bases.
I'm writing a Shinyapp that enables users, among other things, to input new entries to a mongodb and delete specific rows from it.
I'm trying to add a functionality that would allow to undo the last delete by saving a temporary copy of the row. It seems to work fine, but after I use undo, for some reason the delete button doesn't work anymore, and I can't figure out why.
I thought maybe it has something to do with the fact that there's a few other places where I use observers for the two buttons, but I don't understand why that would cause any problem (and I need them for the app to function properly) - at any rate, they don't prevent me from deleting several rows one after the other so long as I don't use the undo function.
As you can see from the code below, I've put a bunch of print() functions throughout it to try and figure out where it's going. The weird thing - none of them show up! It's like the delete button simply doesn't activate the script once undo was used. Any ideas why?
UPDATE: Here's a short version of server.R and ui.R that reproduces the problem (without using mongodb):
server.R
tempEntry<-NULL
shinyServer(function(input, output, session) {
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
## Action: Delete entry
output$delError<-renderText({
input$delButton
isolate({if (!is.na(input$delNum)) {
tempEntry<<-dat[input$delNum,]
output$undo<<-renderUI({
actionLink("undo","Undo last delete")
})
dat<<-dat[-input$delNum,]
print("deleted")
print(dat)
} else print("nope2")
})
})
## Action: Undo delete
output$undoError<-renderText({
input$undo
if (!is.null(input$undo)) {
if (input$undo>0) {
isolate({if (!is.null(tempEntry)) {
dat<<-rbind(dat,tempEntry)
tempEntry<<-NULL
output$delError<<-renderText({""})
print(dat)
} else print("nope3")
}) } else print("undo==0") } else print("undo null")
})
})
ui.R:
library(shiny)
shinyUI(navbarPage("example",
tabPanel("moo",
titlePanel(""),
fluidPage(numericInput("delNum","Row to delete",value=NULL),
actionButton("delButton","Delete row"),
uiOutput("undo"),
div(p(textOutput("delError")),style="color:red"),
div(p(textOutput("undoError")),style="color:blue")
))))
(This also gives an error "argument 1 (type 'list') cannot be handled by 'cat'" after deleting a row, I don't know why... But the problem doesn't seem to be related to that).
Thanks!
That happens because of the output$delError<<-renderText({""}) code that overwrites the original output$delError expression by the empty one, so no surprise output$delError does not trigger on input$delButton any more.
[UPDATE]
The OP's application uses actionButton and actionLink to delete and undelete records from a database, respectively. The 'delete' button is supposed to trigger the delError expression that deletes the record and shows the outcome of deletion (e.g. 'record deleted'). Similarly, the 'undelete' button triggers the undoError expression that puts the record back into the table and reports an outcome of undeletion (e.g. 'record undeleted'). The problem is that undoError has to get rid of the output produced by delError because outputs 'record deleted' and 'record undeleted' don't make much sense when they appear together, but the output 'record deleted' can be removed only by the delError expression.
It seems that this problem can be resolved by modifying delError to make it hide its output when the 'undelete' button (or link) is pressed. But in this case, delError would trigger on both 'delete' and 'undelete' buttons without being able to say which button caused the evaluation, so it would try to delete a record when the 'undelete' button is pressed!
The sample application below provides a way to address this problem by using a global variable that stores the status of the last operation. This status is generated by two high-priority observers (one for 'delete' and another for 'undelete'), which also take care of actual deleting/undeleting of the record. The observers don't produce output that directly goes to the web page, so there is no hassle with getting rid of the messages produced by the other observer. Instead, the status variable is shown by a simple reactive expression.
server.R
tempEntry<-NULL
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
shinyServer(function(input, output, session) {
del.status <- NULL
##################
### Observers ####
##################
delete.row <- observe({
if (input$delButton ==0 ) return() # we don't want to delete anything at start
delNum <- isolate( input$delNum ) # this is the only thing that needs to be isolated
if (is.na(delNum)) {
print('nope2')
return()
}
tempEntry <<- dat[delNum,]
dat <<- dat[-delNum,]
output$undo <<- renderUI( actionLink("undo","Undo last delete") )
del.status <<- 'deleted'
},priority=100) # make sure that del.status will be updated *before* the evaluation of output$delError
undelete.row <- observe({
if (is.null(input$undo) || input$undo==0) return() # trigger on undowe don't want to undelete anything at the beginning of the script
dat <<- rbind(dat,tempEntry)
tempEntry <<- NULL
output$undo <<- renderUI("")
del.status <<- 'undeleted'
},priority=100)
##################
### Renderers ####
##################
output$delError <- renderText({
if (input$delButton == 0) return() # show nothing until first deletion
input$undo # trigger on undo
return(del.status)
})
output$show.table <- renderTable({
input$delButton; input$undo # trigger on delete/undelete buttons
return(dat)
})
})
ui.R
library(shiny)
shinyUI(
navbarPage(
"example"
, tabPanel("moo"
, titlePanel("")
, fluidPage(
numericInput("delNum","Row to delete",value=NULL)
, div(p(textOutput("delError")),style="color:red")
, actionButton("delButton","Delete row")
, uiOutput("undo")
, tableOutput('show.table')
)
)
)
)