New to shiny, I want my app to display all files in a directory, and make the list update every time a file is added or removed. I see this is possible with reactivePoll, so I put this in my server:
server <- function(input, output, session) {
has.new.files <- function() {
length(list.files())
}
get.files <- function() {
list.files()
}
output$files <- renderText(reactivePoll(10, session, checkFunc=has.new.files, valueFunc=get.files))
}
However, I don't know how I can access the character vector containing my files within my ui. I also doubt that renderText in my server is the right choice. Here is my ui (non-reactive, just reads file list once):
ui <- fluidPage(
## How to access the files from server function ??
selectInput("file", "Choose file", list.files())
)
Thus, I just don't know hot to access the data, could anyone point me in the right direction?
You could try this:
server <- function(input, output, session) {
has.new.files <- function() {
unique(list.files())
}
get.files <- function() {
list.files()
}
# store as a reactive instead of output
my_files <- reactivePoll(10, session, checkFunc=has.new.files, valueFunc=get.files)
# any time the reactive changes, update the selectInput
observeEvent(my_files(),ignoreInit = T,ignoreNULL = T, {
print(my_files())
updateSelectInput(session, 'file',choices = my_files())
})
}
ui <- fluidPage(
selectInput("file", "Choose file", list.files())
)
shinyApp(ui,server)
It updates the selectInput any time a file is added, deleted or renamed. If you only want it to change if a file is added, you can replace the has.new.files function back with your own. Hope this helps!
Related
I have an app where I need to monitor a file for changes. However I am struggling to do this.
Consider the following example:
library(shiny)
A function that returns the modified date of a file:
file_info <- function(){
if(file.exists("example.txt")){
return(as.character(as.Date(file.info("example.txt")[1,4])))
} else {
return("File not present")
}
}
Shiny part:
ui <- shinyUI(fluidPage(
textOutput("file_status"),
actionButton("create_file", "Create file"),
actionButton("delete_file", "Delete file")
))
server <- shinyServer(function(input, output, session) {
file_st <- reactive(file_info()) #what is the correct approach here?
output$file_status <- renderText({
file_st()
})
observeEvent(input$create_file,{
file.create("example.txt")
})
observeEvent(input$delete_file, {
unlink("example.txt")
})
})
I would like the file_status text field to update each time the example.txt file changes - if possible even if this happens outside of the app.
I have tried various combinations of reactive, observe and reactiveValues without finding the adequate combo.
Thank you
I was able to solve this using reactivePoll which is practically tailored for this type of task
server <- shinyServer(function(input, output, session) {
file_st <- reactivePoll(500, session,
checkFunc = function() {
if (file.exists("example.txt"))
file.info("example.txt")$mtime[1]
else
""},
valueFunc = function(){
if(file.exists("example.txt")){
return(as.character(as.Date(file.info("example.txt")[1,4])))
} else {
return("File not present")
}
}
)
output$file_status <- renderText({
file_st()
})
observeEvent(input$create_file,{
file.create("example.txt")
})
observeEvent(input$delete_file, {
unlink("example.txt")
})
})
ui <- shinyUI(fluidPage(
textOutput("file_status"),
actionButton("create_file", "Create file"),
actionButton("delete_file", "Delete file")
))
In the below example code, the function testFunction() is defined in the separate source file functionsLibrary.R saved on the desktop. This example code works as intended.
How would I modify the code to first test if testFunction() is an object in the R workspace, and source it (running the line source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")) only if the function is not in the workspace?
In the full code this is intended for, the function takes a very long time to run (reading a large data file into memory) and I only want it sourced if it is not currently a workspace object.
Example code:
library(shiny)
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
Source file contents (filename functionsLibrary.R):
testFunction <- function(a) {
b <- data.frame(Value=seq(1:a),Square_Value = seq(1:a)^2)
return(b)
}
An easy way to go about this would be to use exist(). This should work for your problem.
library(shiny)
if (!exists("testFunction")) {
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
}
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
We could extend the if clause to check if testFunction is really a function in case it exists and if not source the file.
if (!exists("testFunction") || (exists("testFunction") && !is.function(testFunction)))
The scenario I'm emulating with the below minimal example is allowing a user to engage with a Shiny App (click the numericInput control and see server-side events occur) while a long-running download is occurring (simulated with Sys.sleep(10) within downloadHandler).
In a synchronous setting, when the "Download" button is clicked, the user can still interact with UI elements, but other Shiny calculations (in this case, renderText), get put in a queue. I'd like the asynchronous setting, where the download occurs in the background, and users can still interact with the UI elements and get desired output (e.g. renderText).
I'm using callr::r_bg() to achieve asynchronicity within Shiny, but the issue is that my current code of the downloadHandler is incorrect (mtcars should be getting downloaded, but the code is unable to complete the download, 404 error message), I believe it's due to the specific way in which downloadHandler expects the content() function to be written, and the way I've written callr::r_bg() is not playing nicely with that. Any insights would be appreciated!
Reference:
https://www.r-bloggers.com/2020/04/asynchronous-background-execution-in-shiny-using-callr/
Minimal Example:
library(shiny)
ui <- fluidPage(
downloadButton("download", "Download"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text")
)
server <- function(input, output, session) {
long_download <- function(file) {
Sys.sleep(10)
write.csv(mtcars, file)
}
output$download <- downloadHandler(
filename = "data.csv",
content = function(file) {
x <- callr::r_bg(
func = long_download,
args = list(file)
)
return(x)
}
)
observeEvent(input$count, {
output$text <- renderText({
paste(input$count)
})
})
}
shinyApp(ui, server)
I figured out a solution, and learned the following things:
Because downloadHandler doesn't have a traditional input$X, it can be difficult to include reactivity in the traditional way. The workaround was to present the UI as a hidden downlodButton masked by an actionButton which the user would see. Reactivity was facilitated in the following process: user clicks actionButton -> reactive updates -> when the reactive finishes (reactive()$is_alive() == FALSE), use shinyjs::click to initiate the downloadHandler
Instead of placing the callr function within the downloadHandler, I kept the file within the content arg. There seems to be some difficulties with scoping because the file needs to be available within the content function environment
I'm using a reactive function to track when the background job (the long-running computation) is finished to initiate the download using the syntax: reactive()$is_alive()
The invalidateLater() and toggling of a global variable (download_once) is important to prevent the reactive from constantly activating. Without it, what will happen is your browser will continually download files ad infinitum -- this behavior is scary and will appear virus-like to your Shiny app users!
Note that setting global variables is not a best practice for Shiny apps (will think of a better implementation)
Code Solution:
library(shiny)
library(callr)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
#creating a hidden download button, since callr requires an input$,
#but downloadButton does not natively have an input$
actionButton("start", "Start Long Download", icon = icon("download")),
downloadButton("download", "Download", style = "visibility:hidden;"),
p("You can still interact with app during computation"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text"),
textOutput("did_it_work")
)
long_job <- function() {
Sys.sleep(5)
}
server <- function(input, output, session) {
#start async task which waits 5 sec then virtually clicks download
long_run <- eventReactive(input$start, {
#r_bg by default sets env of function to .GlobalEnv
x <- callr::r_bg(
func = long_job,
supervise = TRUE
)
return(x)
})
#desired output = download of mtcars file
output$download <- downloadHandler(filename = "test.csv",
content = function(file) {
write.csv(mtcars, file)
})
#output that's meant to let user know they can still interact with app
output$text <- renderText({
paste(input$count)
})
download_once <- TRUE
#output that tracks progress of background task
check <- reactive({
invalidateLater(millis = 1000, session = session)
if (long_run()$is_alive()) {
x <- "Job running in background"
} else {
x <- "Async job in background completed"
if(isTRUE(download_once)) {
shinyjs::click("download")
download_once <<- FALSE
}
invalidateLater(millis = 1, session = session)
}
return(x)
})
output$did_it_work <- renderText({
check()
})
}
shinyApp(ui, server)
Thanks #latlio for your great answer. I think it cloud be easily improved.
invalidateLater should be used very carefully and only WHEN needed. I use invalidateLater only once and moved it to the logical part where we are waiting for the result. Thus we are NOT invalidating the reactivity infinitely.
library(shiny)
library(callr)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
#creating a hidden download button, since callr requires an input$,
#but downloadButton does not natively have an input$
actionButton("start", "Start Long Download", icon = icon("download")),
downloadButton("download", "Download", style = "visibility:hidden;"),
p("You can still interact with app during computation"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text"),
textOutput("did_it_work")
)
long_job <- function() {
Sys.sleep(5)
}
server <- function(input, output, session) {
#start async task which waits 5 sec then virtually clicks download
long_run <- eventReactive(input$start, {
#r_bg by default sets env of function to .GlobalEnv
x <- callr::r_bg(
func = long_job,
supervise = TRUE
)
return(x)
})
#desired output = download of mtcars file
output$download <- downloadHandler(filename = "test.csv",
content = function(file) {
write.csv(mtcars, file)
})
#output that's meant to let user know they can still interact with app
output$text <- renderText({
paste(input$count)
})
#output that tracks progress of background task
check <- reactive({
if (long_run()$is_alive()) {
x <- "Job running in background"
invalidateLater(millis = 1000, session = session)
} else {
x <- "Async job in background completed"
shinyjs::click("download")
}
return(x)
})
output$did_it_work <- renderText({
check()
})
}
shinyApp(ui, server)
I'm building an RShiny App and I'd like to have users be able to navigate to a directory and then I want to be able to use this directory name in a function. There are several similar questions out there, but nothing I've been able to work out for my problem. I created a simple reproducible example.
In this example, I'd like to be able to take the path_prefix and pass it to a system command so that I can change to this directory. I'm having the function print the path_prefix in the Shiny window and what is printed is appropriate. However, the functions I'm using turn the path into a list where each folder is in quotes. Does anyone have suggestions for how this could work?
library(shiny)
library(shinyFiles)
# UI
ui <- fluidPage(
shinyDirButton('path_prefix', 'Select a directory', title='Select a directory'),
textOutput('path_prefix'),
actionButton("run", "run test")
)
# Server
server <- function(input, output, session) {
volumes <- getVolumes()
shinyDirChoose(input, 'path_prefix', roots=volumes, session=session)
dirname <- reactive({parseDirPath(volumes, input$path_prefix)})
# Observe input dir
observe({
#fileinfo <- parseSavePath(volumes, input$path_prefix)
if(!is.null(dirname)){
print(dirname())
output$path_prefix <- renderText(dirname())
}
})
observeEvent(input$run, {
system(paste0("cd ", input$path_prefix))
})
}
shinyApp(ui = ui, server = server)
I am learing Shiny. I want to make a simple app that allows for dynamic paths that the user enters. The app should then list csv files in folder A and then copy them from folder A to folder B (the working directory). Then the app does some operations in folder B using an external exe program. Afterwards the folder will cut the results files (.txt) from B and copies them into A.
The structure of my app is as follows ( I have also attached a picture). the problem is explained in the comments in the code.
library(shiny)
ui<-fluidPage(
textInput("prg","Program",getwd()),
verbatimTextOutput("prg"),
textInput("prj","Project","Project"),
verbatimTextOutput("prj")
)
server<-function(input, output,session) {
output$prg=renderText(input$prg)
renderPrint(output$prg)
output$prj=renderText(paste0(input$prg,"/",input$prj))
#This is where my challenge is
#I want to
#list.files(path=path-shown-in-text-box-Project,pattern=".csv")
#Then i want to copy csv files from A to B as described above and run the following program
#This works
observeEvent(input$run,
{
system("my.exe") #exe not shared
})
#Finally I want to cut and paste the results (.txt) from B back into A
}
shinyApp(ui,server)
I want to list.files(path=path-shown-in-text-box-Project,pattern=".csv")
Here's code you can use to browse any directory for a particular CSV file, read that file and display its contents.
library(shiny)
# Define UI
ui <- pageWithSidebar(
# App title ----
headerPanel("Open a File and Show Contents"),
# Sidebar panel for inputs ----
sidebarPanel(
label="Data Source",fileInput("fileName", "File Name",accept=c(".csv"))),
# Main panel for displaying outputs ----
mainPanel(
tableOutput(outputId = "table")
)
)
# Define server logic
server <- function(input, output) {
inputData <- reactive ({
if (is.null(input$fileName)) return(NULL)
inFile <- input$fileName
conInFile <- file(inFile$datapath,open='read')
inData <- read.csv(conInFile,stringsAsFactors = FALSE)
close (conInFile)
return (inData)
})
output$table <- renderTable ({
inData <- inputData()
if (length(inData) > 0) inData
})
}
shinyApp(ui, server)