Stream system() output to Shiny front-end (continuously) - r

How can I capture the output of an ongoing system() operation and stream it to the Shiny front-end in "real-time"?
intern=T captures the entire output in a character vector, but I would prefer to "listen" to the system output as it happens.
library(shiny)
ui <- fluidPage(
titlePanel("Stream the system output"),
sidebarLayout(
sidebarPanel(
actionButton("btn1",label = "Let's stream")
),
mainPanel(
textOutput("textstream_output")
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues("textstream"=c(""))
output$textstream_output <- renderText({
rv$textstream
})
observeEvent(input$btn1,{
# problem: is evaluated after finish, not during operation
rv$textstream <- system("Rscript -e \"for(i in 1:5){ print(Sys.time()); Sys.sleep(1); };\"",
intern = T)
})
}
shinyApp(ui = ui, server = server)
When running the system command with intern=F, the R console continuously updates once per second. How can I establish that in Shiny, ideally without having to slice the system call into smaller chunks?
Possibly related:
Possible to show console messages (written with `message`) in a shiny ui?
Extend time progress bar displays message
R Shiny: mirror R console outputs to Shiny

reactiveTimer provides one approach. My guess is that your approach doesn't work because observeEvent only updates the reactive object once evaluation of the expression is completed. Here's my approach. I create a script that I want to run in the background, so_script.R, and divert the output to so_output.txt. We wish to see the contents of so_output.txt while the script is running.
cat('sink(file = "so_output.txt")
for (i in 1:10) {
cat(format(Sys.time(), format = "%H:%M:%S"), "\n")
Sys.sleep(1)
}
cat("*** EOF ***\n")
sink()
', file = "so_script.R")
Here's the Shiny app:
library(shiny)
ui <- fluidPage(
titlePanel("Stream the system output"),
sidebarLayout(
sidebarPanel(
actionButton("btn_start",label = "Let's stream"),
actionButton("btn_stop",label = "Stop")
),
mainPanel(
htmlOutput("textstream_output")
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(textstream = c(""),
timer = reactiveTimer(1000),
started = FALSE)
observeEvent(input$btn_start, {
rv$started <- TRUE
system2("Rscript", "so_script.R", wait = FALSE)
})
observeEvent(input$btn_stop, { rv$started <- FALSE })
observe({
rv$timer()
if (isolate(rv$started))
rv$textstream <- paste(readLines("so_output.txt"), collapse = "<br/>")
})
output$textstream_output <- renderUI({
HTML(rv$textstream)
})
}
shinyApp(ui = ui, server = server)
Each time the timer fires, we read in the contents of so_output.txt if streaming has started. Output:

Related

Run R script after input in Shiny

Good morning everyone,
I have a Shiny application that collects 5 inputs from the users and stores them into variables.
Then, I would be able to use another R script that would run based on the information provided by the user.
Here is a sample of my Shiny App :
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
#Define UI for application
ui <- pageWithSidebar(
#App title
headerPanel("Filters applied for Powerpoints"),
#Panel to display the filters
sidebarPanel(
#Select dates
dateInput(inputId = "startDate", label = "Start date : ", value = "2018-12-01", format = "yyyy/mm/dd"),
dateInput(inputId = "endDate", label = "End date : ", value = "2018-12-31", format = "yyyy/mm/dd"),
#Select brand template
selectInput("Brand", label = "Select brand : ", choices = list("Carat" = "Carat", "Amplifi" = "Amplifi", "iProspect" = "iProspect", "Isobar" = "Isobar")),
#Select medium type
selectInput("Medium", label = "Select medium type : ", choices = list("Social Post" = "Social Post", "Display" = "Display", "Programmatic" = "Programmatic", "SEA" = "SEA")),
#Enter the plan ID of your campaign
textInput("Camp", label = "Enter the plan ID of your campaign : ", value = ""),
#Button to close the window, then run script
useShinyjs(),
extendShinyjs(text = jscode, functions = c("closeWindow")),
actionButton("close", "Close and run")
),
mainPanel()
)
#Define server logic
server <- function(input, output, session){
observe({
startDate <<- input$startDate
endDate <<- input$endDate
brand <<- input$Brand
medium <<- input$Medium
campaign <<- input$Camp
})
observeEvent(input$close, {
js$closeWindow()
stopApp()
})
source("C:/Users/RPeete01/Desktop/Automated powerpoints/Datorama R/Datorama reporting R/DatoramaSocial.R")
}
#Run the application
shinyApp(ui = ui, server = server)
I've used the source function but it doesn't work.
If someone has an idea, please let me know.
Thanks a lot,
Rémi
You should take advantage of built in onStop functions in shiny to execute some functions before the stopApp() call
library(shiny)
if (interactive()) {
# Open this application in multiple browsers, then close the browsers.
shinyApp(
ui = basicPage("onStop demo",actionButton("close", "Close and run")),
server = function(input, output, session) {
onStop(function() cat("Session stopped\n"))
observeEvent(input$close, {
stopApp()
})
},
onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup, your functions go here\n")
})
}
)
}
Instead of creating a function to replace your script, you can source your script by supplying an environment to the local option. This environment must contain the objects needed by your script. Something like that:
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
startDate = input$startDate,
endDate = input$endDate,
brand = input$Brand,
medium = input$Medium,
campaign = input$Camp))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
EDIT
Here is a full example.
library(shiny)
ui <- fluidPage(
textInput("text", "Enter text", value = "test"),
actionButton("runScript", "Run")
)
server <- function(input, output, session) {
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
text = input$text))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
}
shinyApp(ui, server)
File myscript.R:
writeLines(text, "output.txt")
When I run the app and click on the button, the file output.txt is correctly created (i.e. the script is correctly sourced).
Your script DatoramaSocial.R should be formulated as a function that takes your 5 input values as arguments. As to the return value, well you haven't told us what you want to do with it. By formulating it as a function I mean wrap everything in DatoramaSocial.R in a function (or several subfunctions). The code for that function can easily reside in the external script file or be pasted before the ui and server statements in your shiny app. If the former, simply include the definitions by calling source('DatoramaSocial.R') before your ui and server statements.
Now, in your server function, you can simply call it as a reaction to changes in the input:
observe({
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
Although in this case, I recommend inserting an actionbuttonInput and having the user click that when they have selected all their inputs. In which case, update to:
observeEvent(input$actionbutton, ignoreInit=TRUE, {
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
where actionbutton is the actionbutton's inputId.

How to render something first in shiny before excuting the rest of code?

I want to render a text to notify the user that a task is going to run, but it seems that shiny executes all code in server first then it moves to UI.
Here is an example:
library(shiny)
ui <- fluidPage(
mainPanel(
textOutput("ptext")
))
server <- function(input, output) {
output$ptext <- renderText("creating a dataframe")
df <- matrix(rnorm(10000),nrow = 10) # a large dataset
output$ptext <- renderText("dataframe created !!")
}
shinyApp(ui = ui, server = server)
In the above example, I never see "creating a dataframe", How to render that text first before executing the rest of the code.
It's not the most beautiful, but if you can use an input for status messages like this, you can relay what's going on ...
library(shiny)
ui <- fluidPage(
mainPanel(
textInput("notice", "Status", "creating a dataframe"),
textOutput("ptext")
)
)
server <- function(input, output, session) {
dat <- reactive({
Sys.sleep(3)
matrix(rnorm(10000), nrow = 10)
})
output$ptext <- renderText({
req(dat())
updateTextInput(session, "notice", value = "dataframe created !!")
return("hello world")
})
}
shinyApp(ui = ui, server = server)
(Note the addition of session to the arguments to server, necessary to use updateTextInput(session, ...).)
You could get more complex by using dynamic UI creation and deletion, or object hiding (perhaps using shinyjs), but that is getting a bit more complex than I think you may want.

R Shiny - Sequential text output

I want to print a text first, before processing the code and then print a confirmation after the code is executed.
Here is my code (ui and server of app.R):
All unspecified variables are initiated within the app.R file.
ui <- fluidPage(
# Application title
titlePanel(h1("Order2Ship", align="center")),
# Sidebar iputs
sidebarLayout(
sidebarPanel( #LONG LIST OF INPUTS
),
# On Screen output
mainPanel(
textOutput("START"),
textOutput("Confirm")
)
)
)
# Underlining code for output (computes the whole each time an input is changed)
server <- function(input, output) {
observeEvent(input$Do, { # ignores all return values
output$START <- renderText({"Starting Analysis"})
O2S( #LONG LIST OF PARAMETERS, FROM INPUTS
)
output$Confirm <- renderText({"Analysis Done"})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I do not need any returns from the function O2S, it basically takes one file as input and generates a solution file. But, both the text outputs are showing at the same time, after the function has run. I cannot figure it out. I just started out with Shiny, so sorry for such a naïve question.
Hi you can use shinyjs to create a chainevent something like this
library(shinyjs)
library(shiny)
ui <- fluidPage(
# Application title
titlePanel(h1("Order2Ship", align="center")),
# Sidebar iputs
sidebarLayout(
sidebarPanel( #LONG LIST OF INPUTS
actionButton(inputId = "Do",
label = "Start")
),
# On Screen output
mainPanel(
textOutput("START"),
textOutput("Confirm"),
useShinyjs()
)
)
)
# Underlining code for output (computes the whole each time an input is changed)
server <- function(input, output) {
startText <- eventReactive({input$Do},{
runjs("Shiny.onInputChange('analysisStarted',Date.now())")
"Starting Analysis"
},
ignoreInit = TRUE)
output$START <- renderText({startText()})
observeEvent(input$analysisStarted, { # ignores all return values
temp <- NULL
for(i in seq(50000)){
temp <- c(temp,i)
}
runjs("Shiny.onInputChange('analysisFinished',true)")
},
ignoreInit = FALSE)
confirmText <- eventReactive({input$analysisFinished},{
"Analysis Done"
},
ignoreInit = FALSE)
output$Confirm <- renderText({confirmText()})
}
# Run the application
shinyApp(ui = ui, server = server)
hope this helps!

Is there a way to run arbitrary code on objects created in a R Shiny app?

My users would like to run some R scripts using the objects that my Shiny App creates. E.g. if my app creates a new data frame, they would like to run their own analysis using the new data frame.
Is there a way to do that?
Maybe some console-like (interactive) feature in R Shiny?
I found this Access/use R console when running a shiny app, but wondering if there is any other way to do it besides building your own server.
Any input is great appreciated. Thank you!
Here is an example of a very basic console on Shiny. It is based on Dean Attali's code here. The idea is to execute arbitrary code from a textInput with the eval function using the same environment that shiny is using. To test the idea, the variable myDat was created inside the server function and can be used by the user. It should also work with other objects created later. I also enabled the "Enter" key to press the [Run] button using JavaScript, so you don't need click on the button.
It is recommended to enable this console only to trusted users, it is a complete open access to any R command and can be potentially a serious security issue.
library(shiny)
ui <- fluidPage(
# enable the <enter> key to press the [Run] button
tags$script(HTML(
'$(document).keyup(function(event) {
if (event.keyCode == 13) {
$("#run").click();
}
});'
)),
textInput("expr", label = "Enter an R expression",
value = "myDat"),
actionButton("run", "Run", class = "btn-success"),
div( style = "margin-top: 2em;",
uiOutput('result')
)
)
server <- function(input, output, session) {
shinyEnv <- environment()
myDat <- head(iris)
r <- reactiveValues(done = 0, ok = TRUE, output = "")
observeEvent(input$run, {
shinyjs::hide("error")
r$ok <- FALSE
tryCatch(
{
r$output <- isolate(
paste(
capture.output(
eval(parse(text = input$expr), envir = shinyEnv)
),
collapse = '\n'
)
)
r$ok <- TRUE
}
,
error = function(err) {
r$output <- err$message
}
)
r$done <- r$done + 1
})
output$result <- renderUI({
if (r$done > 0 ) {
content <- paste(paste(">", isolate(input$expr)), r$output, sep = '\n')
if (r$ok) {
pre(content)
} else {
pre( style = "color: red; font-weight: bold;", content)
}
}
})
}
shinyApp(ui = ui, server = server)
If you want to make a data frame available to the user in the global environment after running the app, you can use assign(). The following example uses the logic of a shiny widget that can be added as an add-in to RStudio:
shinyApp(
ui = fluidPage(
textInput("name","Name of data set"),
numericInput("n","Number observations", value = 10),
actionButton("done","Done")
),
server = function(input, output, session){
thedata <- reactive({
data.frame(V1 = rnorm(input$n),
V2 = rep("A",input$n))
})
observeEvent(input$done,{
assign(input$name, thedata(), .GlobalEnv)
stopApp()
})
}
)
Keep in mind though that your R thread is continuously executing when a shiny app is running, so you only get access to the global environment after the app stopped running. This is how packages with a shiny interface deal with it.
If you want users to be able to use that data frame while the app is running, you can add a code editor using eg shinyAce. A short example of a shiny App using shinyAce to execute arbitrary code:
library(shinyAce)
shinyApp(
ui = fluidPage(
numericInput("n","Number observations", value = 10),
aceEditor("code","# Example Code.\n str(thedata())\n#Use reactive expr!"),
actionButton("eval","Evaluate code"),
verbatimTextOutput("output")
),
server = function(input, output, session){
thedata <- reactive({
data.frame(V1 = rnorm(input$n),
V2 = rep("A",input$n))
})
output$output <- renderPrint({
input$eval
return(isolate(eval(parse(text=input$code))))
})
}
)
But the package comes with some nice examples, so take a look at those as well.

Force rendering of already computed reactive elements

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

Resources