I have a function (clawCheck) defined in the file CheckClawback.R which takes three data frames as arguments. In my Shiny app, the user uploads three files which are then read into memory and used as the ClawCheck arguments. In order to save time, I want R to start reading a file into memory as soon as it is uploaded, and not only after the "GO" button is pressed, so that once the button is pressed, the arguments for ClawCheck are already in memory and ready to use.
I'm thinking that I have to use eventReactive expressions within the renderTable statement, since I don't want the files to be re-read every time a user changes some input. To avoid further complication, I assume the input is filled in in order, i.e first "account", then "commpaid", then "termriders". When I run the app and the first input file has been uploaded, there is no progress bar appearing which indicates that my code is not working correctly. Here is my (reduced) code:
library('shiny')
source("CheckClawback.R")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("account", "Account File (.csv)"),
fileInput("commpaid", "CommPaid File (.txt)"),
fileInput("termriders", "TermRiders File (.txt)"),
actionButton("do", "GO!")),
mainPanel(
tableOutput("out_table"))
)
)
server <- function(input, output) {
func <- eventReactive(input$do, {
req(acc)
req(comm)
req(term)
datat <<- clawCheck(acc, comm, term)
})
output$out_table <- renderTable({
eventReactive(input$account, {
withProgress(message = "Preparing Account Data...Please Wait", {
acc <<- read.csv(input$account$datapath, header = TRUE, sep = ",")
})
})
eventReactive(input$commpaid, {
withProgress(message = "Preparing CommPaid Data...Please Wait", {
comm <<- read.table(input$commpaid$datapath, header = TRUE, sep = "\t")
})
})
eventReactive(input$termriders, {
withProgress(message = "Preparing TermRiders Data...Please Wait", {
term <<- read.table(input$termriders$datapath, header = TRUE, sep = "\t")
})
})
withProgress(func(), message = "Loading Output...Please Wait")
datat
})
}
shinyApp(ui = ui, server = server)
Ideally, after a file is uploaded, a progress bar should appear, indicating that it is being processed. If, during this process, a second file is uploaded, a second progress bar should appear, indicating that the second file is being processed etc. Once the actual function call happens, I want the input files to be ready to go.
I am very thankful for any help!
Your use of <<- and withProgress() is wrong. Also, using eventReactive() inside a render*() is wrong. I suggest going through RStudio Shiny tutorials to get help on understanding how reactivity works. Also look at showNotification() instead of withProgress(). For now, here's what you probably need -
server <- function(input, output, session) {
acc <- reactive({
validate(need(input$account), "acc not uploaded")
# use showNotification(); use same approach for other files
read.csv(input$account$datapath, header = TRUE, sep = ",")
# use removeNotification() to remove mesg after file is uploaded
})
comm <- reactive({
validate(need(input$commpaid), "comm not uploaded")
read.table(input$commpaid$datapath, header = TRUE, sep = "\t")
})
term <- reactive({
validate(need(input$termriders), "term not uploaded")
read.table(input$termriders$datapath, header = TRUE, sep = "\t")
})
func <- eventReactive(input$do, {
clawCheck(acc(), comm(), term())
})
output$out_table <- renderTable({
func()
})
}
Related
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)
I have a Shiny app that uses the Ace editor. Now I would like to have it so that when a first user is using this editor, other users cannot edit the document, but only view the document.
How can this be realized?
The code is:
library(shiny)
library(shinyAce)
library(stringi)
ui <- fluidPage(
br(),
uiOutput("aceEditor1"),
downloadButton('save1', 'Save editor content')
)
server <- function(input, output, session)
{
output$aceEditor1 <- renderUI(
{
aceEditor(outputId = "ace1",
value = paste(stri_rand_lipsum(3), collapse="\n\n"),
mode = "r",
height = "500px",
fontSize = 17,
theme = "chrome",
wordWrap = TRUE)
})
output$save1 <- downloadHandler (
filename = function()
{
"result.txt"
},
content = function(file)
{
write.table(x = input$ace1, file = file, sep = "", row.names = FALSE, col.names = FALSE, quote = FALSE)
}
)
}
shinyApp(ui = ui, server = server)
You can implement this by introducing keys. Essentially, we create a global key variable which is visible to all sessions. When a session starts it takes the key and sets the global variable to be unavailable.
When a new session connects, and attempts to get the key, but it is unavailable.
Within the server function we can check before executing a "critical section" piece of code.
This is essentially the basics of how semiphore flag work.
Finally, when the session ends for the first session, it returns the key to the global variable.
We can also go a step further and use invalidateLater() to periodically check if the key is available.
To run the dummy example below first run this,
write_csv(mtcars,"~/Desktop/data.csv")
And the app is the following:
library(shiny)
key_available <- TRUE
ui <- fluidPage(
br(),
textInput(inputId = "text_input","Text Input"),
actionButton(inputId = "add_col","Add Column"),
dataTableOutput("table_output"),
downloadButton('save1', 'Save editor content')
)
server <- function(input, output, session){
onSessionEnded(function() key_available <<- TRUE)
# Session starts, Read data in
have_key <- FALSE
observe({
invalidateLater(1000)
if(key_available){
key_available <<- FALSE
have_key <<- TRUE
}
})
data_reactive <- eventReactive(c(input$add_col),{
data <- read_csv("~/Desktop/data.csv")
if(have_key){
data[[input$text_input]] <- NA
write_csv(data,"~/Desktop/data.csv")
}
return(data)
})
output$table_output <- renderDataTable({
req(data_reactive())
data_reactive()
})
}
shinyApp(ui = ui, server = server)
Open the first browser window, add a column name in the text box and click on Add Column.
You will notice the column is added. You can continue to do this as this session has the key.
Opening a new browser window simultaneously, and trying to do the above will be unsuccessful. However, if you close the first browser window, you will be able to now edit on the second browser window.
I've created a dynamic fileInput in shiny using lapply. When I want to read the file, I've also used lapply in an observer.
The problem of using lapply here is, it is triggered every time I upload a new file and thus, reads all files again and again if a new file is uploaded.
Here I provide a Hello World app. The lapply function depends on an input paramter which I abtracted from for simplicity.
library(shiny)
ui <- fluidPage(
titlePanel("Hello World"),
sidebarLayout(
sidebarPanel(),
mainPanel(
lapply(1:2, function(i) {
fileInput(
paste0("file", i),
label = NULL,
multiple = F,
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv"
),
buttonLabel = paste("File", i)
)
}),
verbatimTextOutput("list")
)
)
)
server <- function(input, output) {
r <- reactiveValues()
observe({
lapply(1:2, function(i) {
file <- input[[paste0("file",i)]]
if(is.null(file)) return()
isolate({
r$file[[paste(i)]] <- readr::read_csv2(file = file$datapath)
})
})
})
output$list <- renderPrint(reactiveValuesToList(r))
}
shinyApp(ui = ui, server = server)
How to replace the loop or add a requirement to lapply?
While I started down the road of cache-invalidation in the comments, I think something else may work better for you since you have a fixed number of fileInput fields: swap the lapply and observe lines in your code (plus a couple of other tweaks).
server <- function(input, output) {
lapply(paste0("file", 1:2), function(nm) {
observeEvent(input[[ nm ]], {
req(input[[nm]], file.exists(input[[nm]]$datapath))
readr::read_csv2(file = input[[nm]]$datapath)
})
})
}
Explanation:
I'm creating a list of reactive blocks instead of a reactive block operating on a list. This means "file1" won't react to "file2".
I short-cutted the definition of the input names by putting paste0(...) in the data of the lapply instead of in the function, though it'd be just as easy to do
lapply(1:2, function(i) {
nm <- paste0("file", i)
# ...
})
It's important to have nm defined outside of the observeEvent, and it has to do with delayed evaluation and namespace search order. I fell prey to this a few years ago and was straightened out by Joe Cheng: you can't use a for loop, it must be some environment-preserving operation like this.
N.B.: this is a stub of code, and it is far from complete: having an observe or observeEvent read the data and then discard it is wrong ... it's missing something. Ideally, this should really be a reactive or eventReactive block, or the processed data should be stored in a reactiveValues or reactiveVal. For example:
server <- function(input, output) {
mydata <- lapply(paste0("file", 1:2), function(nm) {
observeEvent(input[[ nm ]], {
req(input[[nm]], file.exists(input[[nm]]$datapath))
readr::read_csv2(file = input[[nm]]$datapath)
})
})
observe({
# the following are identical, the latter more declarative
mydata[[1]]
mydata[["file1"]]
})
}
(And another note about defensive programming: you cannot control perfectly how readr::read_csv2 reacts to that file ... it may error out for some reason. One further step would be to wrap it in tryCatch(..., error = function(e) { errfun(e); NULL; }) where errfun(e) does something meaningful with the error message (logs it and/or gives it to the user in a modal popup) and then returns NULL so that reactive blocks downstream can use req(mydata[[1]]) and will not try to process the NULL.
server <- function(input, output) {
mydata <- lapply(paste0("file", 1:2), function(nm) {
observeEvent(input[[ nm ]], {
req(input[[nm]])
file <- input[[nm]]
tryCatch(
readr::read_csv2(file = input[[nm]]$datapath),
error = function(e) { errfun(e); NULL; })
})
})
observe({
# the following are identical, the latter more declarative
mydata[[1]]
mydata[["file1"]]
})
}
Assistance will be greatly appreciated.
I am working on a shiny app which involves the use of both multiple SQlite databases and rhandsontable package. I found alot of helpful material online with respect to using this package but I am at a level of frustration as I spend 2 days stuck on one problem which I think its worth asking.
So the script below depicts the server and the UI of the rhandsontable. I wanted to be able to enable the user edit, and safe their modified table (which is covered alot online) but across multiple tables (something I am struggling with)
What my code does is that it opens the 1st table, and yes If i make a modification it does safe. But when I attempt to go to another table through the select input, the other table content immediately gets REPLACED by the initial modified one.
I really would like the modifications to be independent without affecting other tables.
Again, assistance will be greatly appreciated.
downloadTableUI <- function(id) {
ns <- NS(id)
tagList(
sidebarLayout(
sidebarPanel(
selectInput(ns("dataset"), "Choose a dataset:",
choices = dput(as.character(alltables[1: NROW(alltables)]))),
radioButtons(ns("filetype"), "File type:",
choices = c("csv", "tsv")),
dateRangeInput(ns("daterange2"), "Date Filtration",
start = "2017-02-17",
end = "2017-03-07"),
actionButton(ns("saveBtn"), "Save"),
br(),
downloadButton(ns('downloadData'), 'Download File', class = "btn-info")
),
mainPanel(
rHandsontableOutput(ns('tabletest'), width = 730, height = 600)
),
position = c("left")
)
)
}
DownloadTable <- function(input, output, session, pool) {
#select databases
tableChoozer <- reactive({input$dataset})
# dateSelector <- reactive({input$daterange2})
# Initiate the reactive table
p1 <- reactive({
results <- dbGetQuery(pool, paste('select * from ', tableChoozer()))
return (results)
})
Mychanges <- reactive({
observe({
input$saveBtn# update database file each time the button is pressed
if (!is.null(input$tabletest)) {#if there 's a table input
dbWriteTable(pool, tableChoozer(),hot_to_r(input$tabletest), overwrite = TRUE, row.names = FALSE)# overwrite the database
}
})
#THIS IS WHERE I THINK THE PROBLEM IS
if (is.null(input$tabletest)) {
return (p1())
} else if (!identical(p1(), input$tabletest)) {
mytable <- as.data.frame(hot_to_r(input$tabletest))
return (mytable)
}
})
output$tabletest <- renderRHandsontable({
rhandsontable(Mychanges()) %>%
hot_cols(columnSorting = TRUE, highlightCol = TRUE, highlightRow = TRUE,allowRowEdit = FALSE, allowColEdit = FALSE, exportToCsv = TRUE)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("table.csv")
},
content = function(file) {
sep <- switch (input$filetype, "csv" = ",", "tsv" = "\t")
write.table(p1(), file, sep = sep, row.names = FALSE)
}
)
}
This code is untested, but hopefully it will work. Put the following at the top level of your server.R file
observeEvent( input$saveBtn,
{
# update database file each time the button is pressed
if (!is.null(input$tabletest)) {
#if there 's a table input
dbWriteTable(pool, tableChoozer(),
hot_to_r(input$tabletest), overwrite = TRUE, row.names = FALSE)
# overwrite the database
},
ignoreInit = TRUE
)
Using observeEvent rather than observe prevents a reactive dependency on tableChoozer and input$tabletest which seems to be your problem. ignoreInit makes it so the save event is not triggered at the initialization of the savebutton.
Is it possible to set reactiveValues inside the content part of the downloadHandler? I tried it and don't understand the behavior.
A simple example could be a counter showing how often the download button has been clicked:
library(shiny)
ui <- fluidPage(
downloadButton("downloadData", "Download"),
textOutput("nDownloads"),
actionButton("trig", "get number")
)
server <- function(input, output) {
# Our dataset
data <- mtcars
r.nDownloads <- reactiveValues(n=0)
output$nDownloads <- renderText({
input$trig
paste("number of downloads:", r.nDownloads$n)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
r.nDownloads$n <- r.nDownloads$n + 1
write.csv(data, file)
}
)
}
shinyApp(ui, server)
If the download button is clicked, the textOutput is grayed out, but not updated. I added an action button as a trigger to force the renderText to be updated. Surprisingly (at least to me) that works: the correct number is shown.
So, somehow the reactiveValue is changed by the downloadHandler, but its dependencies are only invalidated, not updated.
Of course, the proper way to do it would be making the "data"-object reactive and doing the counting there. But I'm curious how the described behavior can be explained.
EDIT:
OK, now I get really confused: I tried what I mentioned above: making "data" reactive and doing the counting there. This could not be simple counting of downloads anymore, because the data-reactive gets only recalculated if it's invalid.
Here is an example with an additional input for the invalidation of "data":
library(shiny)
ui <- fluidPage(
numericInput("nRows", label = "nRows", min=1, max=32, value=15),
downloadButton("downloadData", "Download"),
textOutput("nDownloads")
)
server <- function(input, output) {
r.nDownloads <- reactiveValues(n=0)
# Our dataset
data <- reactive({
isolate({
r.nDownloads$n <- r.nDownloads$n + 1
})
mtcars[1:input$nRows,]
})
output$nDownloads <- renderText({
paste("number of downloads:", r.nDownloads$n)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(data(), file)
}
)
}
shinyApp(ui, server)
But still, I see a similar behavior: Clicking the download button grays the text out, changing "nRows" makes the expected number of downloads (which is now downloads after a change in nRows ;-)) to show up.
Now it gets an actual problem for me: In my real app, a rather complex Excel file can be downloaded. While preparing and formatting the Excel file there can occur events that should lead to some reaction of the app. That's why the download should trigger something. The alternative I can see is, to prepare the Excel file before the user clicks on download (what I would like to avoid, because this can take a few seconds depending on the complexity of the file/formatting).
Am I missing something obvious? If not, I'd appreciate any ideas, how the download event can trigger something in the rest of the app.
The solution is to remove the isolation of the reactiveValues as this prevents the counter from being updated until the numericInput is triggered. This is because data() is dependent on input$nrows.
library(shiny)
ui <- fluidPage(
numericInput("nRows", label = "nRows", min = 1, max = 32, value = 15),
downloadButton("downloadData", "Download"),
textOutput("nDownloads")
)
server <- function(input, output) {
r.nDownloads <- reactiveValues(n = 0)
# Our dataset
data <- reactive({
r.nDownloads$n <- r.nDownloads$n + 1
mtcars[1:input$nRows,]
})
output$nDownloads <- renderText({
paste("number of downloads:", r.nDownloads$n)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(data(), file)
}
)
}
shinyApp(ui, server)
With regards to the deeper problem, it would be inefficient to constantly prepare a complex Excel file if there is no guarantee that the user would download the file. What you can try to do is:
Keep your data in a reactive method (e.g. data()).
Write a method to prep your data for downloading (e.g. prepExcel(data)) which returns your prepped data.
Pass (1) and (2) into the content of the downloadHandler() like this: write_xx(prepExcel(data())) or pipe the data into the write_xx function like this data() %>% prepExcel() %>% write_xx() where xx is the method used to output your final file e.g. write_xlsx or write_csv etc.
I hope this helps.