Add workflow stepper

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;
+  }
+}

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

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"

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) {
+      "&#10004;"
+    } else if (is_active) {
+      "&#9658;"
+    } else {
+      "&#9675;"
+    }
+
+    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("&middot;"))
+      )
+    } 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)
+  )
+}