diff --git a/WWW/stepper.css b/WWW/stepper.css new file mode 100644 index 0000000..f8f9c58 --- /dev/null +++ b/WWW/stepper.css @@ -0,0 +1,130 @@ +/* Workflow stepper */ + +.workflow-stepper { + padding: 10px 24px 8px; + margin: 0; + background: #ffffff; + border-bottom: 1px solid #e8e8e8; +} + +.workflow-stepper.stepper-hidden { + display: none; +} + +.stepper-header { + display: flex; + justify-content: space-between; + align-items: baseline; + gap: 12px; + margin-bottom: 8px; +} + +.stepper-section-name { + font-size: 13px; + font-weight: 600; + color: #083b3f; + letter-spacing: 0.2px; +} + +.stepper-step-count { + font-size: 11px; + font-weight: 500; + color: #999; +} + +.stepper-items { + display: flex; + align-items: center; + flex-wrap: wrap; + gap: 4px 0; +} + +.stepper-item { + display: inline-flex; + align-items: center; + cursor: pointer; + padding: 3px 8px; + border-radius: 4px; + transition: background 0.2s ease; + font-size: 12.5px; + white-space: nowrap; +} + +.stepper-item:hover { + background: #f0f7f0; +} + +.stepper-item.active { + cursor: default; +} + +.stepper-item.active:hover { + background: #eef8ee; +} + +.stepper-sep { + color: #d0d0d0; + font-size: 10px; + margin: 0 2px; + user-select: none; +} + +.stepper-item.completed { + color: #00bfc4; + font-weight: 500; +} + +.stepper-item.completed .stepper-icon { + color: #00bfc4; + margin-right: 4px; + font-size: 12px; +} + +.stepper-item.active { + color: #083b3f; + font-weight: 700; + background: #eef8ee; + border: 1px solid #7bc148; +} + +.stepper-item.active .stepper-icon { + color: #7bc148; + margin-right: 4px; + font-size: 12px; +} + +.stepper-item.completed.active { + color: #083b3f; + background: #eef8ee; + border: 1px solid #7bc148; +} + +.stepper-item.completed.active .stepper-icon { + color: #00bfc4; +} + +.stepper-item.inactive { + color: #aaa; + font-weight: 400; +} + +.stepper-item.inactive .stepper-icon { + color: #ccc; + margin-right: 4px; + font-size: 10px; +} + +@media (max-width: 768px) { + .stepper-items { + gap: 2px 0; + } + + .stepper-item { + font-size: 11px; + padding: 2px 5px; + } + + .stepper-section-name { + font-size: 12px; + } +} diff --git a/server.R b/server.R index a5afd03..c309487 100644 --- a/server.R +++ b/server.R @@ -291,17 +291,30 @@ function(input, output, session){ - # ---- (B) Datasets with pre-trained models (historical) ---- - .get_models_index_csv <- function() file.path(getwd(), app_username, "logs", "models", "index.csv") - dataset_has_history <- reactive({ - idx <- .get_models_index_csv() - if (!file.exists(idx)) return(FALSE) - df <- tryCatch(read.csv(idx, stringsAsFactors = FALSE), error = function(e) NULL) - if (is.null(df) || !"dataset_id" %in% names(df)) return(FALSE) - ds <- rv_ml_ai$dataset_id %||% rv_current$dataset_id - if (is.null(ds) || !nzchar(ds)) return(FALSE) - any(df$dataset_id == ds & (df$framework %in% c("PyCaret","pycaret","Pycaret"))) - }) + # ---- (B) Datasets with pre-trained models (historical) ---- + .get_models_index_csv <- function() file.path(getwd(), app_username, "logs", "models", "index.csv") + dataset_has_history <- reactive({ + ds <- rv_ml_ai$dataset_id %||% rv_current$dataset_id + if (is.null(ds) || !nzchar(ds)) return(FALSE) + + pycaret_history <- tryCatch({ + idx <- .get_models_index_csv() + if (!file.exists(idx)) return(FALSE) + df <- read.csv(idx, stringsAsFactors = FALSE) + if (is.null(df) || !"dataset_id" %in% names(df) || !"framework" %in% names(df)) return(FALSE) + any(df$dataset_id == ds & tolower(df$framework) == "pycaret") + }, error = function(e) FALSE) + + caret_history <- tryCatch({ + log_path <- paste0(app_username, "/.log_files") + if (!isTRUE(Rautoml::check_logs(path = log_path, pattern = "-trained.model.main.log"))) return(FALSE) + df <- Rautoml::collect_logs(path = log_path, pattern = "-trained.model.main.log") + if (is.null(df) || !"dataset_id" %in% names(df)) return(FALSE) + any(df$dataset_id == ds) + }, error = function(e) FALSE) + + isTRUE(pycaret_history) || isTRUE(caret_history) + }) # Expose known datasets for the Deploy module (used in its selector) observe({ @@ -345,13 +358,71 @@ function(input, output, session){ ###-------App Footer-------------------------- - footer_language_translation() - ###-------Menu Translate--------- - - menu_translation() - - #### ---- Change language ---------------------------------------------------- - output$change_language = change_language + footer_language_translation() + ###-------Menu Translate--------- + + menu_translation() + + .workflow_completed_steps <- reactive({ + has_dataset <- is.character(rv_current$dataset_id) && nzchar(rv_current$dataset_id) + has_explore <- !is.null(rv_current$data_summary_str) || + !is.null(rv_current$data_summary_skim) || + !is.null(rv_current$data_summary_summary) || + !is.null(rv_current$data_summary_summarytools) || + !is.null(rv_current$quick_explore_summary) || + !is.null(rv_current$missing_prop) + has_transform <- !is.null(rv_current$changed_variable_type_log) || + !is.null(rv_current$renamed_variable_log) || + !is.null(rv_current$recoded_variable_labels_log) || + !is.null(rv_current$created_missing_values_log) || + !is.null(rv_current$handle_missing_values_log) || + !is.null(rv_current$handle_outlier_values_log) || + !is.null(rv_current$combine_df) + has_visualize <- !is.null(plots_sec_rv$plot_rv) || + !is.null(plots_sec_rv$plot_bivariate_auto) || + !is.null(plots_sec_rv$plot_corr) + has_setup <- is.character(rv_ml_ai$dataset_id) && + nzchar(rv_ml_ai$dataset_id %||% "") && + is.character(rv_ml_ai$analysis_type) && + nzchar(rv_ml_ai$analysis_type %||% "") && + is.character(rv_ml_ai$task) && + nzchar(rv_ml_ai$task %||% "") + has_train_live_caret <- !is.null(rv_training_results$models) && + length(rv_training_results$models) > 0 && + is.character(rv_ml_ai$dataset_id) && + nzchar(rv_ml_ai$dataset_id %||% "") && + identical(rv_ml_ai$dataset_id, rv_current$dataset_id) + has_train <- isTRUE(.can_show_by_train()) || + isTRUE(dataset_has_history()) || + isTRUE(has_train_live_caret) + has_deploy <- !is.null(rv_deploy_models$deployed_models_table) && + NROW(rv_deploy_models$deployed_models_table) > 0 + + completed <- integer() + if (has_dataset) completed <- c(completed, 1L) + if (has_explore) completed <- c(completed, 2L) + if (has_transform) completed <- c(completed, 3L) + if (has_visualize) completed <- c(completed, 4L) + if (has_setup) completed <- c(completed, 5L) + if (has_train) completed <- c(completed, 6L) + if (has_deploy) completed <- c(completed, 7L) + completed + }) + + output$workflow_stepper_bar <- renderUI({ + active_step <- get_step_for_tab(input$tabs) + render_stepper_html( + active_step = active_step, + completed_steps = .workflow_completed_steps() + ) + }) + + observeEvent(input$stepper_nav, { + shinydashboard::updateTabItems(session, "tabs", selected = input$stepper_nav) + }, ignoreInit = TRUE) + + #### ---- Change language ---------------------------------------------------- + output$change_language = change_language source("server/change_language_update.R", local = TRUE) change_language_update() diff --git a/ui/dashboard_body.R b/ui/dashboard_body.R index 3ea21be..0a941d6 100644 --- a/ui/dashboard_body.R +++ b/ui/dashboard_body.R @@ -1,4 +1,5 @@ ## Load UI files +source("ui/stepper_ui.R", local=TRUE) source("ui/sourcedata_ui.R", local=TRUE) source("ui/overview_ui.R", local=TRUE) source("ui/explore_ui.R", local=TRUE) @@ -77,6 +78,8 @@ aphrcBody <- dashboardBody( }); ")) ), + tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "stepper.css")), + stepper_ui(), tabItems( tabItem(tabName = "homePage" diff --git a/ui/stepper_ui.R b/ui/stepper_ui.R new file mode 100644 index 0000000..4c1ef69 --- /dev/null +++ b/ui/stepper_ui.R @@ -0,0 +1,102 @@ +# Workflow stepper helpers. + +workflow_steps <- list( + list(num = 1, key = "upload", label = "Upload", section = "Data Upload", tabs = c("sourcedata")), + list(num = 2, key = "explore", label = "Explore", section = "Data Exploration", tabs = c("Overview", "Explore")), + list(num = 3, key = "transform", label = "Transform", section = "Data Transformation", tabs = c("Transform", "combineData")), + list(num = 4, key = "visualize", label = "Visualize", section = "Visualization", tabs = c("summarizeAutomatic", "summarizeCustom")), + list(num = 5, key = "setup", label = "Model Setup", section = "Machine Learning / Model Setup", tabs = c("setupModels", "featureEngineering")), + list(num = 6, key = "train", label = "Train", section = "Model Training", tabs = c("trainModel")), + list(num = 7, key = "deploy", label = "Deploy", section = "Validate & Deploy", tabs = c("validateDeployModel", "predictClassify")) +) + +non_workflow_tabs <- c( + "homePage", "homepage", "researchQuestions", "deeplearning", "cnndeep", + "evidenceQuality", "achilles", "omop_visualizations", + "CohortConstructor", "FeatureExtraction", "addResources", + "anonymization_quant", "anonymization_qual" +) + +get_step_for_tab <- function(tab_name) { + if (is.null(tab_name) || tab_name %in% non_workflow_tabs) return(0L) + + for (step in workflow_steps) { + if (tab_name %in% step$tabs) return(step$num) + } + + 0L +} + +stepper_ui <- function() { + tags$div( + id = "workflow-stepper-container", + uiOutput("workflow_stepper_bar") + ) +} + +render_stepper_html <- function(active_step, completed_steps = integer()) { + if (active_step == 0L) { + return(tags$div(class = "workflow-stepper stepper-hidden")) + } + + total_steps <- length(workflow_steps) + current_section <- workflow_steps[[active_step]]$section + completed_steps <- unique(as.integer(completed_steps)) + completed_steps <- completed_steps[!is.na(completed_steps) & completed_steps > 0L] + + step_elements <- lapply(seq_along(workflow_steps), function(i) { + step <- workflow_steps[[i]] + + is_active <- identical(i, active_step) + is_completed <- i %in% completed_steps + state_classes <- c( + "stepper-item", + if (is_completed) "completed" else "inactive", + if (is_active) "active" + ) + classes <- paste(state_classes, collapse = " ") + + icon <- if (is_completed) { + "✔" + } else if (is_active) { + "►" + } else { + "○" + } + + attrs <- list( + class = classes, + `data-step` = step$key, + tags$span(class = "stepper-icon", HTML(icon)), + step$label + ) + + if (!is_active) { + attrs$onclick <- sprintf( + "Shiny.setInputValue('stepper_nav','%s',{priority:'event'});", + step$tabs[1] + ) + } + + item <- do.call(tags$span, attrs) + + if (i < total_steps) { + tagList( + item, + tags$span(class = "stepper-sep", HTML("·")) + ) + } else { + item + } + }) + + tags$div( + class = "workflow-stepper", + tags$div( + class = "stepper-header", + tags$span(class = "stepper-section-name", current_section), + tags$span(class = "stepper-step-count", paste0("Step ", active_step, " of ", total_steps)) + ), + tags$div(class = "stepper-items", step_elements) + ) +}