I have a R Shiny app which i am running from Posit. It is running perfectly by running app.R file and the dashboard is launching and the corresponding logs / outputs are getting displayed in R studio in Posit.
Is there a way i can show live real time outputs/logs from R studio consol directly to R Shiny Dashboard frontend? Also adding a progress bar to check status how much percentage of the overall code has run in the UI ?
Below is my code
UI ---------------------------------------------------------------------------------------------
{ # Collapse here
module_tab_inputs_ui <- function(id) {
ns <- NS(id)
ui_contents <- tagList(
fluidRow(
f_global_box(
title = tagList(icon("cat", verify_fa = FALSE), HTML(" "), "Press the Run Button to execute CSM tool!"),
background_color = colour_global_quantum_yellow,
text_color = "black",
outerId = ns("html_EG_BOX1_Id"),
collapseButtonId = ns("in_EG_BOX1_AB_CollapseButton"),
br(),
## UI Buttons -------------------------------------------------------------
fluidRow(
column(4,
shinyFilesButton(
id = ns("in_tab_inputs_btn_chosen_config_file"),
label = "Configuration File",
title = "Select a file where the inputs are.",
icon = icon("arrow-up-from-bracket", verify_fa = FALSE),
width = "200px" ,multiple = TRUE # Adjusted button width
)),
column(4,
shinyDirButton(
id = ns("choosen_dir"),
label = "Choose output folder",
title = "Select a folder where the outputs will be saved",
icon = icon("arrow-up-from-bracket", verify_fa = FALSE),
width = "200px"
)),
),
br(),
fluidRow(
column(4,
actionButton(
inputId = ns("in_CodeRunButton"),
label = "Run Button",
icon = icon("play", verify_fa = FALSE),
width = "150px"
)),
column(4, tags$b(textOutput(ns("hover_message")))),
),
br(), br(),
fluidRow(
column(6, div(style = "display: flex; align-items: center;",
div("Version Name:", style = "margin-right: 10px; font-weight: bold; white-space: nowrap;"),
div(textInput(ns("in_tab_inputs_ti_version_name"), label = NULL, width = "120px"),
style = "margin-right: 10px; height: 34px; padding: 5px; font-size: 14px;"),
div(actionButton(ns("in_tab_inputs_ab_submit_button"), "Submit"),
style = "height: 38px; line-height: 30px; padding: 5px 10px; font-size: 14px;"),
style = "display: flex; align-items: center;")
)
),
br(),
fluidRow(
column(
width = 12,
tags$div(
style = "padding: 10px;
border-radius: 8px;
border: 1px solid #dee2e6;
font-size: 18px;
font-weight: bold;
color: #343a40;
display: flex;
align-items: center;
box-shadow: 2px 2px 5px rgba(0,0,0,0.1);
margin-top: 5px;
width: 100%;
white-sapce:nowarp;
overflow-x:auto;",
icon("info-circle", style = "margin-right: 8px; font-size: 20px;"),
tags$span("Message:", style = "margin-right: 5px;"),
tags$span(
textOutput(ns("message_text")),
style = "font-size: 16px; color: #007bff; font-weight: normal; flex-grow: 1; word-wrap: break-word;"
)
)
)
),
br(), br(),
fluidRow(
column(
12,
actionButton(ns("in_tab_inputs_ab_config_table"), "Configuration File Table", class = "btn btn-primary", width = "100%"),
hidden(
div(
id = ns("div_tab_home_config_table"),
uiOutput(ns("out_tab_inputs_uo_config_table"))
) # div
) # hidden
) # column
), # fluidRow
br(), br(),
) # f_global_box
) # fluidRow
) # tagList
return(ui_contents)
} # module_tab_inputs_ui
} # UI close
________________ -------------------------------------------------------------------------------
SERVER -----------------------------------------------------------------------------------------
{ # Collapse here
module_tab_inputs_server <- function(id) {
# We illustrate taking a reactive expression and a reactive value as an input
moduleServer(
id,
function(input, output, session) {
ns <- NS(id)
# Set up the file system roots
roots <- c(remote = kRemotePath)
## File selection ------------------------------------------------------
shinyFileChoose(input, "in_tab_inputs_btn_chosen_config_file", roots = roots, session = session)
# Reactive value to store the selected file directory
rv_chosen_config_file <- reactive(parseFilePaths(roots, input[["in_tab_inputs_btn_chosen_config_file"]]))
## Directory selection----------
shinyDirChoose(input, "choosen_dir", roots = roots, session = session)
# Reactive value to store the selected directory
choosen_dir <- reactive(parseDirPath(roots, input[["choosen_dir"]]))
# Reactive value to store the data
rv_input_data <- reactiveVal(NULL)
rv_version_name <- reactiveVal(NULL)
rv_log_open <- reactiveVal(NULL)
rv_old_log_data <- reactiveVal(NULL)
rv_folder_path_without_ver_name <- reactiveVal(NULL)
# Reactive value to indicate if run was performed
rv_run_completion_flag <- reactiveVal(NULL)
# global output path to save output and log files
output_file_path <- reactiveVal(NULL)
run_info<-reactiveVal("No run folder.")
checks_info<-reactiveVal("No checks available for display.")
# ## Display configuration table------------
input_files_table <- function(file_path) {
# Importing and Initial Processing
input_data <- ImportInputPython(
file_path, sheet = "Filepaths",
script = kPythonImportingPath
)
input_data <- input_data %>%
mutate(Filepath = strsplit(Filepath, "[/\\\\]")) %>%
rowwise() %>%
mutate(Filepath = do.call(file.path, as.list(unlist(Filepath)))) %>%
ungroup()
# Adding Temp_filepath column
input_data$Temp_filepath <- input_data %>%
mutate(Filepath = map_chr(Filepath, ReplacePathsForEnvironment)) %>%
pull(Filepath)
# Adding TimeStamp column
input_data[["TimeStamp"]] <- sapply(input_data$Temp_filepath, function(path) {
if (file.exists(path)) {
format(file.info(path)$mtime, "%d-%m-%y %H:%M:%S")
} else {
NA_character_
}
})
# Adding FileName column
input_data[["FileName"]] <- basename(input_data[["Filepath"]])
return(input_data)
}
# Render the input data table
RenderInputDataTable <- function(input_data) {
config_data <- input_data[["configuration_file"]]
config_data <- config_data %>%
as.data.frame() %>%
select(Process, Description, Filepath, TimeStamp)
datatable(config_data, options = list(
dom = "lrtip", # Remove global search box
pageLength = 10,
fixedHeader = TRUE, # fixed headers when scrolling
scrollX = TRUE, # Scroll horizontally
searchHighlight = TRUE,
columnDefs = list(list(searchable = TRUE, targets = "_all"))
), filter = "top",
colnames = c("Process", "Description", "FileLink", "TimeStamp")
) # datatable
} # function
# observeEvent Configuration file
observeEvent(input[["in_tab_inputs_ab_config_table"]], {
toggle("div_tab_home_config_table")
})
#Render UI for the input data table
output[["out_tab_inputs_uo_config_table"]] <- renderUI({
df <- rv_input_data()
if (is.null(df) || !("configuration_file" %in% names(df)) || is.null(df[["configuration_file"]])) {
div(style = "text-align: center;", h3("No details to display."))
} else {
div(
class = "citi-table-1",
DTOutput(ns("out_tab_inputs_dto_config_table"))
)
}
})
# Display the configuration table
output[["out_tab_inputs_dto_config_table"]] <- renderDT({
req(rv_input_data())
config_table <- rv_input_data()
RenderInputDataTable(config_table)
})
# Observe the configuration file selection
observeEvent(rv_chosen_config_file(), {
# Extract the file path from the reactive value
file_path <- rv_chosen_config_file()[["datapath"]]
# Check if the file path is valid (not empty, not NULL, and the file exists)
if (length(file_path) != 0 && !is.null(file_path) && file.exists(file_path)) {
# Update the reactive value with the processed data from the configuration file
rv_input_data(list(configuration_file = input_files_table(file_path)))
# Retrieve the processed configuration file data from the reactive value
file_data <- rv_input_data()[["configuration_file"]]
# Check if the configuration file data is empty
if (is.null(file_data) || nrow(file_data) == 0) {
showNotification("Configuration table is not chosen or it is empty.", type = "warning")
} else {
# Extract and display only the specified columns from the data
extracted_data <- file_data %>%
select(Process, Description, Filepath, TimeStamp)
put(extracted_data[, c("Process", "Description", "Filepath", "TimeStamp")], n = 1000)
# Log a message indicating that the configuration file has been used for the run
LogMessageWithTimestamp("Copy of the configuration file used for the run.")
# Update the UI to display the selected file's name
output$message_text <- renderText({
paste("Configuration file selected: ", basename(file_path))
})
}
}
})
# Observe the directory selection
observeEvent(choosen_dir(), {
req(choosen_dir())
current_time <- Sys.time()
formatted_time <- format(current_time, "%y-%m-%d_%H-%M")
file_path <- file.path(choosen_dir(), formatted_time)
source(file.path("R", "config", "load_output_names.R"))
rv_run_completion_flag(0)
if (!dir.exists(file_path)) {
dir.create(file_path)
}
output_file_path(file_path)
rv_folder_path_without_ver_name(file_path)
run_info
(paste("Selected run folder:", ReplacePathsForEnvironment(file.path(output_file_path()), to_pdrive = TRUE)))
checks_info("No checks available for display. Awaiting the start and completion of the new run.")
output$message_text <- renderText({
paste("Selected folder to save outputs:", ReplacePathsForEnvironment(file.path(output_file_path()), to_pdrive = TRUE))
})
})
## Log creation-----------------------------
# Create the log file once the file has been chosen
observe({
req(output_file_path())
# Create the log file once the file has been chosen
log_file <- file.path(output_file_path(), "logfile.log")
if(output_file_path() != get("parent_folder_of_previous_log_file", envir = .GlobalEnv)) {
old_log <- read.table(file.path(get("parent_folder_of_previous_log_file", envir = .GlobalEnv), "log", "logfile.log"), sep = "\n")
log_close()
rv_log_open(log_open(log_file))
write.table(old_log, rv_log_open(), sep = "\t", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
assign("parent_folder_of_previous_log_file", output_file_path(), envir = .GlobalEnv)
} else{
rv_log_open(log_open(log_file))
write.table(rv_old_log_data(), rv_log_open(), sep = "\t", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
}
sep("Shiny dashboard Input tab")
LogMessageWithTimestamp("Copy of the configuration file used for the run.")
file_data_log <- rv_input_data()[["configuration_file"]]
if (!is.null(file_data_log)) {
extracted_data <- file_data_log %>%
select(Process, Description, Filepath, TimeStamp)
put(extracted_data[, c("Process", "Description", "Filepath", "TimeStamp")], n= 1000)
} else {
showNotification("Configuration file data is NULL.", type = "warning")
}
})
# Observe submit button click
observeEvent(input$in_tab_inputs_ab_submit_button, {
if (is.null(rv_folder_path_without_ver_name())) {
output$message_text <- renderText("Choose output folder before clicking the submit button.")
} else if (rv_run_completion_flag()==1) {
output$message_text <- renderText("CSM Tool run was performed and files were saved in current folder. Choose another output folder before clicking the submit button and adding new version name.")
}
else {
rv_version_name(input$in_tab_inputs_ti_version_name)
if( grepl("[[:space:]]", rv_version_name()) || grepl("[^A-Z0-9_-]", rv_version_name()))
{showNotification("Invalid filename. Please ensure it contains only capital letters, numbers, underscores, hyphens and no spaces.", type = "error")}
else {
req(rv_version_name())
source(file.path("R", "config", "load_output_names.R"))
kCsmAOutputFilenames <<- sapply(kCsmAOutputFilenames, function(x) paste0(x, "_", rv_version_name()))
kCsmBOutputFilenames <<- sapply(kCsmBOutputFilenames, function(x) paste0(x, "_", rv_version_name()))
kCsmCOutputFilenames <<- sapply(kCsmCOutputFilenames, function(x) paste0(x, "_", rv_version_name()))
kCsmDOutputFilenames <<- sapply(kCsmDOutputFilenames, function(x) paste0(x, "_", rv_version_name()))
kCsmEOutputFilenames <<- sapply(kCsmEOutputFilenames, function(x) paste0(x, "_", rv_version_name()))
showNotification("Version name added to output names.", type = "message")
new_folder_path <- paste0(rv_folder_path_without_ver_name(), paste0("_", rv_version_name()))
log_close()
rv_old_log_data(read.table(rv_log_open(), sep = "\n"))
file.rename(output_file_path(), new_folder_path)
output_file_path(new_folder_path)
assign("parent_folder_of_previous_log_file", output_file_path(), envir = .GlobalEnv)
run_info(paste("Selected run folder:", ReplacePathsForEnvironment(file.path(output_file_path()), to_pdrive = TRUE)))
output$message_text <- renderText({
paste("Selected folder to save outputs:", ReplacePathsForEnvironment(file.path(output_file_path()), to_pdrive = TRUE))
})
}}
})
observe({
config_file_selected <- !is.null(rv_chosen_config_file()) && length(rv_chosen_config_file()[["datapath"]]) > 0
output_folder_selected <- !is.null(choosen_dir()) && length(choosen_dir()) > 0
if (config_file_selected && output_folder_selected) {
shinyjs::enable("in_CodeRunButton")
output[["hover_message"]] <- renderText("Press the run button to execute.")
} else {
shinyjs::disable("in_CodeRunButton")
output[["hover_message"]] <- renderText("Ensure the configuration file and output folder are selected to enable the run button")
}
})
# Main code run--------------
# Run the wrapper and display the output
observeEvent(
input$in_CodeRunButton,{
selected_config_file <- rv_chosen_config_file()$datapath
output_file_path <- output_file_path()
if(is.null(selected_config_file) || selected_config_file == "" || is.na(selected_config_file)) {
output$message_text <- renderText("Please choose a configuration file before running the tool.")
showNotification("Please choose a configuration file before running the tool.", type = "error")
}
else if (length(output_file_path) == 0 || is.null(output_file_path) || !dir.exists(output_file_path)) {
output$message_text <- renderText("Choose output folder before clicking the run button.")
showNotification("Choose output folder before clicking the run button.", type = "warning")
}
else {
sep("CSM Tool - main code run")
#copy configuration file to output folder
if (file.exists(selected_config_file) && !dir.exists(selected_config_file)) {
file.copy(
selected_config_file,
file.path(output_file_path(), basename(selected_config_file))
)
# Source the wrapper script
csm_tool_run <- CsmTool(output_file_path(),selected_config_file)
rv_run_completion_flag(1)
checks_info(csm_tool_run[["tools_checks_list"]])
output$message_text <- renderText(csm_tool_run[["message"]])
}
}
}) # observeEvent
## ________________ -----------------------------------------------------------------------
## RETURN ---------------------------------------------------------------------------------
return(
list(
run_info = run_info,
checks_info = checks_info
)
) # return
} # function
) # moduleServer
} # module_tab_inputs_server
} # SERVER close