use reactivePoll to monitor the change of folder - r

I am new to shiny, and trying to make a folder monitor based on #jdharrison 's reply at
Use reactivePoll to accumulate data for output
The f1, or check function, seems like a validator. Once it gives whatever results, it triggers the f2, the true action-taker. Then, we render the output.
As the toy sample runs, the f1 does creates files, but not producing the result of listing all the files, as expected.
by the way, the code is running on ubuntu, and the files are saved in a sub-directory called temp
Where did I go wrong?
Would like to invite your advice.
runApp(
list(
ui =
mainPanel(
tableOutput("DT")
),
server =
function(input, output, session) {
# f1 as a tempfile creater. Once it is called. it creates a txt
f1 <- function() system(paste0("touch ", tempfile(tmpdir = "./temp", fileext = "txt")))
# f2 list all the files
f2 <- function(){
list.files("temp", full.names = T)
}
data <- reactivePoll(5000, session, f1, f2)
output$DT <- renderTable(data())
}
)
)
Thanks to suggection from #TonioLiebrand. The f1, check function, is exactly what it is, a checking function.
After I change the return of f1, it works.
I will keep the post here maybe it might help someone someday.
runApp(
list(
ui =
mainPanel(
DTOutput("DT")
),
server =
function(input, output, session) {
f1 <- function() {
system(paste0("touch ", tempfile(tmpdir = "./temp", fileext = "txt")))
file.info(list.files("temp", full.names = T))["mtime"]
}
f2 <- function(){
list.files("temp", full.names = T) %>% as.matrix()
}
data <- reactivePoll(5000, session, f1, f2)
output$DT <- renderDT({datatable(data())})
}
)
)

Related

Read json file continuously

I want to read a json file continuously, e.g. every 1000 ms.
One option my be reactiveFileReader
reactiveFileReader(intervalMillis, session, filePath, readFunc, ...)
described here.
This function seems only working with csv files and not for json files:
file_data <- reactiveFileReader(intervalMillis = 1000, NULL, filePath = json_path, readFunc = read.json)
observe({
View(file_data())
})
Error in View : object read.json not found
With reactivePoll like here:
getJsonData <- reactivePoll(1000, session,
checkFunc = function() {
if (file.exists(path))
file.info(path)$mtime[1]
else
""
},
valueFunc = function() {
read_json(path)
}
I get nearly what I want, but this function is not working in my context. How do I force the program to read the file every second and not only when the content of the file is changing?
Are there other possibilities I not have thought about yet?
In your first way, you wrote read.json instead of read_json.
With your second way, you could replace file.info(path)$mtime[1] with runif(1, 0, 1e6). You would be very unlucky if runif returns the same number two consecutive times.
Finally, a third way could be:
server <- function(input, output, session){
autoInvalidate <- reactiveTimer(1000)
getJsonData <- reactive({
autoInvalidate()
read_json("path/to/file.json")
})
}
Here is a reprex on how to use reactiveFileReader with a json file.
I used a future to detach the writing process from the shiny session - you can simply replace this with your json input.
library(shiny)
library(jsonlite)
library(datasets)
library(promises)
library(future)
plan(multisession(workers = 2))
ui <- fluidPage(
uiOutput("printResult")
)
server <- function(input, output, session) {
json_path <- tempfile(fileext = ".json")
write_json(NULL, json_path)
# async file writing process
future({
for(i in seq_len(nrow(iris))){
Sys.sleep(1)
write_json(iris[i,], json_path)
}
})
file_data <- reactiveFileReader(intervalMillis = 1000, NULL, filePath = json_path, readFunc = read_json)
output$printResult <- renderUI({
req(file_data())
})
}
shinyApp(ui, server)

Save a file via sink function in shiny server?

I have a shiny app to generate a .txt file to download.
In addition, I would like to keep a copy of the file that users generate in my shiny server.
the server function looks like :
server <- function(input, output, session){
data_gen <- reactive({
d1= data.frame(...)
d2= data.frame(...)
result <- list(d1=d1, d2=d2)
return(result)
})
create_file <- reactive({
sink("/srv/shiny-server/S3/file.txt",append = TRUE)
print(data_gen()$d1)
print(data_gen()$d2)
sink()
})
output$downloadData <- downloadHandler(
filename = function() {"input.txt"},
content = function(file) {
sink(file,append = TRUE)
print(data_gen()$d1)
print(data_gen()$d2)
sink()
}
)
}
I'm able to download the data but the app does not react to the create_file function and it does not write a copy into shiny server.
Any Idea how could I fix this ?
Your create_file function is a reactive. Reactive functions only evaluate when 1) their output is required, and 2) their inputs have changed. Neither appears to apply here.
What you could do is move the contents of create_file inside your downloadhandler. content must receive a function that returns a file, but the function can do other things first. So try the following:
server <- function(input, output, session){
data_gen <- reactive({
d1= data.frame(...)
d2= data.frame(...)
result <- list(d1=d1, d2=d2)
return(result)
})
output$downloadData <- downloadHandler(
filename = function() {"input.txt"},
content = function(file) {
# save non-user copy
sink("/srv/shiny-server/S3/file.txt",append = TRUE)
print(data_gen()$d1)
print(data_gen()$d2)
sink()
# copy to be returned for user
sink(file,append = TRUE)
print(data_gen()$d1)
print(data_gen()$d2)
sink()
})
}

r shiny: eventReactive is not reacting when the button is pressed

Below is my code. It might seem a bit long but actually it's a VERY simple app.
The user is supposed to upload a tiny data frame (x.csv if you are in the US or x_Europe.csv if you are in Europe). Then the user should click on the button to start calculations. And then at the end the user should be able to download the results of those calculations as a data frame.
My problem: after I upload the file, when I click on the 'do_it' action button - nothing happens. I can see it because nothing is being printed to my console. WHY? After all, my function 'main_calc' should be eventReactive to input$do_it? Why do all the calculations inside main_calc start happening ONLY after the user tries to download the results?
Important: It is important to me to keep the 'Data' function separately from main_calc.
Thank you very much!
First, generate one of these 2 files in your working directory:
# generate file 'x.csv' to read in later in the app:
write.csv(data.frame(a = 1:4, b = 2:5), "x.csv", row.names = F) # US file
write.csv2(data.frame(a = 1:4, b = 2:5), "x_Europe.csv", row.names = F)
This is the code for the shiny app:
library(shiny)
ui <- fluidPage(
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x.csv'!")),
br(),
actionButton("do_it", "Click Here First:"),
br(),
br(),
textInput("user_filename","Save your file as:", value = "My file x"),
downloadButton('file_down',"Save the output File:")
)
server <- function(input, output, session) {
#----------------------------------------------------------------------
# Function to read in either European (csv2) or American (csv) input:
#----------------------------------------------------------------------
ReadFile <- function(pathtofile, withheader = TRUE){
test <- readLines(pathtofile, n = 1)
if (length(strsplit(test, split = ";")[[1]]) > 1) {
print("Reading European CSV file")
outlist <- list(myinput = read.csv2(pathtofile, header = TRUE),
europe.file = 1)
} else {
print("Reading US CSV file")
outlist <- list(myinput = read.csv(pathtofile, header = TRUE),
europe.file = 0)
}
return(outlist)
}
#----------------------------------------------------------------------
# Data-related - getting the input file
#----------------------------------------------------------------------
Data <- reactive({
print("Starting reactive function 'Data'")
# Input file:
infile_x <- input$file_x
myx <- ReadFile(infile_x$datapath)$myinput
# European file?
europe <- ReadFile(infile_x$datapath)$europe.file
print("Finishing reactive function 'Data'")
return(list(data = myx, europe = europe))
})
#----------------------------------------------------------------------
# Main function that should read in the input and 'calculate' stuff
# after the users clicks on the button 'do_it' - takes about 20 sec
#----------------------------------------------------------------------
main_calc <- eventReactive(input$do_it, {
req(input$file_x)
# Reading in the input file:
x <- Data()$data
print("Done reading in the data inside main_calc")
# Running useless calculations - just to kill time:
myvector <- matrix(unlist(x), ncol = 1, nrow = 1000)
print("Starting calculations")
for (i in seq_len(10)) {
set.seed(12)
mymatr <- matrix(abs(rnorm(1000000)), nrow = 1000)
temp <- solve(mymatr) %*% myvector
}
print("Finished calculations")
# Creating a new file:
y <- temp
result = list(x = x, y = y)
print("End of eventReactive function main_calc.")
return(result)
}) # end of main_calc
#----------------------------------------------------------------------
# The user should be able to save the output of main_calc as a csv file
# using a string s/he specified for the file name:
#----------------------------------------------------------------------
output$file_down <- downloadHandler(
filename = function() {
paste0(input$user_filename, " ", Sys.Date(), ".csv")
},
content = function(file) {
print("Europe Flag is:")
print(Data()$europe)
if (Data()$europe == 1) {
x_out <- main_calc()$x
print("Dimensions of x in downloadHandler are:")
print(dim(x_out))
write.csv2(x_out,
file,
row.names = FALSE)
} else {
x_out <- main_calc()$x
print("Dimensions of x in downloadHandler are:")
print(dim(x_out))
write.csv(x_out,
file,
row.names = FALSE)
}
}
)
} # end of server code
shinyApp(ui, server)
Below is the solution - based on MrFlick's suggestions:
# generate file 'x.csv' to read in later in the app:
# write.csv(data.frame(a = 1:4, b = 2:5), "x.csv", row.names = F)
# write.csv2(data.frame(a = 1:4, b = 2:5), "x_Europe.csv", row.names = F)
library(shiny)
library(shinyjs)
ui <- fluidPage(
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x.csv'!")),
br(),
actionButton("do_it", "Click Here First:"),
br(),
br(),
textInput("user_filename","Save your file as:", value = "My file x"),
downloadButton('file_down',"Save the output File:")
)
server <- function(input, output, session) {
#----------------------------------------------------------------------
# Function to read in either European (csv2) or American (csv) input:
#----------------------------------------------------------------------
ReadFile <- function(pathtofile, withheader = TRUE){
test <- readLines(pathtofile, n = 1)
if (length(strsplit(test, split = ";")[[1]]) > 1) {
print("Reading European CSV file")
outlist <- list(myinput = read.csv2(pathtofile, header = TRUE),
europe.file = 1)
} else {
print("Reading US CSV file")
outlist <- list(myinput = read.csv(pathtofile, header = TRUE),
europe.file = 0)
}
return(outlist)
}
#----------------------------------------------------------------------
# Data-related - getting the input file
#----------------------------------------------------------------------
Data <- reactive({
print("Starting reactive function Data")
# Input file:
infile_x <- input$file_x
myx <- ReadFile(infile_x$datapath)$myinput
# European file?
europe <- ReadFile(infile_x$datapath)$europe.file
print("Finishing reactive function 'Data'")
return(list(data = myx, europe = europe))
})
#----------------------------------------------------------------------
# Main function that should read in the input and 'calculate' stuff
# after the users clicks on the button 'do_it' - takes about 20 sec
#----------------------------------------------------------------------
# Creating reactive Values:
forout_reactive <- reactiveValues()
observeEvent(input$do_it, {
print("STARTING observeEvent")
req(input$file_x)
# Reading in the input file:
x <- Data()$data
print("Done reading in the data inside observeEvent")
# Running useless calculations - just to kill time:
myvector <- matrix(unlist(x), ncol = 1, nrow = 1000)
print("Starting calculations")
for (i in seq_len(10)) {
set.seed(12)
mymatr <- matrix(abs(rnorm(1000000)), nrow = 1000)
temp <- solve(mymatr) %*% myvector
} # takes about 22 sec on a laptop
print("Finished calculations")
# Creating a new file:
y <- temp
forout_reactive$x = x
forout_reactive$y = y
print("End of observeEvent")
}) # end of main_calc
#----------------------------------------------------------------------
# The user should be able to save the output of main_calc as a csv file
# using a string s/he specified for the file name:
#----------------------------------------------------------------------
output$file_down <- downloadHandler(
filename = function() {
paste0(input$user_filename, " ", Sys.Date(), ".csv")
},
content = function(file) {
print("Europe Flag is:")
print(Data()$europe)
if (Data()$europe == 1) {
y_out <- forout_reactive$y
print("Dimensions of y in downloadHandler are:")
print(dim(y_out))
write.csv2(y_out,
file,
row.names = FALSE)
} else {
y_out <- forout_reactive$y
print("Dimensions of y in downloadHandler are:")
print(dim(y_out))
write.csv(y_out,
file,
row.names = FALSE)
}
}
)
} # end of server code
shinyApp(ui, server)
Here is a simple app that may help elucidate how eventReactive() works:
library(shiny)
run_data <- function() {
paste0("Random number generated in eventReactive: ", runif(1))
}
ui <- basicPage(
actionButton("run1", "Invalidate eventReative()"),
actionButton("run2", "Trigger observeEvent()"),
verbatimTextOutput("data")
)
server <- function(input, output, session) {
# Initialize reactiveValues list
# to use inside observeEvent()
rv <- reactiveValues(data = NULL)
# This eventReactive() doesn't run when run1 button is
# clicked. Rather, it becomes invalidated. Only when
# data() (the reactive being returned) is actually
# called, does the expression inside actually run.
# If eventReactive is not invalidated by clicking run1
# then even if data() is called, it still won't run.
data <- eventReactive(input$run1, {
showNotification("eventReactive() triggered...")
run_data()
})
# Every time run2 button is clicked,
# this observeEvent is triggered and
# will run. If run1 is clicked before run2,
# thus invalidating the eventReactive
# that produces data(), then data() will
# contain the output of run_data() and
# rv$data will be assigned this value.
observeEvent(input$run2, {
showNotification("observeEvent() triggered")
rv$data <- data()
})
# Renders the text found in rv$data
output$data <- renderText({
rv$data
})
}
shinyApp(ui, server)
In this example, run1 invalidates the eventReactive(), and run2 triggers the observeEvent() expression. In order for the data (in this case just a random number) to print, run1 must be clicked prior to run2.
The key takeaway is that the input(s) (buttons) that eventReactive() listens to don't trigger eventReactive(). Instead, they invalidate eventReactive() such that when the output from eventReactive() is required, then the expression inside eventReactive() will run. If it is not invalidated or the output is not needed, it will not run.

Load and save shiny inputs

I have a big shiny app with about 60 different inputs and it's still growing. Since I use this program a lot, I wanted the settings to be stored until next time I run the app. I made a csv-file that looks something like this:
input,value
input_a,10
input_b,#FFF000
input_c,hide
input_d,65400
I load the csv-file in ui.R and server.R with (not sure why I have to load it two times...)
config <- data.frame(lapply(read.csv(".//config.csv"), as.character), stringsAsFactors = FALSE)
and have inputs like this
sliderInput(
"input_a",
"Number of cats:",
min = 1,max = 50,
value = config[config$input %in% "input_a", "value"]
)
In server.R, I let input changes replace the value in the table and also save the table to the file
observe({
config[config$input %in% "input_a", "value"] <- input$input_a
config[config$input %in% "input_b", "value"] <- input$input_b
config[config$input %in% "input_c", "value"] <- input$input_c
config[config$input %in% "input_d", "value"] <- input$input_d
write.table(config, file = ".//config.csv", col.names = TRUE, row.names = FALSE, quote = FALSE, sep = ",")
})
I'm sure there is a better way to do this, I searched and checked the other similar questions, I started with dget and dput, but then decided to have all relevant settings in one simple file. Sorry if I missed the most relevant question when I searched.
What I don't like about this is that the program also saves the table when it loads the program, before I make any input changes.
How can I get rid of that unnecessary save every time I run the program?
I don't understand all the "reactivity" in shiny, it's still a bit to complicated for me, I don't really know anything about R or programming, just trying to optimize my program since it gets slower with every new "feature" I add.
I don't see any problem with keeping settings like that, but there might be a better way, and in anycase I would wrap it in a function like I did here.
And here is how you implement writing only "on exit" though (also please note the session parameter which is often not used):
library(shiny)
settingsdf <- data.frame(input=c("input_a","input_b","input_c"),
value=c(10,"#FF000","hide"),
stringsAsFactors=F)
setSetting <- function(pname,pval){
idx <- which(settingsdf$input==pname)
if (length(idx)==1){
print(pval)
settingsdf[ idx,2] <<- pval
}
}
shinyApp(
ui = fluidPage(
selectInput("region", "Region:", choices = colnames(WorldPhones)),
plotOutput("phonePlot")
),
server = function(input, output, session) {
output$phonePlot <- renderPlot({
if (length(input$region)>0){
setSetting("input_a",input$region)
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
}
})
session$onSessionEnded(function() {
write.csv(settingsdf,"settings.csv")
})
},
options = list(height = 500)
)
Note that I am compressing the ui.R and server.R files into a single file which is not normally done but is nicer for these little examples.
This is not perfect code, I don't read the settings in and initialize the variables, and I use the <<- operator, which some people frown on. But it should help you along.
Update
Here is a more complex version that loads and saves the parameters, and encapsulates them for use. It is better, although it probably should use S3 objects...
library(shiny)
# Settings code
settingsdf <- data.frame(input=c("input_a","region"),
value=c(10,"Asia"),stringsAsFactors=F)
setfname <- "settings.csv"
setSetting <- function(pname,pval){
idx <- which(settingsdf$input==pname)
if (length(idx)==1){
settingsdf[ idx,"value"] <<- pval
}
}
getSetting <- function(pname){
idx <- which(settingsdf$input==pname)
if (length(idx)==1){
rv <- settingsdf[ idx,"value"]
return(rv)
} else {
return("")
}
}
readSettings <- function(){
if (file.exists(setfname)){
settingsdf <<- read.csv(setfname,stringsAsFactors=F)
}
}
writeSettings <- function(){
write.csv(settingsdf,setfname,row.names=F)
}
# ShinyApp
shinyApp(
ui = fluidPage(
selectInput("region","Region:", choices = colnames(WorldPhones)),
plotOutput("phonePlot")
),
server = function(input, output, session) {
readSettings()
vlastinput <- getSetting("region")
if (vlastinput!=""){
updateSelectInput(session, "region", selected = vlastinput )
}
output$phonePlot <- renderPlot({
if (length(input$region)>0){
vlastinput <- input$region
setSetting("region",vlastinput)
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
}
})
session$onSessionEnded(function() {
writeSettings()
})
},
options = list(height = 500)
)
Yielding:

Source in reactive content Shiny

I want to split my app into smaller peaces for better handling.
server.R
library(shiny)
source("onLoad.R", local = TRUE)
shinyServer(function(input, output, session) {
sourceRecursive("/.../")
})
sourceRecursive
#check folder and all subfolders for .R files
#source() them!
sourceRecursive <- function(path) {
dirs <- list.dirs()
files <- dir(pattern = "^.*[Rr]$", include.dirs = FALSE)
for (f in files)
source(f)
for (d in dirs)
sourceRecursive(d)
}
example file I try to source. file.R
output$myChoices <- renderUI({
selectInput(inputId = 'x',
label = 'y',
choices = levels(myDataSet$df$z),
multiple = T
)
})
Bounces back with:
Error in output$myChoices <- renderUI({ :
object 'output' not found
Obviously the problem is that within the file.R the variable output is not defined since this is a variable which is used in the shiny context. How would I tell R (or shiny) to treat all the variables as shiny defined variables (such as output$whatever, input$something, reactive etc). That seems crucial to me in order to break up the programme into smaller peaces.
I'm using both source(local=TRUE) and sys.source to load the file into the proper environment, it seems to work:
library(shiny)
shinyServer(function(input, output, session) {
# From http://shiny.rstudio.com/articles/scoping.html
output$text <- renderText({
source('each_call.R', local=TRUE)
})
# Source in the file.R from the example in the question
sys.source('file.R', envir=environment())
})
I didn't test it, but you might be able to use:
sourceRecursive <- function(path, env) {
files <- list.files(path = path, pattern = "^.*[Rr]$", recursive = TRUE)
for (f in files) sys.source(f, env)
}
shinyServer(function(input, output, session) {
session.env <- environment()
sourceRecursive(path = ".", env = session.env)
})
What if you use local=TRUE in your call to source provided that sourceRecursive is in the right scope (maybe put it in server.R). See this documentation here

Resources