I made a function that is performing some complex calculations via a for loop. In order to show progress, the function will print out the current progress via something like message(...), and the final outcome of this function is a data frame.
But when I implement this in Shiny, the for loop counter is printed only in the R console rather than the Shiny document as intended. Is there a way to showing the outputs in the R console in real time during executions?
A very minimal example is here. Notice that in the Shiny interface, the counter is not present.
foo <- function() {
ComplexResult = NULL # vector initiation
for(i in 1:5){
ComplexResult[i] = letters[i]
# At each stage of the for loop, we store some complex calculations
message(paste0("For loop counter is on i = ", i))
# This shows progress of the for loop, also other relevant messages if necessary.
Sys.sleep(0.1) # Comment this out to remove pauses during execution.
}
return(as.data.frame(ComplexResult))
}
runApp(shinyApp(
ui = fluidPage(
dataTableOutput("VeryFinalOutcome")
),
server = function(input,output, session) {
fooOutcome = foo()
output$VeryFinalOutcome = renderDataTable(fooOutcome) # This will only display the function output (i.e. the letters) in Shiny.
}
))
My attempt: the capture.output(foo(),type="message") function did not help. Even though it captured the messages successfully, but it can only be displayed after all execution. And there is a extra issue of not being able to store the actual foo() outputs.
Thanks
Related
It should be possible to use the R packages future and promises to trigger asynchronous (long running) processing via Shiny apps without freezing the rest of the app while the async process is running in another R process.
See:
https://cran.r-project.org/web/packages/promises/vignettes/intro.html
https://cran.r-project.org/web/packages/promises/vignettes/overview.html
https://cran.r-project.org/web/packages/promises/vignettes/futures.html
https://cran.r-project.org/web/packages/promises/vignettes/shiny.html
I got this to work in R-script-based environment but can't get this to work when I implement a simple shiny app with 2 functions. The "not-async" function is always blocked while the async function is running, but that should not be the case.
I have posted the same question on the GitHub repo of the package promises: https://github.com/rstudio/promises/issues/23
I am posting it here as well hoping someone can help.
The question is:
Can you take a look at the shiny app example posted below and let me know why the async processing is blocking the app? (It should not block).
Ideally, can you provide a small example of an app with a non-blocking async and normal functionality (accessible while the async is running)?
Environment
Mac OS 10.12
$ R --version
R version 3.4.3 (2017-11-30) -- "Kite-Eating Tree"
remove.packages("future")
remove.packages("promises")
remove.packages("shiny")
install.packages("future")
install.packages("devtools")
devtools::install_github("rstudio/promises")
devtools::install_github("rstudio/shiny")
> packageVersion("future")
[1] ‘1.8.1’
> packageVersion("promises")
[1] ‘1.0.1’
> packageVersion("shiny")
[1] ‘1.0.5.9000’
One side question on the shiny package version, https://rstudio.github.io/promises/articles/intro.html says it should be >=1.1, but even installing with devtools, the version remains 1.0.5... . Is this an issue or is there a typo in the doc?
First, you can use promises with Shiny outputs. If you’re using an async-compatible version of Shiny (version >=1.1), all of the built-in renderXXX functions can deal with either regular values or promises.
Example of issue
I have implemented this simple shiny app inspired from the example at the URLs mentioned above.
The shiny app has 2 "sections":
A button to trigger the "long running" async processing. This is simulated by a function read_csv_async which sleeps for a few seconds, reads a csv file into a data frame. The df is then rendered below the button.
A simple functionality which should work at any time (including when the async processing has been triggered): it includes a slider defining a number of random values to be generated. We then render a histogram of these values.
The issue is that the second functionality (histogram plot update) is blocked while the async processing is occurring.
global.R
library("shiny")
library("promises")
library("dplyr")
library("future")
# path containing all files, including ui.R and server.R
setwd("/path/to/my/shiny/app/dir")
plan(multiprocess)
# A function to simulate a long running process
read_csv_async = function(sleep, path){
log_path = "./mylog.log"
pid = Sys.getpid()
write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process started"), file = log_path, append = TRUE)
Sys.sleep(sleep)
df = read.csv(path)
write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process work completed\n"), file = log_path, append = TRUE)
df
}
ui.R
fluidPage(
actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
br(),
br(),
tableOutput("user_content"),
br(),
br(),
br(),
hr(),
sliderInput(inputId = "hist_slider_val",
label = "Histogram slider",
value = 25,
min = 1,
max = 100),
plotOutput("userHist")
)
server.R
function(input, output){
# When button is clicked
# load csv asynchronously and render table
data_promise = eventReactive(input$submit_and_retrieve, {
future({ read_csv_async(10, "./data.csv") })
})
output$user_content <- renderTable({
data_promise() %...>% head(5)
})
# Render a new histogram
# every time the slider is moved
output$userHist = renderPlot({
hist(rnorm(input$hist_slider_val))
})
}
data.csv
Column1,Column2
foo,2
bar,5
baz,0
Thanks!
So this behavior is normal, see the response of the package developer at https://github.com/rstudio/promises/issues/23
Summary:
In shiny apps, one R process can be shared by multiple users.
If one user submits a long running task, then all the other users sharing the same underlying R process are blocked.
The goal of promises is to avoid this. So promises will prevent blocking between "user sessions" within one R process but not within a single "user session".
The author of the package mentioned that this feature is not supported yet and that it may be added if enough people ask for it. If you are looking for this, please go the GitHub issue and like the original question - this is how interest for new features is measured.
Thanks!
As this or similar questions about shiny intra-session responsiveness are frequently asked on stackoverflow I think it's worth mentioning the workaround Joe Cheng provides in the GitHub issue #Raphvanns created:
If you really must have this kind of behavior, there is a way to work
around it. You can "hide" the async operation from the Shiny session
(allowing the session to move on with its event loop) by not returning
your promise chain from your observer/reactive code. Essentially the
async operation becomes a "fire and forget". You need to hook up a
promise handler to have some side effect; in the example below, I set
a reactiveVal on successful completion.
Some caveats to this approach:
By doing this you are inherently opening yourself up to race
conditions. Even in this very simple example, the user can click the
Submit button multiple times; if the long-running task has very
variable runtime you might end up with multiple results coming back,
but out of order. Or if you reference input values in promise
handlers, they might pick up values that were set after the submit
button was clicked!
You also lose the automatic semi-transparent
indication that an output has been invalidated (though below I at
least null the reactiveVal out in the beginning of the observeEvent).
Accordingly the solution for the above example code can be something like this:
library("shiny")
library("promises")
library("dplyr")
library("future")
# path containing all files, including ui.R and server.R
# setwd("/path/to/my/shiny/app/dir")
write.csv(data.frame(stringsAsFactors=FALSE,
Column1 = c("foo", "bar", "baz"),
Column2 = c(2, 5, 0)
), file = "./data.csv")
onStop(function() {
file.remove("./data.csv")
})
plan(multiprocess)
# A function to simulate a long running process
read_csv_async = function(sleep, path){
log_path = "./mylog.log"
pid = Sys.getpid()
write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process started"), file = log_path, append = TRUE)
Sys.sleep(sleep)
df = read.csv(path)
write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process work completed\n"), file = log_path, append = TRUE)
df
}
ui <- fluidPage(
textOutput("parallel"),
sliderInput(inputId = "hist_slider_val",
label = "Histogram slider",
value = 25,
min = 1,
max = 100),
plotOutput("userHist"),
actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
tableOutput("user_content")
)
server <- function(input, output, session) {
data_promise <- reactiveVal()
# When button is clicked
# load csv asynchronously and render table
observeEvent(input$submit_and_retrieve, {
future({ read_csv_async(10, "./data.csv") }) %...>% data_promise()
return(NULL) # hide future
})
output$user_content <- renderTable({
req(data_promise())
head(data_promise(), 5)
})
# Render a new histogram
# every time the slider is moved
output$userHist = renderPlot({
hist(rnorm(input$hist_slider_val))
})
output$parallel <- renderText({
invalidateLater(300)
paste("Something running in parallel:", Sys.time())
})
}
shinyApp(ui = ui, server = server)
Note the return(NULL) in the observeEvent call to hide the future. This way the long running process no longer blocks the execution of the other reactives.
Below is some pseudo code for a general question I think can be answered without a reproducible code. If I'm wrong and the reproducible code is needed, I will update my post.
I have a Shiny app that makes use of the dopar function from the doParallel package in R. In the server portion of my code, I have the first reactive expression that has a dependency on the action button "runScoring". When it executes, it runs registerDoParallel to register the parallel back end, as required.
Once the process generating a firstObject is done, it passes that result to a secondObject ( which depends on the same action button as the firstObject ) and then again runs the dopar function within the second reactive expression.
However, I only register the parallel back end within the first reactive expression and do not register it again within the second.
Is it necessary to place registerDoParallel within the second reactive expression in addition to having it within the first?
firstObject <- eventReactive(input$runScoring, {
registerDoParallel(cores = input$cores4Scoring)
itx1 <- iter(data1)
itx2 <- iter(data2)
result2 <- foreach(i = itx1, j = itx2, .export = funs) %dopar% {
do stuff ...
}
})
secondObject <- eventReactive(input$runScoring, {
registerDoParallel(cores = input$cores4Scoring)
itx1 <- iter(firstObject())
result <- foreach(i = itx1 .export = funs) %dopar% {
do stuff ...
}
})
I have developed a Shiny app that allows the user conditional selection of some dependent events. A very simplified toy example is below to help illustrate my question/problem.
In my real problem, the server code contains multiple computationally expensive procedures that are optional to run. There is a "baseline" function that must run to produce output and then firstObject or secondObject take that as input and produce more output if it is selected by the user to do so.
Each function can take upwards of 30 to 40 minutes. So, I wrote the code to allow the user to select using the checkInputBox which functions they want to run and then after selecting them, there is a single action button that runs them all allowing the user to leave and let the process take its course over many hours. This was more convenient than having an actionButton associated with each possible event.
The code below is successful in yielding all the desired output. But, I am not sure from a design point of view if it is "right". In my toy example, the code is simple, but suppose the code for baseObject takes 30 minutes to run. While baseObject is running, the code for firstObject and secondObject were also executed because they depend on the same action button. But, they cannot do anything until the function for baseObject is done. Similarly secondObject cannot do anything until firstObject is done.
Again, this all works and yields the correct output (in my real code as well as in the toy code). But, is there a way to maintain the single action button, but for firstObject to not do anything UNTIL baseline Object has produced its output and then secondObject would wait for firstObject to yield its output if the user selected it.
My worry is that I am creating additional computational overhead in the firstObject is trying to do something it cannot do until baseObject is done and it is cycling over and over until it can properly execute.
I know I can create different action buttons. For instance I could create an action button for baseline and then the user could wait until it is done and then click the action button for firstObject and so on. But, functionally this would not work as in the real problem this allows the entire selected process to run, which can take hours and the user does not need to be in front of their machine.
Thank you and I hope this code helps illustrate the problem as I have described it.
ui <- {
fluidPage(
h3('Run Stuff'),
checkboxInput("runModel1", "Model 1"),
checkboxInput("runModel2", "Model 2"),
actionButton('runAll', 'Run Models'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
}
server <- function(input, output, session) {
baseObject <- eventReactive(input$runAll, {
if(input$runModel1){
runif(100)
}
})
firstObject <- eventReactive(input$runAll, {
if(input$runModel1){
runif(100) + baseObject()
}
})
secondObject <- eventReactive(input$runAll, {
if(input$runModel2){
runif(100) + firstObject()
}
})
output$out1 <- renderPrint({
if (input$runModel1)
firstObject()
})
output$out2 <- renderPrint({
if (input$runModel2)
secondObject()
})
} # end server
shinyApp(ui, server) #run
Two things to remember about reactive expressions:
Reactive expressions are lazy and only execute when called by something else. This is different from observers, which execute immediately any time their dependencies change.
Reactive expression results are cached. As long as their dependencies have not changed, subsequent calls won't cause the expression to re-execute, but instead retrieve the cached value.
Based on these two points, I don't think you have a problem and your example does what you're looking for. With both checkboxes ticked, each reactive expression would only run once per action button click.
Although I can suggest removing the unnecessary if statements in the eventReactives. That would allow the user to only check runModel2 and have all its dependencies run properly. Modified example below - I also added some message(...) statements so you can see the execution flow in the R console.
library(shiny)
ui <- fluidPage(
h3('Run Stuff'),
checkboxInput("runModel1", "Model 1"),
checkboxInput("runModel2", "Model 2"),
actionButton('runAll', 'Run Models'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
server <- function(input, output, session) {
baseObject <- eventReactive(input$runAll, {
message("calculating baseObject...")
result <- runif(100)
message("...baseObject done")
return(result)
})
firstObject <- eventReactive(input$runAll, {
message("calculating firstObject...")
result <- runif(100) + baseObject()
message("...firstObject done")
return(result)
})
secondObject <- eventReactive(input$runAll, {
message("calculating secondObject...")
result <- runif(100) + firstObject()
message("...secondObject done")
return(result)
})
output$out1 <- renderPrint({
if (input$runModel1)
firstObject()
})
output$out2 <- renderPrint({
if (input$runModel2)
secondObject()
})
}
shinyApp(ui, server)
I am using Shiny as an interface for viewing tables stored locally in a series of .RData files however I am unable to get the table to render.
My server code is like this:
output$table1 <- renderTable({
load(paste0(input$one,"/",input$two,".RData"))
myData})
On the ui side I am simply displaying the table in the main panel.
This other SO question suggests that the issue is that the environment that the data is loaded into goes away so the data isn't there to display. They suggest creating a global file and loading the .RData file in there, but I don't believe I will be able to load the data dynamically that way. Any guidance on how to use .RData files effectively within shiny would be appreciated.
Regards
I think you just need to move the load statement outside of the renderTable function. So you should have
load(paste0(input$one,"/",input$two,".RData"))
output$table1 <- renderTable({myData})
If you look at the help file for renderTable, the first argument is
expr: An expression that returns an R object that can be used with
xtable.
load does not return this.
I got around this by "tricking" R Shiny. I make a BOGUS textOutput, and in renderText, call a external function that, based in the input selected, sets the already globally loaded environments to a single environment called "e". Note, you MUST manually load all RDatas into environments in global.R first, with this approach. Assuming your data isn't that large, or that you don't have a million RDatas, this seems like a reasonable hack.
By essentially creating a loadEnvFn() like the below that returns a string input passed as input$datasetNumber, you can avoid the scoping issues that occur when you put code in a reactive({}) context. I tried to do a TON of things, but they all required reactive contexts. This way, I could change the objects loaded in e, without having to wrap a reactive({}) scope around my shiny server code.
#Global Environment Pre-loaded before Shiny Server
e = new.env()
dataset1 = new.env()
load("dataset1.RData", env=dataset1)
dataset2 = new.env()
load("dataset2.RData", env=dataset2)
dataset3 = new.env()
load("dataset3.RData", env=dataset3)
ui = fluidPage(
# Application title
titlePanel(title="View Datasets"),
sidebarLayout(
# Sidebar panel
sidebarPanel(width=3, radioButtons(inputId = "datasetNumber", label = "From which dataset do you want to display sample data?", choices = list("Dataset1", "Dataset2", "Dataset3"), selected = "Dataset2")
),
# Main panel
mainPanel(width = 9,
textOutput("dataset"), # Bogus textOutput
textOutput("numInEnv")
)
)
)
loadEnvFn = function(input) {
if (input$datasetNumber=="Dataset1") {
.GlobalEnv$e = dataset1
} else if (input$datasetNumber=="Dataset2") {
.GlobalEnv$e = dataset2
} else {
.GlobalEnv$e = dataset3
}
# Bogus return string unrelated to real purpose of function loadEnvFn
return(input$datasetNumber)
}
server = function(input, output, session) {
output$dataset = renderText(sprintf("Dataset chosen was %s", loadEnvFn(input))) # Bogus output
output$numInEnv = renderText(sprintf("# objects in environment 'e': %d", length(ls(e))))
}
shinyApp(ui, server)
Hope someone can help me with this.
Let's say there is a function "example" which is something like
##function from a package
example<-function(f){
#does something
cat("step 1 done....")
# etc etc
cat("step 2 done....")
return(some_data_frame)
}
##server ui code
example2<-reactive({
if(input$some_action_button==0)
return()
result<-isolate(example(input$f1))
return(result)
})
output$f2<-renderPrint({
example2()
})
Is there some way to capture the "cat" outputs from the function into renderPrint, periodically? Assuming that this is a long function to process and it would be nice for the user to get some feedbabk. invalidateLater does not work for things that are already within a function (at least it seems that way when I tried it here).
Also, as a secondary problem, writing the code in the above manner would cause renderPrint to capture both the "cat" and the data.frame together, possibly because of the "return".
If anyone could point me in the right direction, it would be most helpful! Thanks!
First of, great question I've been thinking a lot about this.
Since shiny is single threaded it's a bit tricky capturing function output and displaying it in shiny from what i know.
A work around for this would be using a non blocking file connection and running the function you want to capture the output from in the background while reading the file for the function output (Check the edit history to see how to do this).
Another way of doing this would be overriding the cat function to write to stderr (simply switching cat with message) and capture the function output like this:
library(shiny)
library(shinyjs)
myPeriodicFunction <- function(){
for(i in 1:5){
msg <- paste(sprintf("Step %d done.... \n",i))
cat(msg)
Sys.sleep(1)
}
}
# Override cat function
cat <- message
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
actionButton("btn","Click me"),
textOutput("text")
),
server = function(input,output, session) {
observeEvent(input$btn, {
withCallingHandlers({
shinyjs::text("text", "")
myPeriodicFunction()
},
message = function(m) {
shinyjs::text(id = "text", text = m$message, add = FALSE)
})
})
}
))
This example is mostly based on this question by daattali.