I am trying to run a GET request inside a shinyApp, but I don't want to wait for the response as it would take quite a long time to process and I dont need really need the response inside the shinyApp, although a status code would be nice, but it is not obligatory.
Or is there maybe a function, that sends an async request? Like wrapping the whole GET inside a future/promise?
Currently I have this observeEvent in my shinyApp:
observeEvent(input$import, {
httr::GET(url = "https://someurl/that/takes/a/long/time")
})
Is the curl_fetch_multi from the curl package suited for that task?
Here is a way to run GET asynchronously and in a intra-session non-blocking manner (observer returning nothing):
library(shiny)
library(future)
library(promises)
library(future.callr)
library(httr)
plan(callr)
queryGoogle <- function(queryString) {
myResponse <- httr::GET("http://google.com/", path = "search", query = list(q = queryString))
return(myResponse)
}
ui <- fluidPage(
br(),
textOutput("time_output"),
br(),
textInput(inputId="query_input", label = NULL, value = "", placeholder = "Search google..."),
actionButton("import", "Query"),
hr(),
textOutput("query_output")
)
server <- function(input, output, session) {
futureData <- reactiveValues(response = NULL)
observeEvent(input$import, {
myFuture <- future({
queryGoogle(isolate(input$query_input))
})
then(
myFuture,
onFulfilled = function(value) {
futureData$response <- value
},
onRejected = NULL
)
return(NULL)
})
output$query_output <- renderPrint({
req(futureData$response)
})
time <- reactive({
invalidateLater(500, session)
Sys.time()
})
output$time_output <- renderText({ paste("Something running in parallel:", time()) })
}
shinyApp(ui, server)
This is a slight modification of my answer here.
Please also read Joe Cheng's related answer here carefully.
Related
I want Shiny to wait a little bit for the user to input their group size (without using a button). This is a simpler version of my code, but in my actual code, I have more user inputs (so I only want Shiny to wait 2 seconds for this input only). I've been trying to figure out how I would use debounce for this code, but I'm not sure.
library(shiny)
shinyApp(ui <- fluidPage(sidebarPanel(
"",
numericInput("groupSize", label =
"How many people will be with you?", value = ""),
textOutput("output")
)) ,
server <- function(input, output, session) {
getNumber <- reactive({
req(input$groupSize>=0)
groupSize <- input$groupSize
})
output$output <- renderText({
getNumber()
})
})
This works with debounce:
create a reactive input function groupsize
pass this function to debounce to create a new function groupsize_d
use this new function for rendering
library(shiny)
shinyApp(ui <- fluidPage(sidebarPanel(
"",
numericInput("groupSize", label =
"How many people will be with you?", value = ""),
textOutput("output")
)) ,
server <- function(input, output, session) {
groupsize <- reactive(input$groupSize)
groupsize_d <- debounce(groupsize,2000)
getNumber <- reactive({
req(groupsize_d()>=0)
groupsize_d()
})
output$output <- renderText({
getNumber()
})
})
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 am trying to use futures to have a "loading" icon appear. This is the code I have
library(shiny)
library(promises)
library(future)
plan(multiprocess)
disksUI <- function(id) {
ns <- NS(id)
fluidRow(
box(
uiOutput(ns("loading")),
dataTableOutput(ns("filelist")),
width=12
)
)
}
disksServer <- function(input, output, session) {
state <- reactiveValues(onLoading=FALSE)
observe({
if (state$onLoading) {
output$loading <- renderUI("Loading")
} else {
output$loading <- renderUI("Done")
}
})
filelist <- reactive(
{
state$onLoading <- TRUE
future({
Sys.sleep(3)
state$onLoading <- FALSE
}
)
}
)
output$filelist <- renderDataTable({
filelist()
})
}
However, the result is not what I expect. What I expect is
the string Loading appears immediately
after three seconds, the string Loading is replaced with Done
What happens is
Nothing is written for three seconds.
After three seconds, the Loading string appears.
I posted my answer here first. However, adding it also here for future readers:
Here is a working example:
library(shiny)
library(shinydashboard)
library(promises)
library(future)
library(shinyjs)
plan(multiprocess)
server <- function(input, output, session) {
output$loading <- renderUI("Idling")
myFilelist <- reactiveVal(NULL)
observeEvent(input$getBtn, {
disable("getBtn")
output$loading <- renderUI("Loading")
myFuture <- future({
Sys.sleep(3)
data.frame(list.files(getwd()))
})
then(myFuture, onFulfilled = function(value) {
enable("getBtn")
output$loading <- renderUI("Done")
myFilelist(value)
},
onRejected = NULL)
return(NULL)
})
output$filelist <- renderDataTable({
myFilelist()
})
}
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionButton("getBtn", "Get file list"),
box(
uiOutput("loading"),
dataTableOutput("filelist"),
width=12
)
)
)
shinyApp(ui, server)
Please note the return(NULL) in the observeEvent() - this is hiding the future from its own session - allowing intra-session responsiveness. However, now we have to deal with potential race conditions, as Joe Cheng already mentioned to you here. In this simple example we can disable the trigger button to avoid users having the possibility of creating new futures while others are still beeing processed.
For further details please read this.
In shiny, it is possible to call client-side callbacks written in javascript from the server's logic. Say in ui.R you have some JavaScript including a function called setText:
tags$script('
Shiny.addCustomMessageHandler("setText", function(text) {
document.getElementById("output").innerHTML = text;
})
')
then in your server.R you can call session$sendCustomMessage(type='foo', 'foo').
Suppose I have a long-running function which returns some data to plot. If I do this normally, the R thread is busy while running this function, and so can't handle additional requests in this time. It would be really useful to be able to run this function using the futures package, so that it runs asynchronously to the code, and call the callback asyncronously. However, when I tried this is just didn't seem to work.
Sorry if this isn't very clear. As a simple example, the following should work until you uncomment the two lines trying to invoke future in server.R. Once those lines are uncommented, the callback never gets called. Obviously it's not actually useful in the context of this example, but I think it would be very useful in general.
ui.R:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("max",
"Max random number:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
verbatimTextOutput('output'),
plotOutput('plot')
)
),
tags$script('
Shiny.addCustomMessageHandler("setText", function(text) {
document.getElementById("output").innerHTML = text;
})
')
))
server.R:
library(shiny)
library(future)
plan(multiprocess)
shinyServer(function(input, output, session) {
output$plot <- reactive({
max <- input$max
#f <- future({
session$sendCustomMessage(type='setText', 'Please wait')
Sys.sleep(3)
x <- runif(1,0,max)
session$sendCustomMessage(type='setText', paste('Your random number is', x))
return(NULL)
#})
})
})
Here is a solution on how you could use the future package in a shiny app.
It is possible to have multiple sessions with no session blocking another session when running a computationally intensive task or waiting for a sql query to be finished. I suggest to open two sessions (just open http://127.0.0.1:14072/ in two tabs) and play with the buttons to test the functionality.
run_app.R:
library(shiny)
library(future)
library(shinyjs)
runApp(host = "127.0.0.1", port = 14072, launch.browser = TRUE)
ui.R:
ui <- fluidPage(
useShinyjs(),
textOutput("existsFutureData"),
numericInput("duration", "Duration", value = 5, min = 0),
actionButton("start_proc", h5("get data")),
actionButton("start_proc_future", h5("get data using future")),
checkboxInput("checkbox_syssleep", label = "Use Sys.sleep", value = FALSE),
h5('Table data'),
dataTableOutput('tableData'),
h5('Table future data'),
dataTableOutput('tableFutureData')
)
server.R:
plan(multiprocess)
fakeDataProcessing <- function(duration, sys_sleep = FALSE) {
if(sys_sleep) {
Sys.sleep(duration)
} else {
current_time <- Sys.time()
while (current_time + duration > Sys.time()) { }
}
return(data.frame(test = Sys.time()))
}
#fakeDataProcessing(5)
############################ SERVER ############################
server <- function(input, output, session) {
values <- reactiveValues(runFutureData = FALSE, futureDataLoaded = 0L)
future.env <- new.env()
output$existsFutureData <- renderText({ paste0("exists(futureData): ", exists("futureData", envir = future.env)," | futureDataLoaded: ", values$futureDataLoaded) })
get_data <- reactive({
if (input$start_proc > 0) {
shinyjs::disable("start_proc")
isolate({ data <- fakeDataProcessing(input$duration) })
shinyjs::enable("start_proc")
data
}
})
observeEvent(input$start_proc_future, {
shinyjs::disable("start_proc_future")
duration <- input$duration # This variable needs to be created for use in future object. When using fakeDataProcessing(input$duration) an error occurs: 'Warning: Error in : Operation not allowed without an active reactive context.'
checkbox_syssleep <- input$checkbox_syssleep
future.env$futureData %<-% fakeDataProcessing(duration, sys_sleep = checkbox_syssleep)
future.env$futureDataObj <- futureOf(future.env$futureData)
values$runFutureData <- TRUE
check_if_future_data_is_loaded$resume()
},
ignoreNULL = TRUE,
ignoreInit = TRUE
)
check_if_future_data_is_loaded <- observe({
invalidateLater(1000)
if (resolved(future.env$futureDataObj)) {
check_if_future_data_is_loaded$suspend()
values$futureDataLoaded <- values$futureDataLoaded + 1L
values$runFutureData <- FALSE
shinyjs::enable("start_proc_future")
}
}, suspended = TRUE)
get_futureData <- reactive({ if(values$futureDataLoaded > 0) future.env$futureData })
output$tableData <- renderDataTable(get_data())
output$tableFutureData <- renderDataTable(get_futureData())
session$onSessionEnded(function() {
check_if_future_data_is_loaded$suspend()
})
}
I retooled André le Blond's excellent answer to and made a gist showing a generic asynchronous task processor which can be used either by itself or with Shiny: FutureTaskProcessor.R
Note it contains two files: FutureProcessor.R which is the stand alone asynchronous task handler and app.R which is a Shiny App showing use of the async handler within Shiny.
One admittedly complicated workaround to the single-threaded nature of R within Shiny apps is to do the following:
Splinter off an external R process (run another R script located in
the Shiny app directory, or any directory accessible from within the
Shiny session) from within R (I've tried this splintering before,
and it works).
Configure that script to output its results to a temp directory (assuming you're running Shiny on a Unix-based system) and give the output file a unique filename (preferably named within the namespace of the current session (i.e. "/tmp/[SHINY SESSION HASH ID]_example_output_file.RData".
Use Shiny's invalidateLater() function to check for the presence of that output file.
Load the output file into the Shiny session workspace.
Finally, trash collect by deleting the generated output file after loading.
I hope this helps.
I'm trying to build a shiny app that outputs several results through different render* functions.
The problem is that one of those results takes some time to compute. So I would like shiny to render the quick results as soon as possible.
Here is some code to illustrate
# ui.R
library(shiny)
shinyUI(fluidPage(
textOutput("res1"),
textOutput('res2')
))
# server.R
library(shiny)
shinyServer(function(input, output) {
output$res1 = renderText({
"shows up instantly"
})
output$res2 = renderText({
Sys.sleep(3)
"shows up after 3 sec"
})
})
For now, the webpage stays empty for 3 seconds and the two elements are rendered at once.
My question is the following one: is it possible to enforce that output$res1 executes before output$res2 and that it sends its results to the browser before the long computation begins ?
Check out invalidateLater otherwise if you only want to render text you can send text directly to the client using:
# ui.R
library(shiny)
ui <- shinyUI(fluidPage(
tags$head(
tags$script(
HTML("
Shiny.addCustomMessageHandler ('print',function (message) {
$('#'+message.selector).html(message.html);
console.log(message);
});
")
)
),
textOutput("res1"),
textOutput('res2')
))
# server.R
server <- shinyServer(function(input, output, session) {
session$sendCustomMessage(type = 'print', message = list(selector = 'res1', html = "shows up instantly"))
Sys.sleep(3)
session$sendCustomMessage(type = 'print', message = list(selector = 'res2', html = "shows up after 3 sec"))
})
shinyApp(ui = ui, server = server)
I found a workaround. The idea is to force all render* functions to send their results to the browser once before launching the long computations.
In the following code, the two text zones appear immediately and the second one is updated after 3 seconds.
shinyServer(function(input, output,session) {
status=reactiveValues(res1IsDone=FALSE,res2HasRendered=FALSE)
output$res1 = renderText({
status$res1IsDone = TRUE
"shows up instantly"
})
output$res2 = renderText({
if(isolate(!status$res1IsDone || !status$res2HasRendered)) {
status$res2HasRendered = TRUE
invalidateLater(100,session)
"wait"
} else {
Sys.sleep(3)
"shows up after 3 sec"
}
})
})
To my understanding, shiny is monothreaded and the results are sent back to the browser once all the render* functions are executed once (or when all invalidation are resolved ?).