Displaying deployment time on R shiny app - r

I have a shiny app which will be redeployed roughly each week to shinyapps.io using the rsconnect package.
On the front page of the app I want to display the time the app was last deployed.
I thought this would be possible by doing something along the lines of this:
library(shiny)
deployment_time <- lubridate::now()
ui <- fluidPage(
p(glue::glue("Deployment time {deployment_time}"))
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
The reasoning behind this is that deployment_time is set outwith the server, so should only be run once when the app is deployed and not when users view the app later on.
However, the behaviour I am observing is that after a few times loading the app the deployment time will update to the current time, suggesting that this code is in fact rerun at some point.
Any ideas what's going on and how I can set a deployment time which stays fixed without having to manually set a date in the script?
Thanks in advance :)

I would store the last deployment date in a local file that's uploaded to the your Shiny Server alongside your application code.
Below is a minimally reproducible example.
Deployment Record
First is a function that you will only run when deploying an application. You can take some time to insert this function into your deployment scripts so that it writes the time prior to uploading your files to the server.
#' Record the date of app deployment.
record_deployment_date <-
function(deployment_history_file = "deployment_history.txt") {
# make sure the file exists...
if (!file.exists(deployment_history_file)) {
file.create(deployment_history_file)
}
# record the time
deployment_time <- Sys.time()
cat(paste0(deployment_time, "\n"),
file = deployment_history_file,
append = TRUE)
}
Then, you'll have another function to access the last recorded deployment date.
#' Return the last recorded deployment date of the application.
load_deployment_date <-
function(deployment_history_file = "deployment_history.txt") {
deployment_history <- readLines(deployment_history_file)
# return the most recent line
deployment_history[[length(deployment_history)]]
}
Minimal App Example
Finally, you can call the previous function and insert the loaded text into a renderText function to show your last deployment date.
ui <- fluidPage(mainPanel(tags$h1("My App"),
textOutput("deploymentDate")))
server <- function(input, output, session) {
output$deploymentDate <- renderText({
paste0("Deployment Time: ", load_deployment_date())
})
}
shinyApp(ui, server)
Naturally you will want to change the location of your deployment_history.txt file, customize the formatting of your time, etc. You could take this one step further to also include the deployment version. But, this is the minimal info you need to get started.

Related

R Shiny Dashboard - Loading Scripts using source('file.R')

Introduction
I have created an R shiny dashboard app that is quickly getting quite complex. I have over 1300 lines of code all sitting in app.R and it works. I'm using RStudio.
My application has a sidebar and tabs and rather than using modules I dynamically grab the siderbar and tab IDs to generate a unique identifier when plotting graphs etc.
I'm trying to reorganise it to be more manageable and split it into tasks for other programmers but I'm running into errors.
Working Code
My original code has a number of library statements and sets the working directory to the code location.
rm(list = ls())
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
getwd()
I then have a range of functions that sit outside the ui/server functions so are only loaded once (not reactive). These are all called from within the server by setting the reactive values and calling the functions from within something like a renderPlot. Some of them are nested, so a function in server calls a function just in regular app.R which in turn calls another one. Eg.
# Start of month calculation
som <- function(x) {
toReturn <- as.Date(format(x, "%Y-%m-01"))
return(toReturn)
}
start_fc <- function(){
fc_start_date <- som(today())
return(fc_start_date)
}
then in server something like this (code incomplete)
server <- function(input, output, session) {
RV <- reactiveValues()
observe({
RV$selection <- input[[input$sidebar]]
# cat("Selected:",RV$selection,"\r")
})
.......
cat(paste0("modelType: ",input[[paste0(RV$selection,"-modeltype")]]," \n"))
vline1 <- decimal_date(start_pred(input[[paste0(RV$selection,"-modeltype")]],input[[paste0(RV$selection,"-modelrange")]][1]))
vline2 <- decimal_date(start_fc())
.......
Problem Code
So now when I take all my functions and put them into different .R files I get errors indicating the functions haven't been loaded. If I load the source files by highlighting them and Alt-Enter running them so they are loaded into memory then click on Run App the code works. But if I rely on Run App to load those source files, and the functions within them, the functions can't be found.
source('./functionsGeneral.R')
source('./functionsQuote.R')
source('./functionsNewBusiness.R')
source('./ui.R')
source('./server.R')
shinyApp(ui, server)
where ui.R is
source('./header.R')
source('./sidebar.R')
source('./body.R')
source('./functionsUI.R')
ui <- dashboardPage(
header,
sidebar,
body
)
Finally the questions
In what order does R Shiny Dashboard run the code. Why does it fail when I put the exact same inline code into another file and reference it with source('./functions.R')? Does it not load into memory during a shiny app session? What am I missing?
Any help on this would be greatly appreciated.
Thanks,
Travis
Ok I've discovered the easiest way is to create a subfolder called R and to place the preload code into that folder. From shiny version 1.5 all this code in the R folder is loaded first automatically.

How to specify available time for Shiny App usage

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)

Shiny Application to check something at a specified time

I was wondering if there was a way to get Shiny to check something at a specified time each day if it is running. Now I know this is not recommended and I have read through
Schedule task on a shiny application
Schedule R script using cron
call myFunction daily, at specific time, in shiny?
as well as I am aware of the reactiveTimer function in Shiny. However, I have developed and deployed my Shiny App as a desktop app instead of a url and consequently my colleagues like to leave it open. Here is the basic example of what I am trying to:
library(shiny)
ui <- fluidPage()
server <- function(input, output, session) {
test <- reactiveValues(value = format(as.POSIXlt(Sys.time()), "%H:%M"))
observeEvent(test$value == "7:15", {
stopApp()
})
}
shinyApp(ui, server)
The reason I would like the application to stop at a scheduled time is because I want the application to check for an update and re-launch after it updates. I suppose it should only stop if their is something to update but the above is a simpler idea of what I am trying to accomplish.
Is there anyway to get shiny to execute some code at a specific time? I know reactiveTimer is an option but this performs a task after a specified amount of time but not at a specific time each day.
Another option is if I could get a vbs script or even just a different r script to close the Shiny App but I have not been able to figure out how to do that either. Any advice or ideas would be a big help. Thanks!
This does the trick (a little verbose, but works)
You need to set the variable timeStop (HH:MM:SS)
library(shiny)
ui <- fluidPage(
uiOutput("info")
)
server <- function(input, output, session) {
## Variable to set the time when app stops automatically (HH:MM:SS)
timeStop <- "22:47:20"
toStop <- as.POSIXct(timeStop, format="%H:%M:%S")
if (Sys.time() > toStop) {
toStop <- toStop + 86400
}
secsToStop <- round(as.numeric(difftime(toStop, Sys.time(), units = "secs")) * 1000)
timeToStop <- reactiveTimer(secsToStop)
trick <- reactiveValues()
trick$toFire <- FALSE
observeEvent(timeToStop(), {
if (trick$toFire) {
stopApp()
} else {
trick$toFire <- TRUE
}
})
output$info <- renderUI({
h2(paste("App will stop automatically at ", toStop))
})
}
shinyApp(ui, server)

R Shiny run task/script in different process

In my Shiny app users can generate heavy powerpoint report. When it contains a lot of slides it could take > 30 minutes to be done. And therefore I'd like to process those tasks in independent processes/tasks which could work even when app is closed - e.g. user clicks button to generate report, closes app and when report is ready app informs user by email.
Are there any good practices or proven solutions to do this?
My first thought was using future package with plan(multisession) set - but I'm not sure what happens when user closes the app - future session closes too or not?
I was lucky enough to be at London EARL this week and I think one of the best presentations I saw there was about exactly this (by Joe Cheng). You would need the promises package for this to work and as it says on the documentation a special version of shiny devtools::install_github("rstudio/shiny#async") that supports asynchronous programming.
You can find a first documentation here on how this works by using dplyr and promises (future is also compatible).
As a small example (taken from the documentation), running an intensive calculation using the following:
read.csv.async("data.csv") %...>%
filter(state == "NY") %...>%
arrange(median_income) %...>%
head(10) %...>%
View()
would essentially return the console cursor back, allowing you to run any other command you want and would automatically open the View tab once this was finished. I might be able to dig out a shiny example in a bit, but keep in mind this is still under development and will be released before the end of the year (with a more comprehensive documentation I would imagine).
So I made some example workaround using future package. Code executes in separate session (cluster) even when app is closed. I think the next step is just to figure out how app should check if process is still running or is finished. Any ideas?
library(future)
cl <- parallel::makeCluster(2L)
plan(cluster, workers = cl)
server <- function(input, output) {
observeEvent(input$run, {
iteration <- as.numeric(input$iteration)
path <- input$path
future::future({
writeLog <- function(n, path) {
file.remove(path)
for (i in 1:n) {
cat("#", i, "-", as.character(Sys.time()), "\n", file = path, append = TRUE)
Sys.sleep(1)
}
}
writeLog(iteration, path)
}, globals = c("iteration", "path"))
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
tags$div("This app writes to file in cluster which means it is computed in parallel to this session.
It will execute even when app is closed.")
, br()
, shiny::textInput("path", "Path to log file", value = "/src/dev/export_performance/future.log")
, shiny::textInput("iteration", "Iteration number", value = 60)
),
mainPanel(
br()
, actionButton("run", "Run future")
)
)
)
shinyApp(ui = ui, server = server)

server.R needs to be touched for execution

My Shiny app is supposed to read a directory and capture all rds files. It is running fine. But when a new rds file is coming into directory from where app suppose to read, it's not able to read new file. When I touch server.R then app is able to capture new file as well.
So long story in short, whenever a new file is coming into directory, I need to to touch server.R file to work as latest content. I am not making any changes in server.R. To execute successfully I need to run "touch server.R". has someone seen this before?
I am not able to understand, server.R needs any change in time stamp to run successfully.
Thanks!
Tinku
# MrFlick - No I haven't hard coded anything in server.R file. Actually same code is working on other server. I just copied the same program from test to qa box and not it changed the behavior. If I touched the server.R file and refresh the browser then it is working fine. Very starange for me!
#jdharrison - Thanks for your suggestion. But this (my existing server.R) code is running fine on dev server but when I moved to QA, then it not running as expected. I am surprised, that what touch or any non significant change in server.R is enabling it to run fine for one time.
Actually server.R code is reading the .RDS files from the directory and displaying in drop down list. it is working fine on dev server. But on QA server, if I am deleting or creating any new .RDS file then it's not displaying in drop down list automatically, until I touch the server.R file.
You can use a reactivePollto periodically check the directory you are interested in. In this example an actionButton allows the user to add a file to a test directory. The test directory is polled every second by the app and a table with file info is displayed:
library(shiny)
dir.create('test', showWarnings = FALSE)
write(1:3, 'test/dumfile.txt')
write(1:3, 'test/dumfile2.txt')
readTimestamp <- function() Sys.time()
valueFunc <- function() {
print(readTimestamp())
out <- lapply(list.files('test', full.names = TRUE), file.info)
do.call(rbind.data.frame, out)
}
runApp(list(
ui = bootstrapPage(
actionButton("addFile", "Add a file!"),
tableOutput('myTable')
),
server = function(input, output, session) {
observe({
if(input$addFile > 0){
write(1:3, tempfile('file', 'test', '.txt'))
}
})
dirData <- reactivePoll(1000, session, readTimestamp, valueFunc)
output$myTable <- renderTable({
myData <- dirData()
myData
})
}
))

Resources