How to run reactive background process in shiny R? - r

I've written code that runs a long calculation in which, as part of it, several UI elements are updated showing part of the progress and results of the calculations. I would like to make possible for the user to run more than one calculation at the same time and keep been able of checking the progress and results.
This is an example app code:
#EXAMPLE APP----
#Libraries----
library(shiny)
library(shinyjs)
#UI code----
ui <- fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton(
'pressme',
'Press me'
)
),
mainPanel(
div(
id='inmainP'
)
)
)
)
#Server code----
server <- function(input, output, session) {
clicks <- reactiveValues()
clicks$count <- 0
##Adding the UI elements necesary when pressing the button----
observeEvent(input$pressme,{
clicks$count <- clicks$count + 1
insertUI(
'#inmainP',
'beforeEnd',
div(id=paste0('Pcontainer',clicks$count),
p(tags$b(paste0(clicks$count,'-Process'))),
style = 'border:solid thin black;text-align: center;')
)
insertUI(
paste0('#Pcontainer',clicks$count),
'beforeEnd',
textOutput(paste0('process',clicks$count,'1'))
)
insertUI(
paste0('#Pcontainer',clicks$count),
'beforeEnd',
textOutput(paste0('process',clicks$count,'2'))
)
insertUI(
paste0('#Pcontainer',clicks$count),
'beforeEnd',
textOutput(paste0('process',clicks$count,'3'))
)
###Creating input to observe to do long calculation----
#This is done because it is the only way that I've accomplished, in the real app,
#that new elements render before starting calculation
runjs(
paste0('
Shiny.setInputValue("start",',clicks$count,')
')
)
})
##Runing long calculation----
observeEvent(input$start,{
odd <- 1
even <- 1
for (i in 1:10) {
Sys.sleep(1)
html(paste0('process',clicks$count,'1'), i)
if((i%%2)==0){
html(paste0('process',clicks$count,'2'), even)
even <- even + 1
}else{
html(paste0('process',clicks$count,'3'), odd)
odd <- odd + 1
}
}
})
}
shinyApp(ui, server)
As you will notice this app runs perfectly but new processes only run once the ones before have finished. I would like to solve this using callr package, that I've managed to use in other long jobs in the app, but don't know how to use it properly here. Any other suggestions based on the use of other packages as promises or future are also welcome.
As I mention I've tried to solve this using callr but I've failed at traying to create eventReact(s) programmatically, necessary to run each background job (to my understanding). And I don't understand how to make UI update from background process. How do the background processes work in R?
Link to this question in RStudioCommunity.

Related

How to check to see if a function is an object in the R workspace and if not, run a source file to invoke it?

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)))

if-statement in Shiny UI: evaluate simple numeric condition calculated in server

In my way to learning Shiny rudiments, I do want to build a simple application that presents a ui with boxes with different background colours based on the value of a variable calculated in server.
I'm trying to use a classical if-statement, being n_add_due_all in server:
fluidRow(
if(n_add_due_all > 0)
{box(title = "to add", background = "red")}
else
{box(title = "to add", background = "green")}
)
I've being trying to use renderUI -> uiOutput and renderPrint -> textOutput server/ui pairs, but I'm not able to get a numeric value suitable for the n_add_due_all > 0 evaluation.
Please, is it doable? Is there any way of simply passing a numeric value from server to ui?
I found numerous related question and answers, but all of them seam much complex user-cases where some kind of interaction with user by selecting or entering values is required. In this case, the variable is completely calculated in server and should only be recalculated upon a page reload.
Thanks for your help!
Are you looking for this?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(uiOutput("box"))
)
server <- function(input, output, session) {
n_add_due_all <- -1
output$box <- renderUI({
fluidRow(
if (n_add_due_all > 0) {
shinydashboard::box(title = "to add", background = "red")
} else {
shinydashboard::box(title = "to add", background = "green")
}
)
})
}
shinyApp(ui, server)

R shiny: printing the console output produced by an R package to UI

I am using an R package that, in addition to calculating and returning things, prints some very useful info to the console. For example, it prints what iteration it is on right now.
How could I print that console output directly to my UI?
Assume this is my UI:
ui <- shinyUI(
fluidPage(
titlePanel("Print consol output"),
sidebarLayout(
sidebarPanel(actionButton("go", "Go")),
mainPanel(
verbatimTextOutput("console_text")
)
)
)
)
My user clicks on actionButton “Go” and my package starts doing things - while sending stuff to the console at the same time. I guess, I want the content of the console to be saved as output$console_text - but I don’t know if that’s the right approach and how to do it.
I didn't want to make the code super-complicated. So, instead of a package, I created my own little printing function in Server.
server <- function(input, output, session) {
myfunction <- function(x) {
for(i in 1:x) cat(i)
return(x)
}
observeEvent(input$go, {
{
# This is probably wrong:
output$console_text <- renderPrint(onerun <- myfunction(20))
}
})
}
shinyApp(ui, server)
Thank you very much!

How to present an output without waiting for the rest of the script to run in R Shiny

I have a Shiny app that should calculate a value, present it and then use the same value for further more expensive computation. The problem is that it shows me the output only after it finishes evaluating the whole script. Here is a simple example:
library(shiny)
ui <- fluidPage(
titlePanel("test"),
sidebarLayout(
sidebarPanel(
textInput("text_in","Enter text here",value = "This is text to process"),
actionButton("go", "Go")
),
mainPanel(
textOutput("first_text"),
textOutput("results")
)
)
)
# Define server logic
server <- function(input, output) {
num_letter<-eventReactive(input$go, {
nchar(input$text_in)})
output$first_text <- renderText(num_letter())
sec_calculation<-eventReactive(num_letter(), {
Sys.sleep(3)
num_letter()*num_letter()})
output$first_text <- renderText(num_letter())
output$results <- renderText(sec_calculation())
}
# Run the application
shinyApp(ui = ui, server = server)
I added the Sys.sleep so it will be easier to see the problem. I would like to get the first output without waiting for the second one.
This is not currently possible (at least not with native shiny code - you can always hack a workaround). An open issue for this exists on the shiny github repository: https://github.com/rstudio/shiny/issues/1705

Pattern for triggering a series of Shiny actions

I'm having trouble creating a sequence of events in a Shiny app. I know there are other ways of handling parts of this issue (with JS), and also different Shiny functions I could use to a similar end (e.g. withProgress), but I'd like to understand how to make this work with reactivity.
The flow I hope to achieve is as follows:
1) user clicks action button, which causes A) a time-consuming calculation to begin and B) a simple statement to print to the UI letting the user know the calculation has begun
2) once calculation returns a value, trigger another update to the previous text output alerting the user the calculation is complete
I've experimented with using the action button to update the text value, and setting an observer on that value to begin the calculation (so that 1B runs before 1A), to ensure that the message isn't only displayed in the UI once the calculation is complete, but haven't gotten anything to work. Here is my latest attempt:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("run", "Pull Data")
mainPanel(
textOutput("status")
)
)
)
server <- function(input, output, session) {
# slow function for demonstration purposes...
test.function <- function() {
for(i in seq(5)) {
print(i)
Sys.sleep(i)
}
data.frame(a=c(1,2,3))
}
report <- reactiveValues(
status = NULL,
data = NULL
)
observeEvent(input$run, {
report$status <- "Pulling data..."
})
observeEvent(report$status == "Pulling data...", {
report$data <- test.function()
})
observeEvent(is.data.frame(report$data), {
report$status <- "Data pull complete"
}
)
observe({
output$status <- renderText({report$status})
})
}
Eventually, I hope to build this into a longer cycle of calculation + user input, so I'm hoping to find a good pattern of observers + reactive elements to handle this kind of ongoing interaction. Any help is appreciated!

Resources