Is there a way to show happenings/errors/warnings from R script which is sourced inside server part of Shiny in Shiny panel?
Following is the sample code which works fine, but I need to see in Shiny if R throws an error while executing sourced GUI_trials2.R and if possible, a window to stream the happenings, like which line of GUI_trials2.R is running currently.
Sample code -
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Required Calcs", tabName = "Requirements")
)
)
uibody <- dashboardBody(
tabItems(
tabItem(tabName = "Requirements", h2("Required Calcs")
,dateInput("ME_DATE_output",label=h2("Execution Date"), value="2020-05-29")
,hr()
,actionButton("calculate", "Calculate this" ))
))
ui = dashboardPage(dashboardHeader(title = "Results"), sidebar, uibody)
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
Code_loc <- "K:/Codes/"
observeEvent(input$calculate, {
ME_DATE <- ME_DATE_GUI()
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE)
})
}
shinyApp(ui, server)
GUI_trials looks like -
# Use ME_DATE from Shiny
ME_DATE <- as.Date(ME_DATE, format="%Y-%m-%d")
year_N_ME_DATE <- format(ME_DATE,"%Y")
month_N_ME_DATE <- format(ME_DATE,"%m")
month_T_ME_DATE <- months(ME_DATE)
# Location for Outputs
Output_DIR <- "K:/Outputs/"
Output_loc <- paste(Output_DIR,month_N_ME_DATE,". ",month_T_ME_DATE, " ",year_N_ME_DATE,"/",sep="")
success <- "Success"
write.csv(success, paste0(Output_loc,"Success.csv"))
Any help is deeply appreciated!
Use withCallingHandlers()
You can wrap your call to source() as follows and use arbitrary code to handle warnings and messages that arise when the code is run. To handle errors you will need to wrap this again in tryCatch() so your app doesn't crash. For example, you could choose to simply send notifications as follows:
tryCatch(
withCallingHandlers(
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE),
message = function(m) showNotification(m$message, type = "message"),
warning = function(w) showNotification(w$message, type = "warning")
),
error = function(e) showNotification(e$message, type = "error")
)
You can test this by using something like the following code in your GUI_trials2.R script:
for (i in 1:3) {
warning("This is warning ", i)
Sys.sleep(0.5)
message("This is message", i)
Sys.sleep(0.5)
}
stop("This is a fake error!")
Streaming Output in New Window
The easiest way to do this is to pepper your GUI_trials2.R script with informative calls to message() and then use withCallingHandlers() to output these as above. If you want to be more sophisticated and show these messages in a new window, you could do this by updating a modalDialog(), though this would require the shinyjs package. Here is a basic example:
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
# Show a modal that will be updated as your script is run
observeEvent(input$calculate, {
showModal(modalDialog(
shinyjs::useShinyjs(),
title = "Running my R script",
div("You can put an initial message here", br(), id = "modal_status")
))
Code_loc <- "K:/Codes/"
ME_DATE <- ME_DATE_GUI()
# Run the script and use `withCallingHandlers()` to update the modal.
# add = TRUE means each message will be added to all the previous ones
# instead of replacing them.
tryCatch(
withCallingHandlers(
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE),
message = function(m) {
shinyjs::html("modal_status", paste(m$message, br()), add = TRUE)
},
warning = function(w) {
shinyjs::html("modal_status", paste(w$message, br()), add = TRUE)
}
),
error = function(e) {
shinyjs::html("modal_status", paste(e$message, br()), add = TRUE)
}
)
})
}
Display Code From source()
The echo = TRUE argument to source() will mean that each expression in the file gets printed in the console. Unfortunately, applying handlers to text as it appears in the console isn't possible in R unless it's a message/warning/error, so echo = TRUE won't be of any use here. However, you could define a custom function, similar to source() which will allow you to handle the code as text before it gets evaluated. Here is an example:
# Default handler just prints the code to console, similar
# to `source(echo = TRUE)`
source2 <- function(file, handler = cli::cat_line, local = FALSE) {
# Copy `source()` method of handling the `local` argument
envir <- if (isTRUE(local))
parent.frame()
else if (isFALSE(local))
.GlobalEnv
else if (is.environment(local))
local
else stop("'local' must be TRUE, FALSE or an environment")
# Read each 'expression' in the source file
exprs <- parse(n = -1, file = file, srcfile = NULL, keep.source = FALSE)
# Apply `handler()` to each expression as text, then
# evaluate the expression as code
for (expr in exprs) {
handler(deparse(expr))
eval(expr, envir)
}
# Return nothing
invisible()
}
This will allow you to do anything you like with the code text before
it gets evaluated. E.g. you could apply some pretty HTML formatting and
then output it as a message, which would allow you to use something very similar to the code above, since withCallingHandlers() would handle
these messages for you:
# Define a function to show a message as code-formatted HTML
html_message <- function(msg) {
with_linebreaks <- paste(msg, collapse = "<br/>")
as_code <- sprintf("<code>%s</code>", with_linebreaks)
spaces_preserved <- gsub(" ", " ", as_code)
message(spaces_preserved)
}
# Then use very similar code to the above for `server`, so
# something like -
tryCatch(
withCallingHandlers(
source2(file = paste0(Code_loc,"GUI_trials2.r"),
handler = html_message,
local = TRUE),
# ... Same code as in the above example using normal source()
Bonus: Getting Fancy with HTML
If you want to get really fancy you could add some custom HTML formatting to each of your message/warning/error functions, e.g. you could show errors in red like so:
error = function(e) {
shinyjs::html("modal_status", add = TRUE, sprintf(
'<span style = "color: red;">%s</span><br/>', e$message
))
}
I am running an R script daily that I would like to prompt me to enter data when selecting all the whole script.
I have already tried readline(prompt = ), which prompts in the rstudio console, but it does not prompt me if I select all code to run. I also did not like the prompt being in the console because it was easy to overlook.
I have also looked into library(tcltk), in hopes that a message box could help, but nothing I tried seemed to work.
Here's a method using library(tcltk)
EntryBox <- function(label = 'Enter', title = 'Entry Box') {
tt <- tktoplevel()
tkwm.title(tt, title)
done <- tclVar(0)
tkbind(tt,"<Destroy>", function() tclvalue(done) <- 2)
result <- tclVar("")
cancel.but <- tkbutton(tt, text='Cancel', command=function() tclvalue(done) <- 2)
submit.but <- tkbutton(tt, text="Submit", command=function() tclvalue(done) <- 1)
tkgrid(tklabel(tt, text=label), tkentry(tt, textvariable=result), pady=3, padx=3)
tkgrid(submit.but, cancel.but, pady=3, padx=3)
tkfocus(tt)
tkwait.variable(done)
if(tclvalue(done) != 1) result <- "" else result <- tclvalue(result)
tkdestroy(tt)
return(result)
}
x <- EntryBox(label = 'Enter a string'); x
Hi I am trying to run a r script
loadData <- function()
{
library(XLConnect)
excel0157 <- loadWorkbook("C:\\Users\\\\Documents\\R\\data\\0157\\0157.xlsx")
sheet_names <- getSheets(excel0157)
c0157 <- readWorksheetFromFile("C:\\Users\\\\Documents\\R\\data\\0157\\0157.xlsx",sheet = sheet_names[1],region = "B4:B27", header = FALSE)
for (i in 1:79) {
c0157[i] <-readWorksheetFromFile("C:\\Users\\\\Documents\\R\\data\\0157\\0157.xlsx",sheet = sheet_names[i],region = "B4:B27", header = FALSE)
}
c0157ts1 <- as.numeric(c(t(c0157)))
}
However, c0157ts1 does not create. If I run the c0157ts1 <- as.numeric(c(t(c0157))) in the console, c0157ts1 is created.
Can anyone explain why?
I just started with tcltk and R. And I am having troubles accessing a computed value by a function called myFun1 when calling a second function myFun2:
Here is a simplified version of my UI:
Simple tcltk interface
library(tcltk)
tt <- tktoplevel()
topMenu <- tkmenu(tt)
tkconfigure(tt, menu = topMenu)
fileMenu <- tkmenu(topMenu, tearoff = FALSE)
tkadd(fileMenu, "command", label = "Function1", command = myFun1)
tkadd(fileMenu, "command", label = "Function2", command = myFun2)
tkadd(topMenu, "cascade", label = "Tab", menu = fileMenu)
tkfocus(tt)
My functions
myFun1 <- function() {
compVal <- 2*3
compVal
}
myFun2 <- function() {
msg <- paste("The value is: \n", compVal )
mbval<- tkmessageBox(title="This is the title",
message=msg,type="yesno",icon="question")
}
Calling myFun1 works, but myFun2 returns
Error in paste("The value is: \n", compVal) :
Object 'compVal' not found
Also wrapping compVal into return(compVal) doesn`t work.
I was also thinking of doing:
res <- list(compVal=compVal)
but I am not able to access the created list with myFun2.
Any sugesstions on how to access the returned value form myFun1 inside myFun2?
I found a solution, at first I thought its not really a "clean" way of doing it, but even in the offical documentation it is done this way.
Simply create a global variable using <<- :
myFun1 <- function() {
compVal <<- 2*3
}
Is there a way to embed the function edit(dataframe) in gwindow?
example:
DataFrame <- data.frame(cbind(1,1:10)
edit(DataFrame)
Window <- gwindow()
I would like to embed edit(DataFrame) in Window.
Apostolos
The standard way to do this would be through a button click.
dfr <- data.frame(x = 1:10, y = runif(10))
win <- gwindow()
btnEdit <- gbutton(
"Edit",
container = win,
handler = function(h, ...) dfr <<- edit(dfr)
)
You can be even fancier and decide whether or not the data frame should be editable or just viewable.
win <- gwindow()
btnEdit <- gbutton(
"Edit",
container = win,
handler = function(h, ...)
{
if(svalue(chkReadonly)) View(dfr) else dfr <<- edit(dfr)
}
)
chkReadonly <- gcheckbox(
"Read-only",
FALSE,
container = win,
handler = function(h, ...)
{
svalue(btnEdit) <- if(svalue(h$obj)) "View" else "Edit"
}
)
Based upon your comment, what you want is even easier. Store the data frame in a gdf.
tbl <- gdf(dfr, container = win)