diff --git a/.gitignore b/.gitignore
index e98e26d..7cf3dbd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,6 @@
.DS_Store
+users_db/users.sqlite
+.env
# History files
.Rhistory
.Rapp.history
diff --git a/WWW/styles.css b/WWW/styles.css
index 1c0ad09..17cc007 100644
--- a/WWW/styles.css
+++ b/WWW/styles.css
@@ -1,181 +1,195 @@
/* Media query for tablets */
@media (min-width: 577px) and (max-width: 992px) {
- .roundbuttons {
- width: 50%; /* Adjust the width for tablets */
- }
+ .roundbuttons {
+ width: 50%;
+ /* Adjust the width for tablets */
+ }
}
input[type="radio"] {
width: 12px;
height: 12px;
- accent-color: #17a2b8;
- border: 1px solid #7bc148; /* Green border */
+ accent-color: #17a2b8;
+ border: 1px solid #7bc148;
+ /* Green border */
cursor: pointer;
}
-.box.box-success > .box-header {
- background-color: #bde0a3 !important; /* lighter green header */
- }
+.box.box-success>.box-header {
+ background-color: #bde0a3 !important;
+ /* lighter green header */
+}
.footer {
- background-color: #7bc148;
- color: white;
- padding: 0px;
- text-align: center;
- }
-
- .socialform {
- text-align: center;
- padding: 10px;
- }
- .footer a {
- margin: 0px;
- color: white;
- }
- .footer a:hover {
- color: #337ab7;
- }
-
- hr {
- width: 100%; /* Adjust the percentage to control the length */
- }
-
-
- .header {
- background: white;
- color: #7bc148;
- padding: 10px;
- display: flex;
- align-items: center;
- text-align:center;
- }
-
- hr {
- width: 100%; /* Adjust the percentage to control the length */
- }
-
- .logo {
- flex-shrink: 0;
- margin-right: 20px;
- max-height: 80%;
- max-width: 80%;
- }
-
- .header-text h1 {
- font-size: 30px;
- font-weight: bold;
- text-align:center;
- }
-
- .header-text h3 {
- font-size: 20px;
-
- }
-
-
- /* navbar (rest of the header) */
- .skin-blue .main-header .navbar {
- background-color:green;
+ background-color: #7bc148;
+ color: white;
+ padding: 0px;
+ text-align: center;
+}
- }
+.socialform {
+ text-align: center;
+ padding: 10px;
+}
+
+.footer a {
+ margin: 0px;
+ color: white;
+}
+
+.footer a:hover {
+ color: #337ab7;
+}
+
+hr {
+ width: 100%;
+ /* Adjust the percentage to control the length */
+}
+
+
+.header {
+ background: white;
+ color: #7bc148;
+ padding: 10px;
+ display: flex;
+ align-items: center;
+ text-align: center;
+}
+
+hr {
+ width: 100%;
+ /* Adjust the percentage to control the length */
+}
- /* main sidebar */
- .skin-blue .main-sidebar {
+.logo {
+ flex-shrink: 0;
+ margin-right: 20px;
+ max-height: 80%;
+ max-width: 80%;
+}
+
+.header-text h1 {
+ font-size: 30px;
+ font-weight: bold;
+ text-align: center;
+}
+
+.header-text h3 {
+ font-size: 20px;
+
+}
+
+
+/* navbar (rest of the header) */
+.skin-blue .main-header .navbar {
+ background-color: green;
+
+}
+
+/* main sidebar */
+.skin-blue .main-sidebar {
background-color: #7BC148;
- }
- /* active selected tab in the sidebarmenu */
- .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
- background-color:#7BC148;
- }
+}
+
+/* active selected tab in the sidebarmenu */
+.skin-blue .main-sidebar .sidebar .sidebar-menu .active a {
+ background-color: #7BC148;
+}
- /* other links in the sidebarmenu */
- .skin-blue .main-sidebar .sidebar .sidebar-menu a{
+/* other links in the sidebarmenu */
+.skin-blue .main-sidebar .sidebar .sidebar-menu a {
background-color: #7BC148;
border-color: #7BC148;
color: #ffffff;
- }
+}
- /* other links in the sidebarmenu when hovered */
- .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
+/* other links in the sidebarmenu when hovered */
+.skin-blue .main-sidebar .sidebar .sidebar-menu a:hover {
background-color: #2c3b41;
- }
- /* toggle button when hovered */
- .skin-blue .main-header .navbar .sidebar-toggle:hover{
+}
+
+/* toggle button when hovered */
+.skin-blue .main-header .navbar .sidebar-toggle:hover {
background-color: #D37D28;
- }
- /* toggle button when hovered */
- .skin-blue .main-header .navbar .sidebar-toggle{
- margin:1em;
- }
+}
- /* body */
- .content-wrapper, .right-side {
+/* toggle button when hovered */
+.skin-blue .main-header .navbar .sidebar-toggle {
+ margin: 1em;
+}
+
+/* body */
+.content-wrapper,
+.right-side {
background-color: #ffffff;
padding-left: 1.5em;
- }
-
-
- /*Tables*/
-
-.dataTables_wrapper , .dataTables_wrapper .dataTables_wrapper .dataTables_info, .dataTables_wrapper .dataTables_processing, .dataTables_wrapper{
- color:#000000;
- background-color:#ffffff;
- }
-
- thead {
- color: #ffffff;
- font-size:1.2em;
- background-color:#17a2b8;
- }
-
- tbody {
- color: #000000;
- font-size:1.2em;
- }
-
-#upload_form{
+}
+
+
+/*Tables*/
+
+.dataTables_wrapper,
+.dataTables_wrapper .dataTables_wrapper .dataTables_info,
+.dataTables_wrapper .dataTables_processing,
+.dataTables_wrapper {
+ color: #000000;
+ background-color: #ffffff;
+}
+
+thead {
+ color: #ffffff;
+ font-size: 1.2em;
+ background-color: #17a2b8;
+}
+
+tbody {
+ color: #000000;
+ font-size: 1.2em;
+}
+
+#upload_form {
padding-left: 1.2em;
justify-content: left;
align-items: left;
}
-#OverViewMenu{
- height:90vh;
+#OverViewMenu {
+ height: 90vh;
overflow-y: auto;
}
table {
- background-color: white;
- color: black;
- border: 1px solid #ddd;
+ background-color: white;
+ color: black;
+ border: 1px solid #ddd;
}
th {
- background-color: #17a2b8;
- color: white;
+ background-color: #17a2b8;
+ color: white;
}
td {
- background-color: #ffffff;
- color: black;
+ background-color: #ffffff;
+ color: black;
}
.shiny-input-checkbox input[type='checkbox'] {
- background-color: #4CAF50;
- }
-
+ background-color: #4CAF50;
+}
+
- .bootstrap-switch{
+.bootstrap-switch {
background-color: #4CAF50 !important;
}
#primaryTabs {
- color: #7bc148;
- width: 100%;
+ color: #7bc148;
+ width: 100%;
}
@@ -183,9 +197,9 @@ td {
max-width: 400px;
margin: 6% auto;
padding: 30px 25px;
- border-color:#7bc148;
+ border-color: #7bc148;
border-radius: 15px;
- border-width:2px;
+ border-width: 2px;
background-color: #fff;
box-shadow: 0 0 25px rgba(0, 0, 0, 0.1);
}
@@ -222,88 +236,99 @@ td {
#logoutBtn:hover {
- background-color: #c82333;
- }
+ background-color: #c82333;
+}
#loading_screen {
- position: fixed;
- top: 0; left: 0;
- width: 100%; height: 100%;
- background-color: #ffffff;
- z-index: 9999;
- display: flex;
- justify-content: center;
- align-items: center;
- font-size: 40px;
- color: #7bc148;
- }
-
-
+ position: fixed;
+ top: 0;
+ left: 0;
+ width: 100%;
+ height: 100%;
+ background-color: #ffffff;
+ z-index: 9999;
+ display: flex;
+ justify-content: center;
+ align-items: center;
+ font-size: 40px;
+ color: #7bc148;
+}
+
+
#loader svg circle {
- stroke-width: 20px !important; /* increase this for a thicker ring */
- }
+ stroke-width: 20px !important;
+ /* increase this for a thicker ring */
+}
- /* APHRC palette */
-:root{
+/* APHRC palette */
+:root {
--aphrc-green: #7BC148;
- --aphrc-cyan: #00BFC4;
- --aphrc-text: #333333;
- --aphrc-bg: #FFFFFF;
+ --aphrc-cyan: #00BFC4;
+ --aphrc-text: #333333;
+ --aphrc-bg: #FFFFFF;
}
+
/* Row container with shadow + border */
.aphrc-row {
background: var(--aphrc-bg);
border: 2px solid var(--aphrc-green);
border-radius: 14px;
- box-shadow: 0 10px 24px rgba(0,0,0,0.10);
- padding: 14px 16px; /* space around row contents */
- margin: 16px auto; /* vertical rhythm */
+ box-shadow: 0 10px 24px rgba(0, 0, 0, 0.10);
+ padding: 14px 16px;
+ /* space around row contents */
+ margin: 16px auto;
+ /* vertical rhythm */
}
+
/* Optional subtle hover lift */
-.aphrc-row:hover{
- box-shadow: 0 14px 28px rgba(0,0,0,0.12);
+.aphrc-row:hover {
+ box-shadow: 0 14px 28px rgba(0, 0, 0, 0.12);
transform: translateY(-1px);
transition: all .18s ease-in-out;
}
-.aphrc-row:hover{
- box-shadow: 0 14px 28px rgba(0,0,0,0.12);
+.aphrc-row:hover {
+ box-shadow: 0 14px 28px rgba(0, 0, 0, 0.12);
transform: translateY(-1px);
transition: all .18s ease-in-out;
}
-#upload_form{
+#upload_form {
padding-left: 1.2em;
justify-content: left;
align-items: left;
background: var(--aphrc-bg);
border: 2px solid var(--aphrc-green);
border-radius: 14px;
- box-shadow: 0 10px 24px rgba(0,0,0,0.10);
- padding: 14px 16px; /* space around row contents */
- margin: 16px auto; /* vertical rhythm */
+ box-shadow: 0 10px 24px rgba(0, 0, 0, 0.10);
+ padding: 14px 16px;
+ /* space around row contents */
+ margin: 16px auto;
+ /* vertical rhythm */
}
-.upload_form:hover{
- box-shadow: 0 14px 28px rgba(0,0,0,0.12);
+.upload_form:hover {
+ box-shadow: 0 14px 28px rgba(0, 0, 0, 0.12);
transform: translateY(-1px);
transition: all .18s ease-in-out;
}
-#aphrc-row1:hover{
- box-shadow: 0 14px 28px rgba(0,0,0,0.12);
+#aphrc-row1:hover {
+ box-shadow: 0 14px 28px rgba(0, 0, 0, 0.12);
transform: translateY(-1px);
transition: all .18s ease-in-out;
}
-#aphrc-row1:hover{
- box-shadow: 0 14px 28px rgba(0,0,0,0.12);
+#aphrc-row1:hover {
+ box-shadow: 0 14px 28px rgba(0, 0, 0, 0.12);
transform: translateY(-1px);
transition: all .18s ease-in-out;
}
-
+.top-progress .progress-bar {
+ background-color: #7bc148 !important;
+}
\ No newline at end of file
diff --git a/server/auth.R b/server/auth.R
index f3bd0cf..76b3d92 100644
--- a/server/auth.R
+++ b/server/auth.R
@@ -1,11 +1,13 @@
user_auth <- function(input, output, session) {
# guard: run once per session
- if (isTRUE(session$userData$user_auth_initialized)) return(invisible(NULL))
+ if (isTRUE(session$userData$user_auth_initialized)) {
+ return(invisible(NULL))
+ }
session$userData$user_auth_initialized <- TRUE
-
+
USER <- login::login_server(
id = app_login_config$APP_ID,
- db_conn = DBI::dbConnect(RSQLite::SQLite(), 'users.sqlite'),
+ db_conn = DBI::dbConnect(RSQLite::SQLite(), "users.sqlite"),
emailer = login::emayili_emailer(
email_host = app_login_config$email_host,
email_port = app_login_config$email_port,
@@ -13,43 +15,65 @@ user_auth <- function(input, output, session) {
email_password = app_login_config$email_password,
from_email = app_login_config$from_email
),
- additional_fields = c('first_name' = 'First Name',
- 'last_name' = 'Last Name'),
+ additional_fields = c(
+ "first_name" = "First Name",
+ "last_name" = "Last Name"
+ ),
cookie_name = "aphrc",
cookie_password = "aphrcpass1"
)
-
+
output$userName <- renderText({
paste0(USER$first_name, " ", USER$last_name)
})
- observeEvent(input$logoutID, {
- shinyjs::runjs("document.cookie = 'aphrc=; expires=Thu, 01 Jan 1970 00:00:00 UTC; path=/;'")
- session$reload()
- }, ignoreInit = TRUE)
+ observeEvent(input$logoutID,
+ {
+ shinyjs::runjs("document.cookie = 'aphrc=; expires=Thu, 01 Jan 1970 00:00:00 UTC; path=/;'")
+ session$reload()
+ },
+ ignoreInit = TRUE
+ )
- observeEvent(input$show_login, {
- shinyjs::show("login_form", anim = TRUE, animType = "fade", time = 0.4)
- shinyjs::hide("signup_form"); shinyjs::hide("reset_form")
- output$form_title <- renderText("APHRC Nocode Platform")
- }, ignoreInit = TRUE)
+ observeEvent(input$show_login,
+ {
+ shinyjs::show("login_form", anim = TRUE, animType = "fade", time = 0.4)
+ shinyjs::hide("signup_form")
+ shinyjs::hide("reset_form")
+ output$form_title <- renderText("APHRC Nocode Platform")
+ },
+ ignoreInit = TRUE
+ )
- observeEvent(input$show_signup, {
- shinyjs::show("signup_form", anim = TRUE, animType = "fade", time = 0.4)
- shinyjs::hide("login_form"); shinyjs::hide("reset_form")
- output$form_title <- renderText("Create an Account")
- }, ignoreInit = TRUE)
+ observeEvent(input$show_signup,
+ {
+ shinyjs::show("signup_form", anim = TRUE, animType = "fade", time = 0.4)
+ shinyjs::hide("login_form")
+ shinyjs::hide("reset_form")
+ output$form_title <- renderText("Create an Account")
+ },
+ ignoreInit = TRUE
+ )
- observeEvent(input$show_reset, {
- shinyjs::show("reset_form", anim = TRUE, animType = "fade", time = 0.4)
- shinyjs::hide("login_form"); shinyjs::hide("signup_form")
- output$form_title <- renderText("Reset Password")
- }, ignoreInit = TRUE)
+ observeEvent(input$show_reset,
+ {
+ shinyjs::show("reset_form", anim = TRUE, animType = "fade", time = 0.4)
+ shinyjs::hide("login_form")
+ shinyjs::hide("signup_form")
+ output$form_title <- renderText("Reset Password")
+ },
+ ignoreInit = TRUE
+ )
# Optionally show login form on first load:
- observeEvent(TRUE, {
- shinyjs::show("login_form", anim = TRUE, animType = "fade", time = 0.4)
- shinyjs::hide("signup_form"); shinyjs::hide("reset_form")
- output$form_title <- renderText("APHRC Nocode Platform")
- }, once = TRUE, ignoreInit = TRUE)
+ observeEvent(TRUE,
+ {
+ shinyjs::show("login_form", anim = TRUE, animType = "fade", time = 0.4)
+ shinyjs::hide("signup_form")
+ shinyjs::hide("reset_form")
+ output$form_title <- renderText("APHRC Nocode Platform")
+ },
+ once = TRUE,
+ ignoreInit = TRUE
+ )
}
diff --git a/server/deep_learning.R b/server/deep_learning.R
index a52fde4..da62c5a 100644
--- a/server/deep_learning.R
+++ b/server/deep_learning.R
@@ -6,43 +6,47 @@ library(jsonlite)
library(DT)
library(dplyr)
library(shinyjs)
-library(tidyr)
+library(tidyr)
library(dygraphs)
-# Increase max file upload size (e.g., to 2GB)
-options(shiny.maxRequestSize = 2000*1024^2)
+# Increase max file upload size (e.g., to 10GB)
+options(shiny.maxRequestSize = 10000 * 1024^2)
+
+deep_learning <- function() {
+ # Use environment variable for API URL, default to localhost for dev
+ api_url <- Sys.getenv("DL_API_URL", "http://localhost:8000")
+ api_key <- Sys.getenv("DL_API_KEY", "aphrc-secret-key-123")
-deep_learning = function() {
-
- api_url <- "http://23.135.236.5:3186"
-
# ==============================================================================
# == 1. CORE REACTIVE VALUES
# ==============================================================================
-
+
# --- For Live Job Polling ---
polled_data <- reactiveVal(list(
status = "Idle", task = "N/A", log = "", progress = list(percentage = 0, text = "Idle")
))
polled_metrics <- reactiveVal(NULL)
active_job_id <- reactiveVal(NULL)
-
+
+ # --- For System Health ---
+ health_data <- reactiveVal(NULL)
+
# --- For Data Management ---
data_upload_status <- reactiveVal("")
processing_dataset_id <- reactiveVal(NULL)
refresh_data_trigger <- reactiveVal(0) # Triggers reload of dataset lists
-
+
# --- For Model Registry ---
model_registry <- reactiveVal(NULL)
-
+
# --- For History Tab ---
history_metrics <- reactiveVal(NULL)
history_jobs_df <- reactiveVal(NULL)
history_poller_active <- reactiveVal(FALSE)
+ historical_log_text <- reactiveVal("")
# --- For Inference Tab ---
obj_inference_result <- reactiveVal(list(status = "Ready", image_url = NULL, error = NULL))
- asr_inference_result <- reactiveVal(list(status = "Ready", transcription = NULL, error = NULL))
img_class_inference_result <- reactiveVal(list(status = "Ready", prediction = NULL, error = NULL))
seg_inference_result <- reactiveVal(list(status = "Ready", image_url = NULL, error = NULL))
@@ -50,22 +54,32 @@ deep_learning = function() {
proxy_eval_table <- dataTableProxy("eval_table")
proxy_dataset_table <- dataTableProxy("dataset_table")
proxy_history_eval_table <- dataTableProxy("history_eval_table")
-
-
+
+
# ==============================================================================
# == 2. INITIALIZATION & SIDEBAR LOGIC
# ==============================================================================
-
+
# --- Fetch Model Registry on Startup ---
observe({
- tryCatch({
- req <- request(paste0(api_url, "/models/list"))
- resp <- req_perform(req)
- model_registry(resp_body_json(resp))
- }, error = function(e) {
- print(paste("Failed to fetch model registry:", e$message))
- # TODO: Show a fatal error modal to the user
- })
+ # Only fetch if we are actually looking at the deep learning tab
+ req(input$tabs == "cnndeep")
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/models/list"))
+ resp <- req_perform(req)
+ model_registry(resp_body_json(resp))
+ },
+ error = function(e) {
+ # print(paste("Failed to fetch model registry:", e$message))
+ shinyalert::shinyalert(
+ title = "Deep Learning Service Unavailable",
+ text = paste("Could not connect to the Deep Learning API at", api_url, "\nError:", e$message),
+ type = "warning"
+ )
+ }
+ )
})
# --- Task Panel Switching ---
@@ -73,29 +87,30 @@ deep_learning = function() {
observe({
task <- input$task_selector
if (task == "object_detection") {
- shinyjs::show("obj_panel"); shinyjs::hide("asr_panel"); shinyjs::hide("img_class_panel"); shinyjs::hide("seg_panel")
- } else if (task == "asr") {
- shinyjs::hide("obj_panel"); shinyjs::show("asr_panel"); shinyjs::hide("img_class_panel"); shinyjs::hide("seg_panel")
+ shinyjs::show("obj_panel")
+ shinyjs::hide("img_class_panel")
+ shinyjs::hide("seg_panel")
} else if (task == "image_classification") {
- shinyjs::hide("obj_panel"); shinyjs::hide("asr_panel"); shinyjs::show("img_class_panel"); shinyjs::hide("seg_panel")
- } else if (task == "image_segmentation") {
- shinyjs::hide("obj_panel"); shinyjs::hide("asr_panel"); shinyjs::hide("img_class_panel"); shinyjs::show("seg_panel")
+ shinyjs::hide("obj_panel")
+ shinyjs::show("img_class_panel")
+ shinyjs::hide("seg_panel")
+ } else if (task == "semantic_segmentation") {
+ shinyjs::hide("obj_panel")
+ shinyjs::hide("img_class_panel")
+ shinyjs::show("seg_panel")
}
})
-
+
# --- Chained Dropdown Logic (Populate Architectures) ---
observeEvent(c(model_registry(), input$task_selector), {
req(model_registry())
-
+
task_slug <- input$task_selector
arch_choices <- c("Loading..." = "")
-
+
if (task_slug == "object_detection") {
arch_choices <- names(model_registry()$object_detection)
updateSelectInput(session, "obj_model_arch", choices = arch_choices)
- } else if (task_slug == "asr") {
- arch_choices <- names(model_registry()$asr)
- updateSelectInput(session, "asr_model_arch", choices = arch_choices)
} else if (task_slug == "image_classification") {
arch_choices <- names(model_registry()$image_classification)
updateSelectInput(session, "img_class_model_arch", choices = arch_choices)
@@ -104,18 +119,13 @@ deep_learning = function() {
updateSelectInput(session, "seg_model_arch", choices = arch_choices)
}
})
-
+
# --- Chained Dropdown Logic (Populate Checkpoints) ---
observeEvent(input$obj_model_arch, {
req(model_registry(), input$obj_model_arch, input$obj_model_arch != "Loading...")
checkpoints <- model_registry()$object_detection[[input$obj_model_arch]]
updateSelectInput(session, "obj_model_checkpoint", choices = checkpoints)
})
- observeEvent(input$asr_model_arch, {
- req(model_registry(), input$asr_model_arch, input$asr_model_arch != "Loading...")
- checkpoints <- model_registry()$asr[[input$asr_model_arch]]
- updateSelectInput(session, "asr_model_checkpoint", choices = checkpoints)
- })
observeEvent(input$img_class_model_arch, {
req(model_registry(), input$img_class_model_arch, input$img_class_model_arch != "Loading...")
checkpoints <- model_registry()$image_classification[[input$img_class_model_arch]]
@@ -127,139 +137,306 @@ deep_learning = function() {
updateSelectInput(session, "seg_model_checkpoint", choices = checkpoints)
})
-
+
+ # --- Auto-Resume Active Job Logic ---
+ # Trigger ONLY once when the module loads to check for existing running jobs
+ observe({
+ # observeEvent(input$obj_model_checkpoint) logic removed to prevent conflict with ui/deeplearning_ui.R
+ # Only run if we don't have an active job yet
+ if (is.null(active_job_id())) {
+ tryCatch(
+ {
+ # Fetch list of ALL running jobs
+ req <- request(paste0(api_url, "/jobs/list")) %>%
+ req_url_query(status = "running")
+ resp <- req_perform(req)
+ running_jobs <- resp_body_json(resp, simplifyVector = TRUE)
+
+ # Check if we got a valid data frame with rows
+ if (!is.null(running_jobs) && is.data.frame(running_jobs) && nrow(running_jobs) > 0) {
+ # Pick the most recent one (assuming higher ID or just first one)
+ # The API returns them in default order (usually creation time)
+ # We'll take the first one for now.
+ resumed_job_id <- running_jobs$id[1]
+ resumed_task_type <- running_jobs$task_type[1]
+
+ print(paste("Auto-resuming job:", resumed_job_id))
+
+ # Set as active
+ active_job_id(resumed_job_id)
+
+ # Switch UI tab to Live Training? (Optional, might annoy user if they just want to browse)
+ # For now, just notifying via alert
+ shinyalert::shinyalert(
+ title = "Job Resumed",
+ text = paste("Detected running job:", resumed_job_id, "\nResuming live monitoring."),
+ type = "info",
+ timer = 3000
+ )
+ }
+ },
+ error = function(e) {
+ # Silent fail on auto-resume check
+ print(paste("Auto-resume check failed:", e$message))
+ }
+ )
+ }
+ })
# ==============================================================================
# == 3. "DATA MANAGEMENT" TAB LOGIC
# ==============================================================================
# --- Helper: Load Datasets for a specific task ---
load_datasets_for_task <- function(task_slug) {
- tryCatch({
- req <- request(paste0(api_url, "/data/list/", task_slug))
- resp_data <- resp_body_json(req_perform(req), simplifyVector = TRUE)
- if (length(resp_data) > 0 && nrow(resp_data) > 0) {
- setNames(resp_data$id, resp_data$name)
- } else {
- c("No datasets found" = "")
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/data/list/", task_slug))
+ resp_data <- resp_body_json(req_perform(req), simplifyVector = TRUE)
+ if (length(resp_data) > 0 && nrow(resp_data) > 0) {
+ setNames(resp_data$id, resp_data$name)
+ } else {
+ c("No datasets found" = "")
+ }
+ },
+ error = function(e) {
+ c("Error loading datasets" = "")
}
- }, error = function(e) {
- c("Error loading datasets" = "")
- })
+ )
}
-
+
# --- Auto-refresh Dataset Dropdowns ---
# Triggered by: 1. Task selector change, 2. Data refresh trigger
- observeEvent(c(input$task_selector, refresh_data_trigger()), {
- task_slug <- input$task_selector
- if (task_slug == "object_detection") {
- updateSelectInput(session, "obj_dataset_id", choices = load_datasets_for_task("object_detection"))
- } else if (task_slug == "asr") {
- updateSelectInput(session, "asr_dataset_id", choices = load_datasets_for_task("asr"))
- } else if (task_slug == "image_classification") {
- updateSelectInput(session, "img_class_dataset_id", choices = load_datasets_for_task("image_classification"))
- } else if (task_slug == "image_segmentation") {
- updateSelectInput(session, "seg_dataset_id", choices = load_datasets_for_task("image_segmentation"))
- }
- }, ignoreNULL = TRUE, ignoreInit = TRUE)
-
+ observeEvent(c(input$task_selector, refresh_data_trigger()),
+ {
+ task_slug <- input$task_selector
+ if (task_slug == "object_detection") {
+ updateSelectInput(session, "obj_dataset_id", choices = load_datasets_for_task("object_detection"))
+ } else if (task_slug == "image_classification") {
+ updateSelectInput(session, "img_class_dataset_id", choices = load_datasets_for_task("image_classification"))
+ } else if (task_slug == "semantic_segmentation") {
+ updateSelectInput(session, "seg_dataset_id", choices = load_datasets_for_task("semantic_segmentation"))
+ }
+ },
+ ignoreNULL = TRUE,
+ ignoreInit = TRUE
+ )
+
# Manually trigger first data load on startup (after registry is loaded)
- observeEvent(model_registry(), {
- req(model_registry())
- refresh_data_trigger(refresh_data_trigger() + 1)
- }, once = TRUE)
+ observeEvent(model_registry(),
+ {
+ req(model_registry())
+ refresh_data_trigger(refresh_data_trigger() + 1)
+ },
+ once = TRUE
+ )
-
- # --- Handle Dataset Upload Button ---
+ # --- 3.1: Handle File Upload (Async) ---
observeEvent(input$start_data_upload, {
- req(input$new_data_zip, input$new_data_name, input$new_data_task_type)
- data_upload_status("Uploading...")
- tryCatch({
- req <- request(paste0(api_url, "/data/upload/", input$new_data_task_type)) %>%
+ # Explicit validation instead of silent req() failure
+ if (is.null(input$new_data_name) || input$new_data_name == "") {
+ shinyalert::shinyalert("Missing Name", "Please enter a name for the dataset.", type = "warning")
+ return()
+ }
+ if (is.null(input$new_data_zip)) {
+ shinyalert::shinyalert("Missing File", "Please upload a file first.", type = "warning")
+ return()
+ }
+ req(input$new_data_task_type) # SelectInput almost always has a value
+
+ # UI Feedback - Immediate
+ data_upload_status("Step 1/3: Reading file in R...")
+
+ file_path <- input$new_data_zip$datapath
+ data_name_val <- input$new_data_name
+ task_type_val <- input$new_data_task_type
+
+ # Initialize Progress Bar
+ prog <- shiny::Progress$new()
+ prog$set(message = "Step 2/3: Uploading to Backend...", value = 0.5, detail = "This may take a moment for large files.")
+ data_upload_status("Step 2/3: Uploading file from R to Backend... Please wait.")
+
+ # 3. ASYNC UPLOAD (Future)
+ future_promise({
+ # This step sends the file from R to Python. It can be slow for large files.
+
+ # Use local variables captured outside future_promise to prevent cross-scope errors
+ req <- request(paste0(api_url, "/data/upload/", task_type_val)) %>%
+ req_headers("X-API-Key" = api_key) %>%
req_body_multipart(
- data_name = input$new_data_name,
- data_zip = curl::form_file(input$new_data_zip$datapath, type = "application/zip")
- )
+ task_type = task_type_val,
+ data_name = data_name_val,
+ data_file = curl::form_file(file_path)
+ ) %>%
+ req_timeout(600) # 10 minutes timeout for large files
+
resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- # Start the poller
- processing_dataset_id(resp_data$dataset_id)
- data_upload_status(paste("Success! Dataset", input$new_data_name, "is processing..."))
-
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- data_upload_status(paste("Error:", error_message))
+ resp_body_json(resp)
+ }) %...>% (function(resp_data) {
+ # 4. SUCCESS (Back in Main Thread)
+ prog$close()
+
+ # Trigger the existing poller logic
+ processing_dataset_id(resp_data$dataset_id)
+ data_upload_status(paste("Upload complete. Server is now unpacking and validating (Dataset ID:", resp_data$dataset_id, ")..."))
+ }) %...!% (function(error) {
+ # 5. FAILURE (Back in Main Thread)
+ prog$close()
+
+ error_message <- as.character(error$message)
+ if (!is.null(error$body)) {
+ error_message <- paste("API Error:", error$body)
+ }
+
+ data_upload_status(paste("Error during upload:", error_message))
+ shinyalert::shinyalert("Upload Failed", error_message, type = "error")
})
+
+ NULL
})
-
+
# --- Poller for Data Processing Status ---
observe({
ds_id <- processing_dataset_id()
req(ds_id) # Only run if we are processing a dataset
-
+
invalidateLater(2000, session) # Poll every 2 seconds
-
- tryCatch({
- req_status <- request(paste0(api_url, "/data/status/", ds_id))
- resp <- req_perform(req_status)
- status_data <- resp_body_json(resp)
-
- if (status_data$status == "ready" || status_data$status == "failed") {
- processing_dataset_id(NULL) # Stop polling
-
- # --- AUTO-REFRESH ---
- refresh_data_trigger(refresh_data_trigger() + 1)
-
- if(status_data$status == "ready") {
- data_upload_status(paste("Dataset processing complete!"))
+
+ tryCatch(
+ {
+ req_status <- request(paste0(api_url, "/data/status/", ds_id))
+ resp <- req_perform(req_status)
+ status_data <- resp_body_json(resp)
+
+ if (status_data$status == "ready" || status_data$status == "failed") {
+ processing_dataset_id(NULL) # Stop polling
+
+ # --- AUTO-REFRESH ---
+ refresh_data_trigger(refresh_data_trigger() + 1)
+
+ if (status_data$status == "ready") {
+ data_upload_status(paste("Dataset processing complete!"))
+ } else {
+ data_upload_status(paste("Dataset processing failed:", status_data$error))
+ }
} else {
- data_upload_status(paste("Dataset processing failed:", status_data$error))
+ data_upload_status(paste("Processing dataset...", status_data$status))
}
-
- } else {
- data_upload_status(paste("Processing dataset...", status_data$status))
+ },
+ error = function(e) {
+ data_upload_status("Error polling data status.")
+ processing_dataset_id(NULL) # Stop polling on error
}
- }, error = function(e) {
- data_upload_status("Error polling data status.")
- processing_dataset_id(NULL) # Stop polling on error
- })
+ )
})
-
+
# --- Data Management UI Outputs ---
- output$data_upload_status <- renderText({ data_upload_status() })
+ output$data_upload_status <- renderText({
+ data_upload_status()
+ })
- output$dataset_table <- renderDT({
+ # --- Reactive: Fetch Available Datasets (Cached) ---
+ datasets_reactive <- reactive({
refresh_data_trigger() # React to the trigger
-
- tryCatch({
- tasks <- c("object_detection", "asr", "image_classification", "image_segmentation")
- all_datasets <- lapply(tasks, function(task) {
- req <- request(paste0(api_url, "/data/list/", task))
- resp_data <- resp_body_json(req_perform(req), simplifyVector = TRUE)
- if (length(resp_data) > 0 && nrow(resp_data) > 0) {
- resp_data$task_type <- task
- return(resp_data)
+ tryCatch(
+ {
+ tasks <- c("object_detection", "image_classification", "semantic_segmentation")
+ # Make parallel requests for better performance
+ reqs <- lapply(tasks, function(task) request(paste0(api_url, "/data/list/", task)))
+ resps <- httr2::req_perform_parallel(reqs, on_error = "continue")
+
+ all_datasets <- lapply(seq_along(resps), function(i) {
+ resp <- resps[[i]]
+ if (!inherits(resp, "error") && httr2::resp_status(resp) == 200) {
+ resp_data <- httr2::resp_body_json(resp, simplifyVector = TRUE)
+ if (length(resp_data) > 0 && is.data.frame(resp_data) && nrow(resp_data) > 0) {
+ resp_data$task_type <- tasks[i]
+ return(resp_data)
+ }
+ }
+ return(NULL)
+ })
+ bind_rows(all_datasets)
+ },
+ error = function(e) {
+ NULL
+ }
+ )
+ })
+
+ output$dataset_table <- renderDT(
+ {
+ df <- datasets_reactive()
+ req(df)
+
+ # Add Actions Column with Delete Button
+ if (nrow(df) > 0) {
+ df$actions <- sapply(df$id, function(id) {
+ as.character(tags$button(
+ class = "btn btn-danger btn-xs",
+ onclick = sprintf("Shiny.setInputValue('dl_delete_dataset_click', '%s', {priority: 'event'});", id),
+ icon("trash"), " Delete"
+ ))
+ })
+ }
+ return(df)
+ },
+ escape = FALSE
+ ) # Important: Allow HTML for buttons
+
+ # --- Handle Dataset Deletion ---
+ observeEvent(input$dl_delete_dataset_click, {
+ ds_id <- input$dl_delete_dataset_click
+ shinyalert::shinyalert(
+ title = "Delete Dataset?",
+ text = "Are you sure? This will permanently delete the dataset files from the server.",
+ type = "warning",
+ showCancelButton = TRUE,
+ confirmButtonCol = "#DD6B55",
+ confirmButtonText = "Yes, delete it",
+ callbackR = function(x) {
+ if (x) shinyjs::runjs(sprintf("Shiny.setInputValue('dl_delete_dataset_confirmed', '%s', {priority: 'event'});", ds_id))
+ }
+ )
+ })
+
+ observeEvent(input$dl_delete_dataset_confirmed, {
+ ds_id <- input$dl_delete_dataset_confirmed
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/data/", ds_id)) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_method("DELETE")
+ resp <- req_perform(req)
+ if (resp_status(resp) == 200) {
+ shinyalert::shinyalert("Deleted!", "Dataset has been removed.", type = "success")
+ refresh_data_trigger(refresh_data_trigger() + 1) # Reload table
+ } else {
+ shinyalert::shinyalert("Error", "Failed to delete dataset.", type = "error")
}
- return(NULL)
- })
- bind_rows(all_datasets)
- }, error = function(e) {
- data.frame(name = "Error loading dataset list.", task_type = e$message)
- })
+ },
+ error = function(e) {
+ shinyalert::shinyalert("Error", as.character(e), type = "error")
+ }
+ )
})
-
+
# ==============================================================================
# == 4. TRAINING JOB SUBMISSION (One per task)
# ==============================================================================
-
+
# --- Helper: Resets UI before starting a job ---
reset_live_training_ui <- function(task_name) {
replaceData(proxy_eval_table, NULL, resetPaging = TRUE, clearSelection = TRUE)
active_job_id(NULL)
polled_metrics(NULL)
polled_data(list(status = "Submitting...", task = task_name, log = "Submitting job..."))
- updateTabsetPanel(session, "main_tabs", selected = "Live Training")
+
+ # Redirect AND Reset Wizard
+ updateTabsetPanel(session, "main_tabs", selected = "Job Manager") # Fixed Tab Name
+ updateTabsetPanel(session, "wizard_tabs", selected = "step1") # Reset Wizard
+ updateTextInput(session, "obj_run_name", value = "shiny-obj-run") # Optional: reset name
+ # Reset other inputs if needed...
}
# --- 4.1: Object Detection Job ---
@@ -267,214 +444,277 @@ deep_learning = function() {
req(input$obj_dataset_id, input$obj_model_checkpoint)
reset_live_training_ui("Object Detection")
- tryCatch({
- req <- request(paste0(api_url, "/train/object-detection")) %>%
- req_body_multipart(
- # Common Params
- dataset_id = as.character(input$obj_dataset_id),
- model_checkpoint = as.character(input$obj_model_checkpoint),
- run_name = as.character(input$obj_run_name),
- version = as.character(input$obj_version),
- epochs = as.character(input$obj_epochs),
- train_batch_size = as.character(input$obj_train_batch_size),
- eval_batch_size = as.character(input$obj_eval_batch_size),
- seed = as.character(input$obj_seed),
- num_proc = as.character(input$obj_num_proc),
- early_stopping_patience = as.character(input$obj_early_stopping_patience),
- push_to_hub = as.character(input$obj_push_to_hub),
- hub_user_id = as.character(input$obj_hub_user_id),
- log_to_wandb = as.character(input$obj_log_to_wandb),
- wandb_project = as.character(input$obj_wandb_project),
- wandb_entity = as.character(input$obj_wandb_entity),
- max_image_size = as.character(input$obj_max_image_size),
-
- # HF-Specific Params
- learning_rate = as.character(input$obj_learning_rate),
- weight_decay = as.character(input$obj_weight_decay),
- gradient_accumulation_steps = as.character(input$obj_gradient_accumulation_steps),
- gradient_checkpointing = as.character(input$obj_gradient_checkpointing),
- max_grad_norm = as.character(input$obj_max_grad_norm),
- fp16 = as.character(input$obj_fp16),
- force_preprocess = as.character(input$obj_force_preprocess),
- early_stopping_threshold = as.character(input$obj_early_stopping_threshold),
-
- # YOLO-Specific Params
- warmup_epochs = as.character(input$obj_yolo_warmup_epochs),
- lr0 = as.character(input$obj_yolo_lr0),
- momentum = as.character(input$obj_yolo_momentum),
- optimizer = as.character(input$obj_yolo_optimizer),
- weight_decay_yolo = as.character(input$obj_yolo_weight_decay)
- )
-
- resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- active_job_id(resp_data$job_id)
- polled_data(list(status = "Queued", task = "Object Detection", log = "Job is queued."))
-
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- polled_data(list(status = "Error", task = "Object Detection", log = error_message))
- })
- })
-
- # --- 4.2: ASR Job ---
- observeEvent(input$start_asr_job, {
- req(input$asr_dataset_id, input$asr_model_checkpoint)
- reset_live_training_ui("ASR")
-
- outlier_val <- input$outlier_std_devs
- if (is.null(outlier_val) || is.na(outlier_val) || !is.numeric(outlier_val) || !input$asr_apply_outlier_filtering) {
- outlier_val <- 2.0
- }
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/train/object-detection")) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_body_multipart(
+ # Common Params
+ dataset_id = as.character(input$obj_dataset_id),
+ model_checkpoint = as.character(input$obj_model_checkpoint),
+ run_name = as.character(input$obj_run_name),
+ version = as.character(input$obj_version),
+ epochs = as.character(input$obj_epochs),
+ train_batch_size = as.character(input$obj_train_batch_size),
+ max_image_size = as.character(input$obj_max_image_size),
+ seed = as.character(input$obj_seed),
+ early_stopping_patience = as.character(input$obj_early_stopping_patience),
- max_hours <- if (is.na(input$asr_max_train_hours) || is.null(input$asr_max_train_hours)) NULL else as.character(input$asr_max_train_hours)
-
- tryCatch({
- req_list <- list(
- dataset_id = as.character(input$asr_dataset_id),
- model_checkpoint = as.character(input$asr_model_checkpoint),
- run_name = as.character(input$asr_run_name),
- version = as.character(input$asr_version),
- language = as.character(input$asr_language),
- language_code = as.character(input$asr_language_code),
- speaker_id_column = as.character(input$asr_speaker_id_column),
- text_column = as.character(input$asr_text_column),
- target_sampling_rate = as.character(input$asr_target_sampling_rate),
- min_duration_s = as.character(input$asr_min_duration_s),
- max_duration_s = as.character(input$asr_max_duration_s),
- min_transcript_len = as.character(input$asr_min_transcript_len),
- max_transcript_len = as.character(input$asr_max_transcript_len),
- apply_outlier_filtering = as.character(input$asr_apply_outlier_filtering),
- outlier_std_devs = as.character(outlier_val),
- is_presplit = as.character(input$asr_is_presplit),
- speaker_disjointness = as.character(input$asr_speaker_disjointness),
- train_ratio = as.character(input$asr_train_ratio),
- dev_ratio = as.character(input$asr_dev_ratio),
- test_ratio = as.character(input$asr_test_ratio),
- epochs = as.character(input$asr_epochs),
- learning_rate = as.character(input$asr_learning_rate),
- lr_scheduler_type = as.character(input$asr_lr_scheduler_type),
- warmup_ratio = as.character(input$asr_warmup_ratio),
- train_batch_size = as.character(input$asr_train_batch_size),
- eval_batch_size = as.character(input$asr_eval_batch_size),
- gradient_accumulation_steps = as.character(input$asr_gradient_accumulation_steps),
- gradient_checkpointing = as.character(input$asr_gradient_checkpointing),
- optimizer = as.character(input$asr_optimizer),
- early_stopping_patience = as.character(input$asr_early_stopping_patience),
- early_stopping_threshold = as.character(input$asr_early_stopping_threshold),
- push_to_hub = as.character(input$asr_push_to_hub),
- hub_user_id = as.character(input$asr_hub_user_id),
- hub_private_repo = as.character(input$asr_hub_private_repo),
- log_to_wandb = as.character(input$asr_log_to_wandb),
- wandb_project = as.character(input$asr_wandb_project),
- wandb_entity = as.character(input$asr_wandb_entity),
- seed = as.character(input$asr_seed),
- num_proc = as.character(input$asr_num_proc),
- max_train_hours = max_hours
- )
-
- req_list <- req_list[!sapply(req_list, is.null)]
+ # HF-Specific Params (Transformers)
+ eval_batch_size = as.character(input$obj_eval_batch_size),
+ learning_rate = as.character(input$obj_learning_rate),
+ weight_decay_hf = as.character(input$obj_weight_decay_hf),
+ gradient_accumulation_steps = as.character(input$obj_gradient_accumulation_steps),
+ gradient_checkpointing = if (isTRUE(input$obj_gradient_checkpointing)) "true" else "false",
+ early_stopping_threshold = as.character(input$obj_early_stopping_threshold),
- req <- request(paste0(api_url, "/train/asr")) %>%
- req_body_multipart(!!!req_list)
-
- resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- active_job_id(resp_data$job_id)
- polled_data(list(status = "Queued", task = "ASR", log = "Job is queued."))
-
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- polled_data(list(status = "Error", task = "ASR", log = error_message))
- })
+ # Hugging Face specific arguments
+ optimizer_hf = as.character(input$obj_optimizer_hf),
+ scheduler_hf = as.character(input$obj_scheduler_hf),
+ warmup_epochs_hf = as.character(input$obj_warmup_epochs_hf),
+
+ # YOLO-Specific Params
+ warmup_epochs = as.character(input$obj_warmup_epochs),
+ momentum = as.character(input$obj_momentum),
+ optimizer = as.character(input$obj_optimizer),
+ weight_decay_yolo = as.character(input$obj_weight_decay),
+ lr0 = as.character(input$obj_lr0),
+
+ # Augmentation
+ enable_augmentation = if (isTRUE(input$obj_enable_augment)) "true" else "false",
+ flip_prob = as.character(input$obj_flip_prob),
+ rotate_limit = as.character(input$obj_rotate_limit),
+ brightness = as.character(input$obj_brightness),
+ contrast = as.character(input$obj_contrast),
+ mosaic = as.character(input$obj_mosaic),
+ mixup = as.character(input$obj_mixup),
+ hsv_h = as.character(input$obj_hsv_h),
+ hsv_s = as.character(input$obj_hsv_s),
+ hsv_v = as.character(input$obj_hsv_v)
+ )
+
+ resp <- req_perform(req)
+ resp_data <- resp_body_json(resp)
+ active_job_id(resp_data$job_id)
+ polled_data(list(status = "Queued", task = "Object Detection", log = "Job is queued."))
+ },
+ error = function(e) {
+ error_message <- as.character(e$message)
+ if (!is.null(e$body)) {
+ error_message <- paste("API Error:", e$body)
+ }
+ polled_data(list(status = "Error", task = "Object Detection", log = error_message))
+ }
+ )
})
+
# --- 4.3: Image Classification Job ---
observeEvent(input$start_img_class_job, {
req(input$img_class_dataset_id, input$img_class_model_checkpoint)
reset_live_training_ui("Image Classification")
- tryCatch({
- req <- request(paste0(api_url, "/train/image-classification")) %>%
- req_body_multipart(
- dataset_id = as.character(input$img_class_dataset_id),
- model_checkpoint = as.character(input$img_class_model_checkpoint),
- run_name = as.character(input$img_class_run_name),
- version = as.character(input$img_class_version),
- epochs = as.character(input$img_class_epochs),
- learning_rate = as.character(input$img_class_learning_rate),
- weight_decay = as.character(input$img_class_weight_decay),
- train_batch_size = as.character(input$img_class_train_batch_size),
- eval_batch_size = as.character(input$img_class_eval_batch_size),
- max_image_size = as.character(input$img_class_max_image_size),
- gradient_accumulation_steps = as.character(input$img_class_grad_accum),
- gradient_checkpointing = as.character(input$img_class_grad_check),
- fp16 = as.character(input$img_class_fp16),
- seed = as.character(input$img_class_seed),
- early_stopping_patience = as.character(input$img_class_early_stop),
- push_to_hub = as.character(input$img_class_push_to_hub),
- hub_user_id = as.character(input$img_class_hub_user_id),
- log_to_wandb = as.character(input$img_class_log_to_wandb),
- wandb_project = as.character(input$img_class_wandb_project),
- wandb_entity = as.character(input$img_class_wandb_entity),
- num_proc = as.character(input$img_class_num_proc),
- is_presplit = as.character(input$img_class_is_presplit),
- train_ratio = as.character(input$img_class_train_ratio),
- dev_ratio = as.character(input$img_class_dev_ratio)
- )
-
- resp <- req_perform(req)
- active_job_id(resp_body_json(resp)$job_id)
- }, error = function(e) {
- polled_data(list(status = "Error", task = "Image Classification", log = as.character(e)))
- })
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/train/image-classification")) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_body_multipart(
+ dataset_id = as.character(input$img_class_dataset_id),
+ model_checkpoint = as.character(input$img_class_model_checkpoint),
+ run_name = as.character(input$img_class_run_name),
+ version = as.character(input$img_class_version),
+ epochs = as.character(input$img_class_num_train_epochs),
+ learning_rate = as.character(input$img_class_learning_rate),
+ weight_decay = as.character(input$img_class_weight_decay),
+ train_batch_size = as.character(input$img_class_per_device_train_batch_size),
+ eval_batch_size = as.character(input$img_class_eval_batch_size),
+ max_image_size = as.character(input$img_class_max_image_size),
+ gradient_accumulation_steps = as.character(input$img_class_gradient_accumulation_steps),
+ gradient_checkpointing = if (isTRUE(input$img_class_gradient_checkpointing)) "true" else "false",
+ early_stopping_patience = as.character(input$img_class_early_stopping_patience),
+ early_stopping_threshold = as.character(input$img_class_early_stopping_threshold),
+ seed = as.character(input$img_class_seed),
+
+ # Optimizer configuration
+ optimizer = as.character(input$img_class_optimizer),
+ scheduler = as.character(input$img_class_scheduler),
+ warmup_epochs = as.character(input$img_class_warmup_epochs),
+
+ # Data augmentation configuration
+ enable_augmentation = if (isTRUE(input$img_class_enable_augment)) "true" else "false",
+ flip_prob = as.character(input$img_class_flip_prob),
+ rotate_limit = as.character(input$img_class_rotate_limit),
+ brightness = as.character(input$img_class_brightness),
+ contrast = as.character(input$img_class_contrast)
+ )
+
+ resp <- req_perform(req)
+ active_job_id(resp_body_json(resp)$job_id)
+ },
+ error = function(e) {
+ polled_data(list(status = "Error", task = "Image Classification", log = as.character(e)))
+ }
+ )
})
-
+
# --- 4.4: Image Segmentation Job ---
observeEvent(input$start_seg_job, {
req(input$seg_dataset_id, input$seg_model_checkpoint)
reset_live_training_ui("Image Segmentation")
- tryCatch({
- req <- request(paste0(api_url, "/train/image-segmentation")) %>%
- req_body_multipart(
- dataset_id = as.character(input$seg_dataset_id),
- model_checkpoint = as.character(input$seg_model_checkpoint),
- run_name = as.character(input$seg_run_name),
- version = as.character(input$seg_version),
- epochs = as.character(input$seg_epochs),
- learning_rate = as.character(input$seg_learning_rate),
- weight_decay = as.character(input$seg_weight_decay),
- train_batch_size = as.character(input$seg_train_batch_size),
- eval_batch_size = as.character(input$seg_eval_batch_size),
- max_image_size = as.character(input$seg_max_image_size),
- gradient_accumulation_steps = as.character(input$seg_grad_accum),
- gradient_checkpointing = as.character(input$seg_grad_check),
- fp16 = as.character(input$seg_fp16),
- seed = as.character(input$seg_seed),
- early_stopping_patience = as.character(input$seg_early_stop),
- push_to_hub = as.character(input$seg_push_to_hub),
- hub_user_id = as.character(input$seg_hub_user_id),
- log_to_wandb = as.character(input$seg_log_to_wandb),
- wandb_project = as.character(input$seg_wandb_project),
- wandb_entity = as.character(input$seg_wandb_entity),
- num_proc = as.character(input$seg_num_proc),
- is_presplit = as.character(input$seg_is_presplit),
- train_ratio = as.character(input$seg_train_ratio),
- dev_ratio = as.character(input$seg_dev_ratio)
- )
-
- resp <- req_perform(req)
- active_job_id(resp_body_json(resp)$job_id)
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- polled_data(list(status = "Error", task = "Image Segmentation", log = error_message))
- })
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/train/image-segmentation")) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_body_multipart(
+ dataset_id = as.character(input$seg_dataset_id),
+ model_checkpoint = as.character(input$seg_model_checkpoint),
+ run_name = as.character(input$seg_run_name),
+ version = as.character(input$seg_version),
+ epochs = as.character(input$seg_num_train_epochs),
+ learning_rate = as.character(input$seg_learning_rate),
+ weight_decay = as.character(input$seg_weight_decay),
+ train_batch_size = as.character(input$seg_per_device_train_batch_size),
+ eval_batch_size = as.character(input$seg_eval_batch_size),
+ max_image_size = as.character(input$seg_max_image_size),
+ gradient_accumulation_steps = as.character(input$seg_gradient_accumulation_steps),
+ gradient_checkpointing = if (isTRUE(input$seg_gradient_checkpointing)) "true" else "false",
+ early_stopping_patience = as.character(input$seg_early_stopping_patience),
+ early_stopping_threshold = as.character(input$seg_early_stopping_threshold),
+ seed = as.character(input$seg_seed),
+
+ # Optimizer configuration
+ optimizer = as.character(input$seg_optimizer),
+ scheduler = as.character(input$seg_scheduler),
+ warmup_epochs = as.character(input$seg_warmup_epochs),
+
+ # Data augmentation configuration
+ enable_augmentation = if (isTRUE(input$seg_enable_augment)) "true" else "false",
+ flip_prob = as.character(input$seg_flip_prob),
+ rotate_limit = as.character(input$seg_rotate_limit),
+ brightness = as.character(input$seg_brightness),
+ contrast = as.character(input$seg_contrast)
+ )
+
+ resp <- req_perform(req)
+ active_job_id(resp_body_json(resp)$job_id)
+ },
+ error = function(e) {
+ error_message <- as.character(e$message)
+ if (!is.null(e$body)) {
+ error_message <- paste("API Error:", e$body)
+ }
+ polled_data(list(status = "Error", task = "Image Segmentation", log = error_message))
+ }
+ )
+ })
+
+
+ # ==============================================================================
+ # == WIZARD NAVIGATION LOGIC
+ # ==============================================================================
+ observeEvent(input$wiz_next_1, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step2")
+ })
+
+ observeEvent(input$wiz_next_2, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step3")
+ })
+ observeEvent(input$wiz_back_2, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step1")
+ })
+
+ observeEvent(input$wiz_next_3, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step4")
})
+ observeEvent(input$wiz_back_3, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step2")
+ })
+
+ observeEvent(input$wiz_back_4, {
+ updateTabsetPanel(session, "wizard_tabs", selected = "step3")
+ })
+
+ # --- 4.4: Wizard Review Table ---
+ output$wizard_review_table <- renderTable({
+ task <- input$task_selector
+ params <- data.frame(Parameter = character(), Value = character(), stringsAsFactors = FALSE)
+
+ # Helper for lookup
+ get_ds_name <- function(id) {
+ df <- datasets_reactive()
+ if (!is.null(df) && id %in% df$id) {
+ return(paste0(df$name[df$id == id], " (", id, ")"))
+ }
+ return(id)
+ }
+
+ if (task == "object_detection") {
+ params <- rbind(params, c("Task", "Object Detection"))
+ params <- rbind(params, c("Dataset", get_ds_name(input$obj_dataset_id)))
+ params <- rbind(params, c("Run Name", input$obj_run_name))
+ params <- rbind(params, c("Version", input$obj_version))
+ params <- rbind(params, c("Model Arch", input$obj_model_arch))
+ params <- rbind(params, c("Checkpoint", input$obj_model_checkpoint))
+
+ # Conditional Params (YOLO vs HF)
+ is_yolo_pt <- grepl("\\.pt$", input$obj_model_checkpoint)
+
+ params <- rbind(params, c("Epochs", as.character(input$obj_epochs)))
+ params <- rbind(params, c("Train Batch Size", as.character(input$obj_train_batch_size)))
+ if (is_yolo_pt) {
+ params <- rbind(params, c("Optimizer", input$obj_optimizer))
+ params <- rbind(params, c("Lr0", as.character(input$obj_lr0))) # Use Lr0
+ params <- rbind(params, c("Momentum", as.character(input$obj_momentum)))
+ params <- rbind(params, c("Weight Decay", as.character(input$obj_weight_decay)))
+ params <- rbind(params, c("Warmup Epochs", as.character(input$obj_warmup_epochs)))
+ params <- rbind(params, c("Mosaic", as.character(input$obj_mosaic)))
+ params <- rbind(params, c("Mixup", as.character(input$obj_mixup)))
+ } else {
+ params <- rbind(params, c("Eval Batch Size", as.character(input$obj_eval_batch_size))) # HF Only
+ params <- rbind(params, c("Learning Rate", as.character(input$obj_learning_rate))) # HF Only
+ params <- rbind(params, c("Weight Decay", as.character(input$obj_weight_decay_hf)))
+ params <- rbind(params, c("Optimizer", input$obj_optimizer_hf))
+ params <- rbind(params, c("Scheduler", input$obj_scheduler_hf))
+ params <- rbind(params, c("Warmup Epochs", as.character(input$obj_warmup_epochs_hf)))
+ }
+
+ params <- rbind(params, c("Early Stopping Patience", as.character(input$obj_early_stopping_patience)))
+ params <- rbind(params, c("Seed", as.character(input$obj_seed)))
+ } else if (task == "image_classification") {
+ params <- rbind(params, c("Task", "Image Classification"))
+ params <- rbind(params, c("Dataset", get_ds_name(input$img_class_dataset_id)))
+ params <- rbind(params, c("Run Name", input$img_class_run_name))
+ params <- rbind(params, c("Version", input$img_class_version))
+ params <- rbind(params, c("Model Arch", input$img_class_model_arch))
+ params <- rbind(params, c("Checkpoint", input$img_class_model_checkpoint))
+ params <- rbind(params, c("Epochs", as.character(input$img_class_num_train_epochs)))
+ params <- rbind(params, c("Train Batch Size", as.character(input$img_class_per_device_train_batch_size)))
+ params <- rbind(params, c("Eval Batch Size", as.character(input$img_class_eval_batch_size)))
+ params <- rbind(params, c("Learning Rate", as.character(input$img_class_learning_rate)))
+ params <- rbind(params, c("Weight Decay", as.character(input$img_class_weight_decay)))
+ params <- rbind(params, c("Max Image Size", as.character(input$img_class_max_image_size)))
+ params <- rbind(params, c("Seed", as.character(input$img_class_seed)))
+ } else if (task == "semantic_segmentation") {
+ params <- rbind(params, c("Task", "Semantic Segmentation"))
+ params <- rbind(params, c("Dataset", get_ds_name(input$seg_dataset_id)))
+ params <- rbind(params, c("Run Name", input$seg_run_name))
+ params <- rbind(params, c("Version", input$seg_version))
+ params <- rbind(params, c("Model Arch", input$seg_model_arch))
+ params <- rbind(params, c("Checkpoint", input$seg_model_checkpoint))
+ params <- rbind(params, c("Epochs", as.character(input$seg_num_train_epochs)))
+ params <- rbind(params, c("Train Batch Size", as.character(input$seg_per_device_train_batch_size)))
+ params <- rbind(params, c("Eval Batch Size", as.character(input$seg_eval_batch_size)))
+ params <- rbind(params, c("Learning Rate", as.character(input$seg_learning_rate)))
+ params <- rbind(params, c("Weight Decay", as.character(input$seg_weight_decay)))
+ params <- rbind(params, c("Max Image Size", as.character(input$seg_max_image_size)))
+ params <- rbind(params, c("Seed", as.character(input$seg_seed)))
+ }
+
+ if (nrow(params) > 0) colnames(params) <- c("Parameter", "Value")
+ return(params)
+ })
# ==============================================================================
# == 5. "LIVE TRAINING" TAB LOGIC
@@ -484,51 +724,92 @@ deep_learning = function() {
observe({
job_id <- active_job_id()
current_status <- polled_data()$status
-
- # Only poll if we have an active job that isn't finished
+
if (!is.null(job_id) && !(current_status %in% c("completed", "failed", "Error", "Polling Error"))) {
- invalidateLater(2000, session)
-
+ invalidateLater(1000, session)
+
# Poll for Status & Log
- tryCatch({
- req_status <- request(paste0(api_url, "/status/", job_id))
- resp_status <- req_perform(req_status)
- if (resp_status(resp_status) == 200) {
- polled_data(resp_body_json(resp_status))
+ tryCatch(
+ {
+ req_status <- request(paste0(api_url, "/status/", job_id))
+ resp_status <- req_perform(req_status)
+ if (resp_status(resp_status) == 200) {
+ polled_data(resp_body_json(resp_status))
+ }
+ },
+ error = function(e) {
+ current_data <- polled_data()
+ current_data$status <- "Polling Error"
+ polled_data(current_data)
}
- }, error = function(e) {
- current_data <- polled_data()
- current_data$status <- "Polling Error"
- polled_data(current_data)
- })
-
+ )
+
# Poll for Metrics
- tryCatch({
- req_metrics <- request(paste0(api_url, "/metrics/", job_id))
- resp_metrics <- req_perform(req_metrics)
- if (resp_status(resp_metrics) == 200) {
- polled_metrics(resp_body_json(resp_metrics))
+ tryCatch(
+ {
+ req_metrics <- request(paste0(api_url, "/metrics/", job_id))
+ resp_metrics <- req_perform(req_metrics)
+ if (resp_status(resp_metrics) == 200) {
+ polled_metrics(resp_body_json(resp_metrics))
+ }
+ },
+ error = function(e) {
+ polled_metrics(NULL)
}
- }, error = function(e) {
- polled_metrics(NULL)
- })
+ )
}
})
-
+
# --- 5.2: Job Status Panel Outputs ---
- output$job_task_display <- renderText({ polled_data()$task })
- output$job_id_display <- renderText({ ifelse(is.null(active_job_id()), "None", active_job_id()) })
- output$job_status_display <- renderText({ polled_data()$status })
-
+ output$job_task_display <- renderText({
+ polled_data()$task
+ })
+ output$job_id_display <- renderText({
+ ifelse(is.null(active_job_id()), "None", active_job_id())
+ })
+ output$job_status_display <- renderText({
+ polled_data()$status
+ })
+
+ # --- 5.2.b: Job Progress Bar ---
+ output$job_progress_ui <- renderUI({
+ pdata <- polled_data()
+ if (is.null(pdata) || is.null(pdata$progress)) {
+ return(NULL)
+ }
+
+ pct <- pdata$progress$percentage
+ txt <- pdata$progress$text
+ if (is.null(pct)) pct <- 0
+ if (is.null(txt)) txt <- "Starting..."
+
+ tags$div(
+ tags$p(strong("Progress: "), txt),
+ tags$div(
+ class = "progress",
+ tags$div(
+ class = "progress-bar progress-bar-success progress-bar-striped active",
+ role = "progressbar",
+ `aria-valuenow` = pct,
+ `aria-valuemin` = "0",
+ `aria-valuemax` = "100",
+ style = paste0("width: ", pct, "%"),
+ span(class = "sr-only", paste0(pct, "% Complete"))
+ )
+ )
+ )
+ })
+
# --- 5.3: Metrics Table Panel Output ---
output$eval_table <- renderDT({
metrics_list <- polled_metrics()
req(metrics_list, length(metrics_list) > 0)
-
+
metrics_df <- bind_rows(metrics_list)
-
+
if (nrow(metrics_df) > 0) {
display_df <- metrics_df %>%
+ select(epoch, starts_with("eval_"), starts_with("test_")) %>%
pivot_longer(
cols = starts_with("eval_") | starts_with("test_"),
names_to = "metric_name",
@@ -544,14 +825,14 @@ deep_learning = function() {
select(any_of(c("step", "epoch", "loss", "map", "wer", "cer", "mean_iou")), everything())
datatable(
- display_df,
+ display_df,
options = list(
- pageLength = 5,
- scrollX = TRUE,
- searching = FALSE,
- autoWidth = TRUE,
- class = 'cell-border stripe'
- ),
+ pageLength = 5,
+ scrollX = TRUE,
+ searching = FALSE,
+ autoWidth = TRUE,
+ class = "cell-border stripe"
+ ),
rownames = FALSE
)
} else {
@@ -568,6 +849,14 @@ deep_learning = function() {
return(log_text)
})
+ output$historical_log_output <- renderText({
+ log_text <- historical_log_text()
+ if (is.null(log_text) || nchar(log_text) == 0) {
+ return("No log loaded. Click a job request to load.")
+ }
+ return(log_text)
+ })
+
# --- 5.5: Plotting Logic for "Live Training" Tab ---
metrics_for_plotting <- reactive({
metrics_list <- polled_metrics()
@@ -575,156 +864,600 @@ deep_learning = function() {
bind_rows(metrics_list) %>%
filter(!is.na(epoch)) %>%
- filter(if_any(everything(), ~ !is.na(.))) %>%
- select(starts_with("eval_"), epoch) %>%
- arrange(epoch) %>%
- distinct(epoch, .keep_all = TRUE)
+ mutate(plot_group = ceiling(epoch)) %>% # Group fractional steps into next integer epoch
+ group_by(plot_group) %>%
+ summarise(
+ epoch = max(plot_group),
+ across(starts_with(c("eval_", "train_")), ~ last(na.omit(.))),
+ .groups = "drop"
+ ) %>%
+ filter(epoch > 0) %>%
+ arrange(epoch)
})
-
- output$metric_selector_ui <- renderUI({
+
+ output$is_job_running <- reactive({
+ job <- selected_job_data()
+ !is.null(job) && job$status == "running"
+ })
+ outputOptions(output, "is_job_running", suspendWhenHidden = FALSE)
+
+ last_metric_choices <- reactiveVal(NULL)
+
+ observe({
+ # Update metric selector choices dynamically without re-rendering the input
df <- tryCatch(metrics_for_plotting(), error = function(e) NULL)
-
- if (is.null(df) || nrow(df) == 0) {
- return(p("Waiting for first evaluation epoch to complete..."))
- }
-
- metric_names <- names(df)[sapply(df, is.numeric) & !names(df) %in% c("epoch", "step", "runtime", "samples_per_second", "steps_per_second")]
-
- default_metric <- "eval_loss"
- if (!"eval_loss" %in% metric_names && length(metric_names) > 0) {
- default_metric <- metric_names[1]
- }
-
- selected_val <- input$selected_metric
- if (is.null(selected_val) || !selected_val %in% metric_names) {
- selected_val <- default_metric
+
+ if (!is.null(df) && nrow(df) > 0) {
+ metric_names <- names(df)[sapply(df, is.numeric) & !names(df) %in% c("epoch", "step", "runtime", "samples_per_second", "steps_per_second", "plot_group")]
+
+ # Check if choices actually changed
+ current_choices <- last_metric_choices()
+ if (!identical(metric_names, current_choices)) {
+ last_metric_choices(metric_names)
+
+ # Smart default selection
+ default_metric <- "eval_loss"
+ if (!"eval_loss" %in% metric_names && length(metric_names) > 0) {
+ default_metric <- metric_names[1]
+ }
+
+ # Preserve current selection if valid
+ selected_val <- isolate(input$selected_metric)
+ if (is.null(selected_val) || !selected_val %in% metric_names) {
+ selected_val <- default_metric
+ }
+
+ updateSelectInput(session, "selected_metric",
+ choices = metric_names,
+ selected = selected_val
+ )
+ }
}
-
- selectInput("selected_metric", "Select Metric to Plot:",
- choices = metric_names,
- selected = selected_val)
})
-
+
output$dynamic_metric_plot <- renderDygraph({
df <- tryCatch(metrics_for_plotting(), error = function(e) NULL)
-
+
if (is.null(df) || nrow(df) == 0) {
- return(dygraph(data.frame(x=c(0), y=c(0)), main = "Waiting for Epoch 1") %>%
- dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE) %>%
- dyAxis("x", label = "Epoch"))
+ return(dygraph(data.frame(x = c(0), y = c(0)), main = "Waiting for Epoch 1") %>%
+ dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE) %>%
+ dyAxis("x", label = "Epoch"))
}
-
- req(input$selected_metric)
+
+ req(input$selected_metric)
req(input$selected_metric %in% names(df))
-
+
metric_to_plot <- input$selected_metric
-
+
if (!"epoch" %in% names(df) || !metric_to_plot %in% names(df)) {
- return(dygraph(data.frame(x=c(0), y=c(0)), main = "Metric data not yet available") %>%
- dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE))
+ return(dygraph(data.frame(x = c(0), y = c(0)), main = "Metric data not yet available") %>%
+ dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE))
}
plot_data <- df[, c("epoch", metric_to_plot)]
-
+
dygraph(plot_data, main = paste(metric_to_plot, "vs. Epoch")) %>%
dySeries(metric_to_plot, label = metric_to_plot) %>%
dyAxis("x", label = "Epoch", valueRange = c(0, max(df$epoch, na.rm = TRUE) + 1)) %>%
dyRangeSelector() %>%
- dyOptions(stackedGraph = FALSE,
- fillGraph = FALSE,
- stepPlot = FALSE,
- drawPoints = TRUE,
- pointSize = 4) %>%
+ dyOptions(
+ stackedGraph = FALSE,
+ fillGraph = FALSE,
+ stepPlot = FALSE,
+ drawPoints = TRUE,
+ pointSize = 4,
+ connectSeparatedPoints = TRUE
+ ) %>%
dyLegend(show = "always", width = 200)
})
-
-
+
+
# ==============================================================================
- # == 6. "TRAINING HISTORY" TAB LOGIC
+ # == 6. JOB MANAGER LOGIC (Unified History & Live)
# ==============================================================================
- # --- 6.1: Populate the Job Selector Dropdown (with Filters) ---
+ # --- 6.1: Fetch Jobs based on Filters ---
observe({
# React to tab switching, job completion, and filter changes
input$main_tabs
- polled_data()
- input$history_task_filter
- input$history_status_filter
-
- tryCatch({
-
- query_params <- list()
- if (input$history_task_filter != "all") {
- query_params$task_type <- input$history_task_filter
- }
- if (input$history_status_filter != "all") {
- query_params$status <- input$history_status_filter
- }
-
- req <- request(paste0(api_url, "/jobs/list"))
- if (length(query_params) > 0) {
- req <- req_url_query(req, !!!query_params)
- }
-
- resp <- req_perform(req)
- jobs_list_raw <- resp_body_json(resp, simplifyVector = FALSE)
-
- if (length(jobs_list_raw) > 0) {
-
- jobs_df <- bind_rows(lapply(jobs_list_raw, function(job) {
- data.frame(
- id = job$id,
- task_type = job$task_type,
- status = job$status,
- run_name = ifelse(is.null(job$details$run_name), "N/A", job$details$run_name)
- )
- }))
+ polled_data()
+ input$jm_task_filter
+ input$jm_status_filter
+ input$jm_show_entries
+ refresh_data_trigger() # Trigger refresh on actions like delete
- history_jobs_df(jobs_df)
+ # Auto-refresh list every 5 seconds to show status updates
+ invalidateLater(5000, session)
- job_names <- paste0(
- jobs_df$run_name,
- " (", jobs_df$task_type, " | ID: ", substr(jobs_df$id, 1, 8), ") - ",
- jobs_df$status
- )
- job_choices <- setNames(jobs_df$id, job_names)
-
- updateSelectInput(session, "history_job_selector", choices = job_choices)
-
- } else {
- updateSelectInput(session, "history_job_selector", choices = c("No jobs found" = ""))
+ tryCatch(
+ {
+ query_params <- list()
+ if (!is.null(input$jm_task_filter) && input$jm_task_filter != "All") {
+ query_params$task_type <- input$jm_task_filter
+ }
+ if (!is.null(input$jm_status_filter) && input$jm_status_filter != "All") {
+ query_params$status <- input$jm_status_filter
+ }
+
+ req <- request(paste0(api_url, "/jobs/list"))
+ if (length(query_params) > 0) {
+ req <- req_url_query(req, !!!query_params)
+ }
+
+ resp <- req_perform(req)
+ jobs_df <- resp_body_json(resp, simplifyVector = TRUE)
+
+ if (length(jobs_df) > 0 && is.data.frame(jobs_df) && nrow(jobs_df) > 0) {
+ history_jobs_df(jobs_df) # Reuse existing reactive val
+ } else {
+ history_jobs_df(NULL)
+ }
+ },
+ error = function(e) {
history_jobs_df(NULL)
}
- }, error = function(e) {
- updateSelectInput(session, "history_job_selector", choices = c("Error loading jobs" = ""))
- history_jobs_df(NULL)
- })
+ )
})
- # --- 6.2: Fetch Metrics when user selects a historical job ---
- observeEvent(input$history_job_selector, {
- job_id <- input$history_job_selector
-
- history_poller_active(FALSE) # Deactivate poller by default
-
- if (!is.null(job_id) && nchar(job_id) > 0) {
- tryCatch({
- req <- request(paste0(api_url, "/metrics/", job_id))
- resp <- req_perform(req)
- history_metrics(resp_body_json(resp))
- }, error = function(e) {
- history_metrics(NULL)
- })
-
- # --- Poller Activation Logic ---
- req(history_jobs_df())
- job_info <- history_jobs_df() %>% filter(id == job_id)
- if (nrow(job_info) > 0 && job_info$status == "running") {
- print(paste("Activating poller for running job:", job_id))
+ # --- Handle Stale Data (Clear Selection on Filter Change) ---
+ observeEvent(input$jm_task_filter, {
+ selected_job_data(NULL)
+ active_job_id(NULL) # Stop polling
+ })
+
+ # --- 6.2: Render Job Manager Table ---
+ output$job_manager_table <- renderDT({
+ df <- history_jobs_df()
+
+ if (is.null(df) || nrow(df) == 0) {
+ return(NULL)
+ }
+
+ # -- Apply Filters --
+ # Task Filter
+ if (!is.null(input$jm_task_filter) && input$jm_task_filter != "All") {
+ df <- df[df$task_type == input$jm_task_filter, ]
+ }
+
+ # Status Filter (Case-insensitive)
+ if (!is.null(input$jm_status_filter) && input$jm_status_filter != "All") {
+ # Backend statuses: 'completed', 'running', 'failed', 'queued'
+ # Filter options: 'Completed', 'Running', 'Failed'
+ df <- df[tolower(df$status) == tolower(input$jm_status_filter), ]
+ }
+
+
+ # Add Actions column
+ df$Actions <- vapply(seq_len(nrow(df)), function(i) {
+ status <- df$status[i]
+ id <- df$id[i]
+ if (status %in% c("running", "queued")) {
+ as.character(tags$button(
+ class = "btn btn-danger btn-xs",
+ onclick = sprintf("Shiny.setInputValue('dl_cancel_job_id', '%s', {priority: 'event'});", id),
+ "Cancel"
+ ))
+ } else {
+ as.character(tags$button(
+ class = "btn btn-default btn-xs",
+ onclick = sprintf("Shiny.setInputValue('dl_delete_job_click', '%s', {priority: 'event'});", id),
+ icon("trash"), " Delete"
+ ))
+ }
+ }, FUN.VALUE = character(1))
+
+ # Add Explicit Select Column (Checkbox behaving as toggle)
+ current_sel <- selected_job_data()
+ sel_id <- if (!is.null(current_sel)) current_sel$id else ""
+
+ df$Select <- vapply(df$id, function(id) {
+ checked <- if (id == sel_id) "checked" else ""
+ sprintf('', id, checked)
+ }, FUN.VALUE = character(1))
+
+ display_df <- df %>%
+ select(Select, Actions, Status = status, Name = run_name, Version = version, Task = task_type, ID = id) %>%
+ arrange(desc(ID))
+
+ datatable(
+ display_df,
+ escape = FALSE,
+ selection = "none", # Disable native row selection
+ options = list(
+ pageLength = as.integer(input$jm_show_entries), scrollX = TRUE, dom = "t,p",
+ columnDefs = list(list(className = "dt-center", targets = 0))
+ )
+ )
+ })
+
+ # --- 6.3: Handle Job Selection (Explicit Toggle) ---
+ selected_job_data <- reactiveVal(NULL)
+
+ observeEvent(input$dl_job_toggle, {
+ toggled_id <- input$dl_job_toggle
+ req(toggled_id)
+
+ current_sel <- selected_job_data()
+
+ # If clicking the currently selected job -> Deselect
+ if (!is.null(current_sel) && current_sel$id == toggled_id) {
+ selected_job_data(NULL)
+ active_job_id(NULL)
+ history_metrics(NULL)
+ updateSelectInput(session, "history_job_selector", selected = character(0))
+ return()
+ }
+
+ # Else -> Select new job
+ df <- history_jobs_df()
+ req(df)
+ selected_row <- df[df$id == toggled_id, ]
+ req(nrow(selected_row) > 0)
+
+ selected_job_data(selected_row)
+
+ if (selected_row$status == "running") {
+ # ... (existing polling logic)
+ active_job_id(selected_row$id)
+ history_poller_active(FALSE)
+ } else {
+ # ... (existing completed logic)
+ active_job_id(NULL)
+
+ # Fetch Historical Metrics & Logs
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/metrics/", selected_row$id))
+ resp <- req_perform(req)
+ if (resp_status(resp) == 200) history_metrics(resp_body_json(resp))
+
+ req_log <- request(paste0(api_url, "/jobs/", selected_row$id, "/log"))
+ resp_log <- req_perform(req_log)
+ if (resp_status(resp_log) == 200) historical_log_text(resp_body_json(resp_log)$log)
+ },
+ error = function(e) {
+ print(paste("Error fetching historical data:", e$message))
+ }
+ )
+ }
+ })
+
+ # --- Auto-Update Selected Job Details from history_jobs_df ---
+ # This ensures that when a running job completes in the background (and history_jobs_df refreshes),
+ # the details panel updates to show "completed" status/buttons without re-selection.
+ observe({
+ input$jm_task_filter # Dep
+ df <- history_jobs_df()
+ current_sel <- selected_job_data()
+
+ req(df, current_sel)
+
+ # Find updated row for current selection
+ updated_row <- df[df$id == current_sel$id, ]
+
+ if (nrow(updated_row) == 1) {
+ # Only update if status changed (avoid infinite loops/flicker)
+ if (updated_row$status != current_sel$status) {
+ # Update local state
+ selected_job_data(updated_row)
+
+ # If status flipped to completed/failed, ensure polling logic reacts
+ if (updated_row$status %in% c("completed", "failed", "error")) {
+ active_job_id(NULL) # Stop polling
+
+ # Trigger metrics fetch for final results
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/metrics/", updated_row$id))
+ resp <- req_perform(req)
+ if (resp_status(resp) == 200) history_metrics(resp_body_json(resp))
+
+ req_log <- request(paste0(api_url, "/jobs/", updated_row$id, "/log"))
+ resp_log <- req_perform(req_log)
+ if (resp_status(resp_log) == 200) historical_log_text(resp_body_json(resp_log)$log)
+ },
+ error = function(e) {}
+ )
+ }
+ }
+ }
+ })
+
+
+ # --- 6.4: Dynamic Details Panel ---
+ output$job_manager_details_ui <- renderUI({
+ selected <- selected_job_data()
+ polled <- polled_data()
+
+ # Use polled data if available and matches selected job (Real-time source)
+ if (!is.null(selected) && !is.null(polled) && !is.null(polled$id) && polled$id == selected$id) {
+ job <- polled
+ # Debug Print
+ if (job$status == "completed") print(paste("UI REFRESH: Job", job$id, "detected as COMPLETED from polled source"))
+ } else {
+ job <- selected
+ }
+
+ if (is.null(job)) {
+ return(box(width = NULL, title = "Job Details", status = "success", solidHeader = TRUE, "Select a job from the list to view details."))
+ }
+
+ if (job$status == "running") {
+ # LIVE VIEW
+ tagList(
+ box(
+ width = NULL, title = paste("Running:", job$run_name), status = "success", solidHeader = TRUE, collapsible = TRUE,
+ fluidRow(
+ column(6, strong("Status:"), textOutput("job_status_display", inline = TRUE)),
+ column(6, strong("ID:"), job$id)
+ ),
+ br(),
+ uiOutput("job_progress_ui")
+ ),
+ # Live Metrics moved to static UI to prevent re-rendering glitches
+ box(
+ width = NULL, title = "Logs", status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE,
+ verbatimTextOutput("log_output")
+ )
+ )
+ } else {
+ # HISTORICAL VIEW (Completed/Failed)
+
+ # Extract config/details
+ details_ui <- tagList()
+ if (!is.null(job$details) && length(job$details) > 0) {
+ # jobs_df$details is likely a dataframe of 1 row if simplified, or a list
+ d <- job$details
+ if (is.data.frame(d)) d <- as.list(d)
+
+ # Filter keys
+ all_keys <- names(d)[!names(d) %in% c("script_name", "output_dir", "log_file")]
+
+ # Detect Model Type for UI Filtering
+ model_chk <- if (!is.null(d$model_checkpoint)) tolower(d$model_checkpoint) else ""
+ is_yolo <- (grepl("yolo", model_chk) && !grepl("yolos", model_chk)) || grepl("rtdetr", model_chk)
+
+ valid_keys <- all_keys
+
+ if (is_yolo) {
+ # YOLO: Exclude HF params
+ exclude_hf <- c(
+ "learning_rate", "optimizer_hf", "scheduler_hf", "warmup_epochs_hf", "eval_batch_size",
+ "gradient_accumulation_steps", "gradient_checkpointing", "early_stopping_threshold", "weight_decay_hf"
+ )
+ valid_keys <- valid_keys[!valid_keys %in% exclude_hf]
+ } else {
+ # HF: Exclude YOLO params
+ exclude_yolo <- c("lr0", "momentum", "weight_decay_yolo", "mosaic", "mixup", "hsv_h", "hsv_s", "hsv_v")
+ # Also exclude "optimizer" if "optimizer_hf" is present (cleaner)
+ if ("optimizer_hf" %in% names(d)) exclude_yolo <- c(exclude_yolo, "optimizer")
+ valid_keys <- valid_keys[!valid_keys %in% exclude_yolo]
+ }
+
+ if (length(valid_keys) > 0) {
+ mid <- ceiling(length(valid_keys) / 2)
+ keys_col1 <- valid_keys[1:mid]
+ keys_col2 <- valid_keys[(mid + 1):length(valid_keys)]
+
+ render_item <- function(k) {
+ val <- d[[k]]
+ if (length(val) > 1) val <- paste(val, collapse = ", ")
+ # Handle NULL or empty
+ if (is.null(val) || length(val) == 0) val <- "N/A"
+ p(strong(paste0(tools::toTitleCase(gsub("_", " ", k)), ":")), as.character(val))
+ }
+
+ col1_ui <- lapply(keys_col1, render_item)
+ col2_ui <- lapply(keys_col2, render_item)
+
+ details_ui <- fluidRow(
+ column(6, do.call(tagList, col1_ui)),
+ column(6, do.call(tagList, col2_ui))
+ )
+ }
+ }
+
+ details_buttons <- tagList()
+ if (job$status == "completed") {
+ details_buttons <- tagList(
+ br(),
+ downloadButton("download_job_result", "Download Outputs", class = "btn-success", style = "width: 100%; margin-top: 10px; color: white;")
+ )
+ }
+
+ tagList(
+ box(
+ width = NULL, title = paste("Job Details:", job$run_name), status = "info", solidHeader = TRUE, collapsible = TRUE,
+ p(strong("ID:"), job$id),
+ p(strong("Status:"), job$status),
+ p(strong("Task:"), job$task_type),
+ # p(strong("Version:"), job$version), # Moved to dynamic details
+ hr(),
+ h5(strong("Configuration:")),
+ details_ui,
+ details_buttons
+ ),
+ box(
+ width = NULL, title = "Historical Metrics", status = "primary", solidHeader = TRUE, collapsible = TRUE,
+ uiOutput("history_metric_selector_ui"),
+ dygraphOutput("history_metric_plot", height = "300px")
+ ),
+ box(
+ width = NULL, title = "Evaluation Results", status = "success", solidHeader = TRUE, collapsible = TRUE,
+ DTOutput("history_eval_table")
+ ),
+ box(
+ width = NULL, title = "Logs (Historical)", status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE,
+ verbatimTextOutput("historical_log_output")
+ )
+ )
+ }
+ })
+
+ # --- Download Handler ---
+ output$download_job_result <- downloadHandler(
+ filename = function() {
+ job <- selected_job_data()
+ if (is.null(job)) {
+ return("model.zip")
+ }
+ paste0(job$run_name, "-", job$task_type, ".zip")
+ },
+ content = function(file) {
+ job <- selected_job_data()
+ req(job)
+
+ # Construct API URL
+ down_url <- paste0(api_url, "/jobs/", job$id, "/download")
+
+ # Use httr2 to download with API Key
+ tryCatch(
+ {
+ req <- request(down_url) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_timeout(600)
+
+ res <- req_perform(req, path = file)
+
+ if (resp_status(res) != 200) {
+ stop(paste("Download failed:", resp_body_string(res)))
+ }
+ },
+ error = function(e) {
+ shinyalert::shinyalert("Error", paste("Download failed:", e$message), type = "error")
+ }
+ )
+ }
+ )
+
+ # --- 6.1.6: Handle Job Cancellation ---
+ observeEvent(input$dl_cancel_job_id, {
+ job_id <- input$dl_cancel_job_id
+ req(job_id)
+
+ shinyalert::shinyalert(
+ title = "Cancelling Job...",
+ text = "Sending request to stop the training job...",
+ closeOnEsc = FALSE,
+ closeOnClickOutside = FALSE,
+ showConfirmButton = FALSE,
+ timer = 10000, # Failsafe: auto-close after 10s if stuck
+ type = "info"
+ )
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/jobs/cancel/", job_id)) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_method("POST") %>%
+ req_timeout(5) # 5 second timeout
+
+ resp <- req_perform(req)
+
+ if (resp_status(resp) == 200) {
+ # Success
+ shinyalert::shinyalert(
+ title = "Job Cancelled",
+ text = paste("Job", job_id, "has been cancelled."),
+ type = "success",
+ timer = 2000,
+ showConfirmButton = FALSE
+ )
+ # Refresh table
+ refresh_data_trigger(refresh_data_trigger() + 1)
+ } else {
+ shinyalert::shinyalert(
+ title = "Error",
+ text = paste("Failed to cancel job. Status:", resp_status(resp)),
+ type = "error",
+ showConfirmButton = TRUE
+ )
+ }
+ },
+ error = function(e) {
+ shinyalert::shinyalert(
+ title = "Communication Error",
+ text = paste("Could not connect to cancel endpoint:", e$message),
+ type = "error",
+ showConfirmButton = TRUE
+ )
+ }
+ )
+ })
+
+ # --- 6.1.7: Handle Job Deletion (Click -> Confirm -> Delete) ---
+ observeEvent(input$dl_delete_job_click, {
+ job_id <- input$dl_delete_job_click
+ req(job_id)
+
+ shinyalert::shinyalert(
+ title = "Confirm Deletion",
+ text = paste("Are you sure you want to delete Job", job_id, "?\nThis will remove the job record AND all output files/logs permanently."),
+ type = "warning",
+ showCancelButton = TRUE,
+ confirmButtonText = "Yes, delete it",
+ cancelButtonText = "No, keep it",
+ callbackR = function(x) {
+ if (x) {
+ # User confirmed, trigger actual deletion event
+ shinyjs::runjs(sprintf("Shiny.setInputValue('dl_delete_job_confirmed', '%s', {priority: 'event'});", job_id))
+ }
+ }
+ )
+ })
+
+ observeEvent(input$dl_delete_job_confirmed, {
+ job_id <- input$dl_delete_job_confirmed
+ req(job_id)
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/jobs/", job_id)) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_method("DELETE")
+ resp <- req_perform(req)
+
+ if (resp_status(resp) == 200) {
+ shinyalert::shinyalert("Deleted!", "Job and files have been deleted.", type = "success")
+ refresh_data_trigger(refresh_data_trigger() + 1)
+ selected_job_data(NULL)
+ active_job_id(NULL)
+ } else {
+ shinyalert::shinyalert("Error", "Failed to delete job.", type = "error")
+ }
+ },
+ error = function(e) {
+ shinyalert::shinyalert("Error", paste("Communication error:", e$message), type = "error")
+ }
+ )
+ })
+
+ # --- 6.2: Fetch Metrics when user selects a historical job ---
+ observeEvent(input$history_job_selector, {
+ job_id <- input$history_job_selector
+
+ history_poller_active(FALSE) # Deactivate poller by default
+
+ if (!is.null(job_id) && nchar(job_id) > 0) {
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/metrics/", job_id))
+ resp <- req_perform(req)
+ history_metrics(resp_body_json(resp))
+ },
+ error = function(e) {
+ history_metrics(NULL)
+ }
+ )
+
+ # --- Poller Activation Logic ---
+ req(history_jobs_df())
+ job_info <- history_jobs_df() %>% filter(id == job_id)
+ if (nrow(job_info) > 0 && job_info$status == "running") {
+ print(paste("Activating poller for running job:", job_id))
history_poller_active(TRUE) # Activate poller
}
# --- End Poller Logic ---
-
} else {
# If job_id is "" or NULL (e.g., "No jobs found"), clear the metrics.
history_metrics(NULL)
@@ -736,40 +1469,80 @@ deep_learning = function() {
metrics_list <- history_metrics()
req(metrics_list, length(metrics_list) > 0)
- bind_rows(metrics_list) %>%
- filter(!is.na(epoch)) %>% # <--- THIS IS THE FIX
- filter(if_any(everything(), ~ !is.na(.))) %>%
- select(starts_with("eval_"), epoch) %>%
- arrange(epoch) %>%
- distinct(epoch, .keep_all = TRUE)
+ df <- bind_rows(metrics_list)
+
+ # Robust handling for 'epoch'
+ if ("epoch" %in% names(df)) {
+ df <- df %>%
+ filter(!is.na(epoch)) %>%
+ mutate(plot_group = ceiling(epoch)) %>%
+ group_by(plot_group) %>%
+ summarise(
+ epoch = max(plot_group),
+ # Use last(na.omit(.)) to capture valid data even if scattered across rows
+ across(everything(), ~ last(na.omit(.))),
+ .groups = "drop"
+ ) %>%
+ filter(epoch > 0) %>%
+ arrange(epoch)
+ } else if ("step" %in% names(df)) {
+ df$epoch <- df$step # Fallback to step
+ df <- df %>% arrange(epoch)
+ } else {
+ # Fallback: create pseudo-epoch index
+ df$epoch <- 1:nrow(df)
+ }
+
+ df %>%
+ select(where(is.numeric)) # Select numeric columns for plotting
})
# --- 6.4: Render Historical Metrics Table ---
output$history_eval_table <- renderDT({
metrics_list <- history_metrics()
req(metrics_list, length(metrics_list) > 0)
-
+
metrics_df <- bind_rows(metrics_list)
-
+
if (nrow(metrics_df) > 0) {
- display_df <- metrics_df %>%
- pivot_longer(
- cols = starts_with("eval_") | starts_with("test_"),
- names_to = "metric_name",
- values_to = "value",
- values_drop_na = TRUE
- ) %>%
- separate(metric_name, into = c("step", "metric"), sep = "_", extra = "merge") %>%
- pivot_wider(
- names_from = metric,
- values_from = value,
- values_fn = first
- ) %>%
- select(any_of(c("step", "epoch", "loss", "map", "wer", "cer", "mean_iou")), everything())
+ # Check if we have any eval or test columns to pivot
+ has_eval_cols <- any(grepl("^eval_", names(metrics_df)))
+ has_test_cols <- any(grepl("^test_", names(metrics_df)))
+
+ if (!has_eval_cols && !has_test_cols) {
+ return(NULL)
+ }
+
+ display_df <- tryCatch(
+ {
+ metrics_df %>%
+ select(epoch, starts_with("eval_"), starts_with("test_")) %>%
+ pivot_longer(
+ cols = starts_with("eval_") | starts_with("test_"),
+ names_to = "metric_name",
+ values_to = "value",
+ values_drop_na = TRUE
+ ) %>%
+ separate(metric_name, into = c("step", "metric"), sep = "_", extra = "merge") %>%
+ pivot_wider(
+ names_from = metric,
+ values_from = value,
+ values_fn = first
+ ) %>%
+ select(any_of(c("step", "epoch", "loss", "map", "wer", "cer", "mean_iou")), everything())
+ },
+ error = function(e) {
+ return(NULL)
+ }
+ )
+
+ if (is.null(display_df)) {
+ return(NULL)
+ }
datatable(
- display_df,
- options = list(pageLength = 5, scrollX = TRUE, searching = FALSE, autoWidth = TRUE),
+ display_df,
+ options = list(pageLength = 5, scrollX = TRUE, searching = FALSE, autoWidth = TRUE),
rownames = FALSE
)
} else {
@@ -780,59 +1553,111 @@ deep_learning = function() {
# --- 6.5: Render Historical Plot UI (Dropdown) ---
output$history_metric_selector_ui <- renderUI({
df <- tryCatch(history_metrics_for_plotting(), error = function(e) NULL)
-
+
if (is.null(df) || nrow(df) == 0) {
return(p("No evaluation metrics found for this job."))
}
-
- metric_names <- names(df)[sapply(df, is.numeric) & !names(df) %in% c("epoch", "step", "runtime", "samples_per_second", "steps_per_second")]
-
+
+ metric_names <- names(df)[sapply(df, is.numeric) & !names(df) %in% c("epoch", "step", "runtime", "samples_per_second", "steps_per_second", "plot_group")]
+
default_metric <- "eval_loss"
if (!"eval_loss" %in% metric_names && length(metric_names) > 0) {
default_metric <- metric_names[1]
}
-
+
selected_val <- input$history_selected_metric
if (is.null(selected_val) || !selected_val %in% metric_names) {
selected_val <- default_metric
}
-
- selectInput("history_selected_metric", "Select Metric to Plot:",
- choices = metric_names,
- selected = selected_val)
+
+ selectInput("history_selected_metric", "Select Metric to Plot:",
+ choices = metric_names,
+ selected = selected_val
+ )
+ })
+
+
+ # ==============================================================================
+ # == 7. INFERENCE LOGIC
+ # ==============================================================================
+
+ # --- 7.1: Fetch Completed Jobs for Inference Dropdown ---
+ observe({
+ # Trigger when Inference tab is active
+ req(input$main_tabs == "Prediction")
+
+ tryCatch(
+ {
+ # Fetch ALL completed jobs (no other filters to ensure we get all candidates)
+ req <- request(paste0(api_url, "/jobs/list")) %>%
+ req_url_query(status = "completed")
+ resp <- req_perform(req)
+ all_completed <- resp_body_json(resp, simplifyVector = TRUE)
+
+ if (length(all_completed) > 0 && is.data.frame(all_completed) && nrow(all_completed) > 0) {
+ # Filter for Object Detection
+ obj_runs <- all_completed %>%
+ filter(task_type == "object_detection") %>%
+ pull(run_name)
+ updateSelectInput(session, "infer_run_name", choices = obj_runs, selected = if (length(obj_runs) > 0) obj_runs[1] else "")
+
+ # Filter for Image Class
+ img_runs <- all_completed %>%
+ filter(task_type == "image_classification") %>%
+ pull(run_name)
+ updateSelectInput(session, "infer_img_class_run_name", choices = img_runs, selected = if (length(img_runs) > 0) img_runs[1] else "")
+
+ # Filter for Segmentation
+ seg_runs <- all_completed %>%
+ filter(task_type == "semantic_segmentation") %>%
+ pull(run_name)
+ updateSelectInput(session, "infer_seg_run_name", choices = seg_runs, selected = if (length(seg_runs) > 0) seg_runs[1] else "")
+ } else {
+ # No completed jobs found
+ updateSelectInput(session, "infer_run_name", choices = "No completed jobs", selected = "")
+ updateSelectInput(session, "infer_img_class_run_name", choices = "No completed jobs", selected = "")
+ updateSelectInput(session, "infer_seg_run_name", choices = "No completed jobs", selected = "")
+ }
+ },
+ error = function(e) {
+ print(paste("Error fetching inference runs:", e$message))
+ }
+ )
})
# --- 6.6: Render Historical Plot ---
output$history_metric_plot <- renderDygraph({
df <- tryCatch(history_metrics_for_plotting(), error = function(e) NULL)
-
+
if (is.null(df) || nrow(df) == 0) {
- return(dygraph(data.frame(x=c(0), y=c(0)), main = "No Metric Data") %>%
- dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE) %>%
- dyAxis("x", label = "Epoch"))
+ return(dygraph(data.frame(x = c(0), y = c(0)), main = "No Metric Data") %>%
+ dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE) %>%
+ dyAxis("x", label = "Epoch"))
}
- req(input$history_selected_metric)
+ req(input$history_selected_metric)
req(input$history_selected_metric %in% names(df))
-
+
metric_to_plot <- input$history_selected_metric
-
+
if (!"epoch" %in% names(df) || !metric_to_plot %in% names(df)) {
- return(dygraph(data.frame(x=c(0), y=c(0)), main = "Metric data not yet available") %>%
- dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE))
+ return(dygraph(data.frame(x = c(0), y = c(0)), main = "Metric data not yet available") %>%
+ dyOptions(drawGrid = FALSE, drawAxes = FALSE, drawYAxis = FALSE, drawXAxis = FALSE))
}
plot_data <- df[, c("epoch", metric_to_plot)]
-
+
dygraph(plot_data, main = paste(metric_to_plot, "vs. Epoch")) %>%
dySeries(metric_to_plot, label = metric_to_plot) %>%
dyAxis("x", label = "Epoch", valueRange = c(0, max(df$epoch, na.rm = TRUE) + 1)) %>%
dyRangeSelector() %>%
- dyOptions(stackedGraph = FALSE,
- fillGraph = FALSE,
- stepPlot = FALSE,
- drawPoints = TRUE,
- pointSize = 4) %>%
+ dyOptions(
+ stackedGraph = FALSE,
+ fillGraph = FALSE,
+ stepPlot = FALSE,
+ drawPoints = TRUE,
+ pointSize = 4
+ ) %>%
dyLegend(show = "always", width = 200)
})
@@ -845,187 +1670,270 @@ deep_learning = function() {
!is.null(input$history_job_selector),
nchar(input$history_job_selector) > 0
)
-
+
# Poll every 3 seconds
invalidateLater(3000, session)
-
+
job_id <- input$history_job_selector
print(paste("History Poller: Fetching metrics for", job_id))
-
- tryCatch({
- req <- request(paste0(api_url, "/metrics/", job_id))
- resp <- req_perform(req)
- if (resp_status(resp) == 200) {
- history_metrics(resp_body_json(resp))
- }
-
- # Check if job is still running
- req_status <- request(paste0(api_url, "/status/", job_id))
- resp_status <- req_perform(req_status)
- if (resp_status(resp_status) == 200) {
- status_data <- resp_body_json(resp_status)
- if (status_data$status != "running") {
- print(paste("History Poller: Job", job_id, "is no longer running. Deactivating poller."))
- history_poller_active(FALSE)
- # Refresh the job list dropdown to show "completed"
- observeEvent(model_registry(), {
- req(model_registry())
- refresh_data_trigger(refresh_data_trigger() + 1)
- }, once = TRUE)
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/metrics/", job_id))
+ resp <- req_perform(req)
+ if (resp_status(resp) == 200) {
+ history_metrics(resp_body_json(resp))
+ }
+
+ # Check if job is still running
+ req_status <- request(paste0(api_url, "/status/", job_id))
+ resp_status <- req_perform(req_status)
+ if (resp_status(resp_status) == 200) {
+ status_data <- resp_body_json(resp_status)
+ if (status_data$status != "running") {
+ print(paste("History Poller: Job", job_id, "is no longer running. Deactivating poller."))
+ history_poller_active(FALSE)
+ # Refresh the job list dropdown to show "completed"
+ observeEvent(model_registry(),
+ {
+ req(model_registry())
+ refresh_data_trigger(refresh_data_trigger() + 1)
+ },
+ once = TRUE
+ )
+ }
}
+ },
+ error = function(e) {
+ print(paste("History Poller Error:", e$message))
+ history_poller_active(FALSE) # Stop polling on error
}
-
- }, error = function(e) {
- print(paste("History Poller Error:", e$message))
- history_poller_active(FALSE) # Stop polling on error
- })
+ )
})
-
-
+
+
# ==============================================================================
# == 7. "INFERENCE" TAB LOGIC
# ==============================================================================
-
- # --- 7.1: Inference Checkpoint Finders ---
- observeEvent(input$infer_run_name, {
- run_name <- input$infer_run_name
- if (nchar(run_name) > 2) {
- tryCatch({
- req <- request(paste0(api_url, "/checkpoints")) %>%
- req_url_query(run_name = run_name, task_type = "object_detection")
+
+ # --- 7.0: Populate Runs for Prediction ---
+ observeEvent(input$inference_task_selector, {
+ task <- input$inference_task_selector
+ req(task)
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/jobs/list")) %>%
+ req_headers("X-API-Key" = api_key)
resp <- req_perform(req)
if (resp_status(resp) == 200) {
- checkpoints <- resp_body_json(resp, simplifyVector = TRUE)
- updateSelectInput(session, "infer_checkpoint_dropdown", choices = checkpoints)
+ jobs <- resp_body_json(resp, simplifyVector = TRUE)
+
+ # Filter by Task and Status=Completed
+ if (!is.null(jobs) && is.data.frame(jobs) && nrow(jobs) > 0) {
+ jobs <- jobs[jobs$task_type == task & jobs$status == "completed", ]
+
+ if (nrow(jobs) > 0) {
+ # Create choices: run_name (id)
+ choices <- setNames(jobs$run_name, paste0(jobs$run_name, " (", substr(jobs$id, 1, 8), ")"))
+
+ # Update specific input
+ if (task == "object_detection") {
+ updateSelectInput(session, "infer_run_name", choices = choices)
+ } else if (task == "image_classification") {
+ updateSelectInput(session, "infer_img_class_run_name", choices = choices)
+ } else if (task == "semantic_segmentation") {
+ updateSelectInput(session, "infer_seg_run_name", choices = choices)
+ }
+ } else {
+ # No completed jobs
+ msg <- "No completed jobs found"
+ if (task == "object_detection") {
+ updateSelectInput(session, "infer_run_name", choices = c("No jobs found" = ""))
+ } else if (task == "image_classification") {
+ updateSelectInput(session, "infer_img_class_run_name", choices = c("No jobs found" = ""))
+ } else if (task == "semantic_segmentation") updateSelectInput(session, "infer_seg_run_name", choices = c("No jobs found" = ""))
+ }
+ }
}
- }, error = function(e) {
- updateSelectInput(session, "infer_checkpoint_dropdown", choices = c("Error finding checkpoints"))
- })
- }
+ },
+ error = function(e) {
+ print(paste("Error fetching runs:", e$message))
+ }
+ )
})
-
- observeEvent(input$infer_asr_run_name, {
- run_name <- input$infer_asr_run_name
- if (nchar(run_name) > 2) {
- tryCatch({
+
+ # --- Inference Event Debounce Logic ---
+ debounced_infer_obj_run_name <- reactive(input$infer_run_name) %>% debounce(500)
+ debounced_infer_img_class_run_name <- reactive(input$infer_img_class_run_name) %>% debounce(500)
+ debounced_infer_seg_run_name <- reactive(input$infer_seg_run_name) %>% debounce(500)
+
+ # --- 7.1: Inference Checkpoint Finders ---
+ observeEvent(debounced_infer_obj_run_name(), {
+ run_name <- debounced_infer_obj_run_name()
+ req(nchar(run_name) > 2) # Require at least 3 chars
+ tryCatch(
+ {
req <- request(paste0(api_url, "/checkpoints")) %>%
- req_url_query(run_name = run_name, task_type = "asr")
+ req_url_query(run_name = run_name, task_type = "object_detection")
resp <- req_perform(req)
if (resp_status(resp) == 200) {
checkpoints <- resp_body_json(resp, simplifyVector = TRUE)
- updateSelectInput(session, "infer_asr_checkpoint_dropdown", choices = checkpoints)
+ if (length(checkpoints) > 0) {
+ # Create friendly relative labels: run-ver/checkpoint
+ # Extract part after 'model_outputs/'
+ lbls <- sub(".*model_outputs/", "", checkpoints)
+
+ # Add explicit "best.pt" context for YOLO if it's the root dir
+ lbls <- sapply(lbls, function(stat) {
+ if (!grepl("weights", stat) && !grepl("checkpoint-", stat)) paste0(stat, "/best.pt") else stat
+ })
+ names(checkpoints) <- lbls
+
+ # FILTER: STRICTLY show ONLY Final Models (exclude intermediate checkpoints)
+ keep_mask <- !grepl("checkpoint-", checkpoints)
+ checkpoints <- checkpoints[keep_mask]
+ }
+ updateSelectInput(session, "infer_checkpoint_dropdown", choices = checkpoints)
}
- }, error = function(e) {
- updateSelectInput(session, "infer_asr_checkpoint_dropdown", choices = c("Error finding checkpoints"))
- })
- }
+ },
+ error = function(e) {
+ updateSelectInput(session, "infer_checkpoint_dropdown", choices = c("Error finding checkpoints"))
+ }
+ )
})
- observeEvent(input$infer_img_class_run_name, {
- run_name <- input$infer_img_class_run_name
- if (nchar(run_name) > 2) {
- tryCatch({
+
+ observeEvent(debounced_infer_img_class_run_name(), {
+ run_name <- debounced_infer_img_class_run_name()
+ req(nchar(run_name) > 2)
+ tryCatch(
+ {
req <- request(paste0(api_url, "/checkpoints")) %>%
req_url_query(run_name = run_name, task_type = "image_classification")
checkpoints <- resp_body_json(req_perform(req), simplifyVector = TRUE)
+ if (length(checkpoints) > 0) {
+ # Create friendly relative labels: run-ver/checkpoint
+ lbls <- sub(".*model_outputs/", "", checkpoints)
+ lbls <- sapply(lbls, function(stat) {
+ if (!grepl("checkpoint-", stat)) paste0(stat, "/best_model") else stat
+ })
+ names(checkpoints) <- lbls
+
+ # FILTER: Remove intermediate checkpoints
+ checkpoints <- checkpoints[!grepl("checkpoint-", checkpoints)]
+ }
updateSelectInput(session, "infer_img_class_checkpoint_dropdown", choices = checkpoints)
- }, error = function(e) { })
- }
+ },
+ error = function(e) {}
+ )
})
-
- observeEvent(input$infer_seg_run_name, {
- run_name <- input$infer_seg_run_name
- if (nchar(run_name) > 2) {
- tryCatch({
+
+ observeEvent(debounced_infer_seg_run_name(), {
+ run_name <- debounced_infer_seg_run_name()
+ req(nchar(run_name) > 2)
+ tryCatch(
+ {
req <- request(paste0(api_url, "/checkpoints")) %>%
- req_url_query(run_name = run_name, task_type = "image_segmentation")
+ req_url_query(run_name = run_name, task_type = "semantic_segmentation")
checkpoints <- resp_body_json(req_perform(req), simplifyVector = TRUE)
+ if (length(checkpoints) > 0) {
+ # Create friendly relative labels: run-ver/checkpoint
+ lbls <- sub(".*model_outputs/", "", checkpoints)
+ lbls <- sapply(lbls, function(stat) {
+ if (!grepl("checkpoint-", stat)) paste0(stat, "/best_model") else stat
+ })
+ names(checkpoints) <- lbls
+
+ # FILTER: Remove intermediate checkpoints
+ checkpoints <- checkpoints[!grepl("checkpoint-", checkpoints)]
+ }
updateSelectInput(session, "infer_seg_checkpoint_dropdown", choices = checkpoints)
- }, error = function(e) { })
- }
+ },
+ error = function(e) {}
+ )
})
# --- 7.2: Inference Job Submission (One per task) ---
-
+
observeEvent(input$start_obj_inference, {
- req(input$infer_obj_image_upload); req(input$infer_checkpoint_dropdown)
+ req(input$infer_obj_image_upload)
+ req(input$infer_checkpoint_dropdown)
obj_inference_result(list(status = "Running...", image_url = NULL, error = NULL))
- tryCatch({
- req <- request(paste0(api_url, "/inference/object-detection")) %>%
- req_body_multipart(
- image = curl::form_file(input$infer_obj_image_upload$datapath),
- model_checkpoint = input$infer_checkpoint_dropdown,
- threshold = as.character(input$infer_obj_threshold),
- iou = as.character(input$infer_obj_iou),
- max_det = as.character(input$infer_obj_max_det)
- )
- resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- obj_inference_result(list(status = "Success", image_url = resp_data$output_url, error = NULL))
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- obj_inference_result(list(status = "Error", image_url = NULL, error = error_message))
- })
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/inference/object-detection")) %>%
+ req_headers("X-API-Key" = api_key) %>%
+ req_body_multipart(
+ image = curl::form_file(input$infer_obj_image_upload$datapath),
+ model_checkpoint = input$infer_checkpoint_dropdown,
+ threshold = as.character(input$infer_obj_threshold),
+ iou = as.character(input$infer_obj_iou),
+ max_det = as.character(input$infer_obj_max_det),
+ imgsz = as.character(input$infer_obj_imgsz),
+ classes = as.character(input$infer_obj_classes)
+ )
+ resp <- req_perform(req)
+ resp_data <- resp_body_json(resp)
+ obj_inference_result(list(status = "Success", image_url = resp_data$output_url, error = NULL))
+ },
+ error = function(e) {
+ error_message <- as.character(e$message)
+ if (!is.null(e$body)) {
+ error_message <- paste("API Error:", e$body)
+ }
+ obj_inference_result(list(status = "Error", image_url = NULL, error = error_message))
+ }
+ )
})
- observeEvent(input$start_asr_inference, {
- req(input$infer_asr_audio_upload)
- req(input$infer_asr_checkpoint_dropdown)
- asr_inference_result(list(status = "Running...", transcription = "Processing...", error = NULL))
- tryCatch({
- req <- request(paste0(api_url, "/inference/asr")) %>%
- req_body_multipart(
- audio = curl::form_file(input$infer_asr_audio_upload$datapath),
- model_checkpoint = input$infer_asr_checkpoint_dropdown
- )
- resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- asr_inference_result(list(status = "Success", transcription = resp_data$transcription, error = NULL))
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- asr_inference_result(list(status = "Error", transcription = NULL, error = error_message))
- })
- })
-
+
observeEvent(input$start_img_class_inference, {
req(input$infer_img_class_upload, input$infer_img_class_checkpoint_dropdown)
img_class_inference_result(list(status = "Running...", prediction = "Processing...", error = NULL))
- tryCatch({
- req <- request(paste0(api_url, "/inference/image-classification")) %>%
- req_body_multipart(
- image = curl::form_file(input$infer_img_class_upload$datapath),
- model_checkpoint = input$infer_img_class_checkpoint_dropdown
- )
- resp_data <- resp_body_json(req_perform(req))
- img_class_inference_result(list(status = "Success", prediction = resp_data$prediction, error = NULL))
- }, error = function(e) {
- img_class_inference_result(list(status = "Error", prediction = NULL, error = as.character(e)))
- })
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/inference/image-classification")) %>%
+ req_body_multipart(
+ image = curl::form_file(input$infer_img_class_upload$datapath),
+ model_checkpoint = input$infer_img_class_checkpoint_dropdown
+ )
+ resp_data <- resp_body_json(req_perform(req))
+ img_class_inference_result(list(status = "Success", prediction = resp_data$prediction, error = NULL))
+ },
+ error = function(e) {
+ img_class_inference_result(list(status = "Error", prediction = NULL, error = as.character(e)))
+ }
+ )
})
-
+
observeEvent(input$start_seg_inference, {
- req(input$infer_seg_image_upload); req(input$infer_seg_checkpoint_dropdown)
+ req(input$infer_seg_image_upload)
+ req(input$infer_seg_checkpoint_dropdown)
seg_inference_result(list(status = "Running...", image_url = NULL, error = NULL))
- tryCatch({
- req <- request(paste0(api_url, "/inference/image-segmentation")) %>%
- req_body_multipart(
- image = curl::form_file(input$infer_seg_image_upload$datapath),
- model_checkpoint = input$infer_seg_checkpoint_dropdown
- )
- resp <- req_perform(req)
- resp_data <- resp_body_json(resp)
- seg_inference_result(list(status = "Success", image_url = resp_data$output_url, error = NULL))
- }, error = function(e) {
- error_message <- as.character(e$message)
- if(!is.null(e$body)) { error_message <- paste("API Error:", e$body) }
- seg_inference_result(list(status = "Error", image_url = NULL, error = error_message))
- })
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/inference/image-segmentation")) %>%
+ req_body_multipart(
+ image = curl::form_file(input$infer_seg_image_upload$datapath),
+ model_checkpoint = input$infer_seg_checkpoint_dropdown
+ )
+ resp <- req_perform(req)
+ resp_data <- resp_body_json(resp)
+ seg_inference_result(list(status = "Success", image_url = resp_data$output_url, error = NULL))
+ },
+ error = function(e) {
+ error_message <- as.character(e$message)
+ if (!is.null(e$body)) {
+ error_message <- paste("API Error:", e$body)
+ }
+ seg_inference_result(list(status = "Error", image_url = NULL, error = error_message))
+ }
+ )
})
-
+
# --- 7.3: Inference UI Outputs ---
-
+
output$inference_status_ui <- renderUI({
res <- obj_inference_result()
if (res$status == "Running...") {
@@ -1034,41 +1942,29 @@ deep_learning = function() {
tags$div(class = "alert alert-danger", HTML(paste("Error:", res$error)))
}
})
- output$inference_image_output <- renderImage({
- res <- obj_inference_result()
- req(res$status == "Success", res$image_url)
- image_url <- paste0(api_url, res$image_url)
- temp_file <- tempfile(fileext = ".jpg")
- download.file(image_url, temp_file, mode = "wb")
- list(src = temp_file, contentType = 'image/jpeg', alt = "Inference Result")
- }, deleteFile = TRUE)
-
- output$asr_inference_status_ui <- renderUI({
- res <- asr_inference_result()
- if (res$status == "Running...") {
- tags$div(class = "alert alert-info", "Running inference...")
- } else if (res$status == "Error") {
- tags$div(class = "alert alert-danger", HTML(paste("Error:", res$error)))
- }
- })
- output$asr_transcription_output <- renderText({
- res <- asr_inference_result()
- if (is.null(res$transcription)) {
- "Upload an audio file and click 'Run Inference' to see the transcription here."
- } else {
- res$transcription
- }
- })
+ output$inference_image_output <- renderImage(
+ {
+ res <- obj_inference_result()
+ req(res$status == "Success", res$image_url)
+ image_url <- paste0(api_url, res$image_url)
+ temp_file <- tempfile(fileext = ".jpg")
+ download.file(image_url, temp_file, mode = "wb")
+ list(src = temp_file, contentType = "image/jpeg", alt = "Inference Result")
+ },
+ deleteFile = TRUE
+ )
+
output$img_class_inference_status_ui <- renderUI({
res <- img_class_inference_result()
- if (res$status == "Running...") tags$div(class = "alert alert-info", "Running inference...")
- else if (res$status == "Error") tags$div(class = "alert alert-danger", HTML(paste("Error:", res$error)))
+ if (res$status == "Running...") {
+ tags$div(class = "alert alert-info", "Running inference...")
+ } else if (res$status == "Error") tags$div(class = "alert alert-danger", HTML(paste("Error:", res$error)))
})
output$img_class_prediction_output <- renderText({
img_class_inference_result()$prediction
})
-
+
output$seg_inference_status_ui <- renderUI({
res <- seg_inference_result()
if (res$status == "Running...") {
@@ -1077,13 +1973,71 @@ deep_learning = function() {
tags$div(class = "alert alert-danger", HTML(paste("Error:", res$error)))
}
})
- output$seg_inference_image_output <- renderImage({
- res <- seg_inference_result()
- req(res$status == "Success", res$image_url)
- image_url <- paste0(api_url, res$image_url)
- temp_file <- tempfile(fileext = ".jpg")
- download.file(image_url, temp_file, mode = "wb")
- list(src = temp_file, contentType = 'image/jpeg', alt = "Inference Result")
- }, deleteFile = TRUE)
-
-}
\ No newline at end of file
+ output$seg_inference_image_output <- renderImage(
+ {
+ res <- seg_inference_result()
+ req(res$status == "Success", res$image_url)
+ image_url <- paste0(api_url, res$image_url)
+ temp_file <- tempfile(fileext = ".jpg")
+ download.file(image_url, temp_file, mode = "wb")
+ list(src = temp_file, contentType = "image/jpeg", alt = "Inference Result")
+ },
+ deleteFile = TRUE
+ )
+
+
+ # ==============================================================================
+ # == 8. SYSTEM HEALTH MONITORING
+ # ==============================================================================
+
+
+ observe({
+ # Poll every 5 seconds
+ invalidateLater(5000, session)
+
+ # Only poll if we are on the deep learning tab
+ # req(input$tabs == "cnndeep") # Optional, saves bandwidth if other tabs open
+
+ tryCatch(
+ {
+ req <- request(paste0(api_url, "/system/health"))
+ resp <- req_perform(req)
+ data <- resp_body_json(resp)
+ health_data(data)
+ },
+ error = function(e) {
+ health_data(NULL)
+ }
+ )
+ })
+
+ output$status_cpu_box <- renderInfoBox({
+ d <- health_data()
+ val <- if (is.null(d)) "..." else paste0(d$cpu$percent, "%")
+ infoBox("CPU Usage", val, icon = icon("microchip"), color = "aqua", fill = TRUE)
+ })
+
+ output$status_ram_box <- renderInfoBox({
+ d <- health_data()
+ val <- if (is.null(d)) "..." else paste0(d$ram$percent, "%")
+ infoBox("RAM Usage", val, icon = icon("memory"), color = "purple", fill = TRUE)
+ })
+
+ output$status_disk_box <- renderInfoBox({
+ d <- health_data()
+ val <- if (is.null(d)) "..." else paste0(d$disk$percent, "%")
+ infoBox("Disk Usage", val, icon = icon("hdd"), color = "yellow", fill = TRUE)
+ })
+
+ output$status_gpu_box <- renderInfoBox({
+ d <- health_data()
+ if (is.null(d) || length(d$gpu) == 0) {
+ infoBox("GPU", "None", icon = icon("desktop"), color = "red", fill = TRUE)
+ } else {
+ # Show utilization of the first GPU
+ first_gpu <- d$gpu[[1]]
+ val <- paste0(first_gpu$utilization, "%")
+ infoBox(first_gpu$name, val, icon = icon("bolt"), color = "green", fill = TRUE)
+ }
+ })
+}
diff --git a/ui.R b/ui.R
index ced999e..2ddcef0 100644
--- a/ui.R
+++ b/ui.R
@@ -1,5 +1,5 @@
-#Only UI files and R packages should be included
-#Load R packages
+# Only UI files and R packages should be included
+# Load R packages
source(paste0(getwd(), "/ui/load_r_packages.R"))
## Language change utilities
@@ -14,85 +14,81 @@ source("ui/train_model_ui.R")
# Load UI function before deploy_model_ui()
source("ui/deploy_model_ui.R")
-#Load Headertag
+# Load Headertag
source(paste0(getwd(), "/ui/login_credentials.R"))
source(paste0(getwd(), "/ui/headertag.R"))
-#Load App Theme
+# Load App Theme
source(paste0(getwd(), "/ui/appTheme.R"))
-#Load Header
+# Load Header
source(paste0(getwd(), "/ui/header.R"))
-#Load Footer
+# Load Footer
source(paste0(getwd(), "/ui/footer.R"))
source(paste0(getwd(), "/ui/homepage.R"))
source("ui/dashboard_body.R")
-#Sidebar
+# Sidebar
aphrcSiderbar <- dashboardSidebar(
width = "20%",
- #menuItemOutput("dynamic_meinu_aphrc"),
+ # menuItemOutput("dynamic_meinu_aphrc"),
sidebarMenuOutput("dynamic_meinu_aphrc")
- #menuItem("AutoML", tabName = "automl_tab", icon = icon("robot"))
-
+ # menuItem("AutoML", tabName = "automl_tab", icon = icon("robot"))
)
-#Body
+# Body
fluidPage(
useShinyjs(),
useWaiter(),
-
waiterShowOnLoad(
color = "#FFF",
- html = spin_loaders(id = 2, style="width:56px;height:56px;color:#7BC148;"),
- logo= "WWW/aphrc.png"),
-
- div(
- id = "auth_wrapper1", # <– will be shown after spinner
- login::is_logged_in(
- id = app_login_config$APP_ID, header
- ),
-
- aphrcHeader <- dashboardHeader(disable = TRUE),
-
- login::is_not_logged_in(
- id = app_login_config$APP_ID,
+ html = spin_loaders(id = 2, style = "width:56px;height:56px;color:#7BC148;"),
+ logo = "WWW/aphrc.png"
+ ),
+ div(
+ id = "auth_wrapper1", # <– will be shown after spinner
+ login::is_logged_in(
+ id = app_login_config$APP_ID, header
+ ),
+ aphrcHeader <- dashboardHeader(disable = TRUE),
+ login::is_not_logged_in(
+ id = app_login_config$APP_ID,
+ div(
+ class = "auth-container",
+ br(),
+ div(
+ class = "auth-title text-center",
+ tags$img(src = "aphrc.png", height = "80px", style = "margin-bottom: 15px;"),
+ h3("Welcome to Nocode Platform")
+ ),
+ div(
+ class = "toggle-buttons",
+ actionButton("show_login", "Login", class = "btn btn-outline-success"),
+ actionButton("show_signup", "Sign Up", class = "btn btn-outline-success"),
+ actionButton("show_reset", "Reset Password", class = "btn btn-outline-success")
+ ),
+ div(
+ id = "login_form",
+ login::login_ui(id = app_login_config$APP_ID)
+ ),
div(
- class = "auth-container",
- br(),
- div(
- class = "auth-title text-center",
- tags$img(src = "aphrc.png", height = "80px", style = "margin-bottom: 15px;"),
- h3("Welcome to Nocode Platform")
- ),
- div(
- class = "toggle-buttons",
- actionButton("show_login", "Login", class = "btn btn-outline-success"),
- actionButton("show_signup", "Sign Up", class = "btn btn-outline-success"),
- actionButton("show_reset", "Reset Password", class = "btn btn-outline-success")
- ),
- div(id = "login_form",
- login::login_ui(id = app_login_config$APP_ID)
- ),
- div(id = "signup_form", style = "display:none;",
- login::new_user_ui(id = app_login_config$APP_ID)
- ),
- div(id = "reset_form", style = "display:none;",
- login::reset_password_ui(id = app_login_config$APP_ID)
- )
+ id = "signup_form", style = "display:none;",
+ login::new_user_ui(id = app_login_config$APP_ID)
+ ),
+ div(
+ id = "reset_form", style = "display:none;",
+ login::reset_password_ui(id = app_login_config$APP_ID)
)
- ),
-
- login::is_logged_in(
- id = app_login_config$APP_ID,
- div(dashboardPage(aphrcHeader, aphrcSiderbar, aphrcBody, skin = "green"))
- ),
-
- login::is_logged_in(
- id = app_login_config$APP_ID,
- div(footer)
)
- ))
-
-
+ ),
+ login::is_logged_in(
+ id = app_login_config$APP_ID,
+ div(dashboardPage(aphrcHeader, aphrcSiderbar, aphrcBody, skin = "green"))
+ ),
+ login::is_logged_in(
+ id = app_login_config$APP_ID,
+ div(footer)
+ )
+ )
+)
diff --git a/ui/deeplearning_ui.R b/ui/deeplearning_ui.R
index cdc356a..b62bb5c 100644
--- a/ui/deeplearning_ui.R
+++ b/ui/deeplearning_ui.R
@@ -7,775 +7,489 @@ library(dygraphs)
# Helper function to create a collapsible section
collapsible_panel <- function(title, ..., open = FALSE) {
- tags$details(
- open = if (open) NA else NULL,
- tags$summary(title, style = "font-weight: bold; cursor: pointer; margin-top: 15px;"),
- div(style = "padding: 10px; border: 1px solid #ddd; border-radius: 5px; margin-top: 5px;", ...
+ tags$details(
+ open = if (open) NA else NULL,
+ tags$summary(title, style = "font-weight: bold; cursor: pointer; margin-top: 15px;"),
+ div(style = "padding: 10px; border: 1px solid #ddd; border-radius: 5px; margin-top: 5px;", ...)
)
- )
}
+# Helper to create label with help icon
+label_with_help <- function(label, tooltip) {
+ tagList(
+ label,
+ tags$i(class = "fa fa-question-circle text-info", style = "margin-left: 5px;", title = tooltip)
+ )
+}
+
+deeplearning_ui <- function() {
+ tabItem(
+ tabName = "cnndeep",
+ fluidRow(
+ useShinyjs(),
+ fluidRow(
+ column(
+ width = 12,
+ box(
+ title = "System Health", status = "success", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE, width = NULL,
+ fluidRow(
+ infoBoxOutput("status_cpu_box", width = 3),
+ infoBoxOutput("status_ram_box", width = 3),
+ infoBoxOutput("status_disk_box", width = 3),
+ infoBoxOutput("status_gpu_box", width = 3)
+ )
+ )
+ )
+ ),
+
+ # --- Main Tabset Interface ---
+ tabsetPanel(
+ id = "main_tabs",
+
+ # --- Tab 1: Job Manager (Dashboard) ---
+ tabPanel(
+ "Job Manager",
+ fluidRow(
+ column(
+ width = 4,
+ box(
+ width = NULL, title = "Job Explorer", status = "success", solidHeader = TRUE,
+ fluidRow(
+ column(4, selectInput("jm_task_filter", label_with_help("Task", "Filter jobs by task type."),
+ choices = c("All", "Object Detection" = "object_detection", "Image Classification" = "image_classification", "Semantic Segmentation" = "semantic_segmentation")
+ )),
+ column(4, selectInput("jm_status_filter", label_with_help("Status", "Filter jobs by execution status."),
+ choices = c("All", "Running", "Completed", "Failed")
+ )),
+ column(4, selectInput("jm_show_entries", label_with_help("Show", "Number of entries to show."),
+ choices = c(5, 10, 25, 50, 100), selected = 5
+ ))
+ ),
+ DTOutput("job_manager_table")
+ )
+ ),
+ column(
+ width = 8,
+ # Static container for Live Metrics (only shown when running) - Prevents dropdown glitches
+ conditionalPanel(
+ condition = "output.is_job_running == true",
+ box(
+ width = NULL, title = "Live Metrics", status = "primary", solidHeader = TRUE, collapsible = TRUE,
+ selectInput("selected_metric", "Select Metric to Plot:", choices = NULL),
+ dygraphOutput("dynamic_metric_plot", height = "300px")
+ )
+ ),
+ uiOutput("job_manager_details_ui")
+ )
+ )
+ ),
+
+ # --- Tab 2: New Training (Wizard) ---
+ tabPanel(
+ "New Training",
+ fluidRow(
+ column(
+ width = 10, offset = 1,
+
+ # --- Wizard Progress Indicator ---
+ div(
+ style = "margin-bottom: 20px; text-align: center;",
+ h3("Training Configuration")
+ ),
+ box(
+ width = NULL, solidHeader = TRUE, status = "success", title = uiOutput("wizard_step_title"),
+
+ # --- Wizard Steps (Hidden Tabset) ---
+ tabsetPanel(
+ id = "wizard_tabs", type = "hidden", selected = "step1",
+
+ # === STEP 1: Task & Data ===
+ tabPanel(
+ "step1",
+ selectInput("task_selector", label_with_help("Select Task", "Choose the Deep Learning task you want to perform."),
+ choices = c(
+ "Object Detection" = "object_detection",
+ "Image Classification" = "image_classification",
+ "Semantic Segmentation" = "semantic_segmentation"
+ )
+ ),
+ hr(style = "border-color: #7BC148;"),
+ # -- Object Detection Data --
+ conditionalPanel(
+ condition = "input.task_selector == 'object_detection'",
+ selectInput("obj_dataset_id", label_with_help("Select Dataset", "Choose a registered dataset for training."), choices = c("Loading..." = ""))
+ ),
+
+ # -- Image Classification Data --
+ conditionalPanel(
+ condition = "input.task_selector == 'image_classification'",
+ selectInput("img_class_dataset_id", label_with_help("Select Dataset", "Choose a registered dataset for training."), choices = c("Loading..." = ""))
+ ),
+ # -- Segmentation Data --
+ conditionalPanel(
+ condition = "input.task_selector == 'semantic_segmentation'",
+ selectInput("seg_dataset_id", label_with_help("Select Dataset", "Choose a registered dataset for training."), choices = c("Loading..." = ""))
+ ),
+ br(),
+ div(class = "text-right", actionButton("wiz_next_1", "Model Setup", icon = icon("arrow-right"), class = "btn btn-success"))
+ ),
+
+ # === STEP 2: Model & Architecture ===
+ tabPanel(
+ "step2",
-deeplearning_ui = function() {
- tabItem(tabName = "cnndeep",
- fluidRow(
- useShinyjs(),
-
- sidebarLayout(
- sidebarPanel(
- width = 4,
- h4("Task Configuration"),
- selectInput("task_selector", "Select Task:",
- choices = c("Object Detection" = "object_detection",
- "ASR" = "asr",
- "Image Classification" = "image_classification",
- "Image Segmentation" = "image_segmentation")
- ),
-
- # --- Object Detection Training UI ---
- shinyjs::hidden(
- div(
- id = "obj_panel",
- h5("Object Detection Training", style="font-weight:bold; margin-top:20px; border-bottom: 1px solid #ddd; padding-bottom: 5px;"),
- collapsible_panel("Paths & Naming", open = TRUE,
- selectInput("obj_dataset_id", "Select Dataset", choices = c("Loading..." = "")),
- selectInput("obj_model_arch", "Select Architecture", choices = c("Loading..." = "")),
- selectInput("obj_model_checkpoint", "Select Checkpoint", choices = NULL),
- textInput("obj_run_name", "Run Name", "shiny-obj-run"),
- textInput("obj_version", "Version", "1.0.0")
- ),
- # --- Training Parameters (Conditional) ---
- # These are for Transformers-based models
- conditionalPanel(
- condition = "input.obj_model_arch != 'YOLO'",
- collapsible_panel("Training Parameters (Transformers)", open = FALSE,
- numericInput("obj_learning_rate", "Learning Rate", 5e-5, step = 1e-6),
- numericInput("obj_weight_decay", "Weight Decay", 1e-4, step = 1e-5),
- numericInput("obj_gradient_accumulation_steps", "Gradient Accumulation", 1, min = 1),
- numericInput("obj_max_grad_norm", "Max Gradient Norm", 1.0, min = 0.1, step = 0.1)
- )
- ),
- # --- NEW: YOLO-specific Parameters ---
- conditionalPanel(
- condition = "input.obj_model_arch == 'YOLO'",
- collapsible_panel("Training Parameters (YOLO)", open = FALSE,
- # --- ADDED NEW INPUTS ---
- numericInput("obj_yolo_warmup_epochs", "Warmup Epochs", 3.0, min = 0, step = 0.1),
- numericInput("obj_yolo_lr0", "Initial Learning Rate (lr0)", 0.01, min = 0, step = 0.001),
- numericInput("obj_yolo_momentum", "Momentum", 0.937, min = 0, step = 0.001),
- selectInput("obj_yolo_optimizer", "Optimizer", choices = c("auto", "SGD", "Adam", "AdamW")),
- numericInput("obj_yolo_weight_decay", "Weight Decay", 0.0005, min = 0, step = 1e-5)
- )
- ),
- # --- Common Training Parameters ---
- collapsible_panel("Common Training Parameters", open = FALSE,
- numericInput("obj_epochs", "Epochs", 5, min = 1),
- numericInput("obj_train_batch_size", "Train Batch Size", 8, min = 1),
- numericInput("obj_eval_batch_size", "Eval Batch Size", 8, min = 1),
- numericInput("obj_max_image_size", "Max Image Size", 600, min = 128)
- ),
- collapsible_panel("Execution & Reproducibility", open = FALSE,
- numericInput("obj_seed", "Seed", 42),
- numericInput("obj_num_proc", "Number of Processes", 4, min = 0),
- checkboxInput("obj_force_preprocess", "Force Data Pre-processing", value = FALSE),
- conditionalPanel(
- condition = "input.obj_model_arch != 'YOLO'",
- checkboxInput("obj_gradient_checkpointing", "Enable Gradient Checkpointing (Saves Memory)", value = FALSE),
- checkboxInput("obj_fp16", "Use FP16 Precision (Unstable)", value = TRUE)
- )
- ),
- collapsible_panel("Saving & Early Stopping", open = FALSE,
- numericInput("obj_early_stopping_patience", "Early Stopping Patience", 5),
- conditionalPanel(
- condition = "input.obj_model_arch != 'YOLO'",
- numericInput("obj_early_stopping_threshold", "Early Stopping Threshold", 0.0, step = 1e-4)
- )
- ),
- collapsible_panel("Hub & Logging", open = FALSE,
- checkboxInput("obj_push_to_hub", "Push to Hub", FALSE),
- conditionalPanel(
- condition = "input.obj_push_to_hub == true",
- textInput("obj_hub_user_id", "Hub User/Org Name", "")
- ),
- checkboxInput("obj_log_to_wandb", "Log to W&B", FALSE),
- conditionalPanel(
- condition = "input.obj_log_to_wandb == true",
- textInput("obj_wandb_project", "W&B Project", ""),
- textInput("obj_wandb_entity", "W&B Entity", "")
- )
- ),
- actionButton("start_obj_job", "Start Object Detection Job", class = "btn-primary", style="margin-top: 15px; width: 100%;")
- )
- ),
-
- # --- ASR Training UI ---
- shinyjs::hidden(
- div(
- id = "asr_panel",
- h5("ASR Training", style="font-weight:bold; margin-top:20px; border-bottom: 1px solid #ddd; padding-bottom: 5px;"),
- collapsible_panel("Paths & Naming", open = TRUE,
- selectInput("asr_dataset_id", "Select Dataset", choices = c("Loading..." = "")),
- selectInput("asr_model_arch", "Select Architecture", choices = c("Loading..." = "")),
- selectInput("asr_model_checkpoint", "Select Checkpoint", choices = NULL),
- textInput("asr_run_name", "Run Name", "shiny-asr-run"),
- textInput("asr_version", "Version", "1.0.0")
- ),
- collapsible_panel("Data Splitting", open = FALSE,
- checkboxInput("asr_is_presplit", "Is Data Pre-Split?", TRUE),
- conditionalPanel(
- condition = "input.asr_is_presplit == false",
- checkboxInput("asr_speaker_disjointness", "Ensure Speaker Disjoint Split (if not pre-split)", FALSE),
- numericInput("asr_train_ratio", "Train Ratio", 0.8, min = 0, max = 1),
- numericInput("asr_dev_ratio", "Dev Ratio", 0.1, min = 0, max = 1),
- numericInput("asr_test_ratio", "Test Ratio", 0.1, min = 0, max = 1)
- )
- ),
- collapsible_panel("Dataset & Language", open = FALSE,
- conditionalPanel(
- condition = "input.asr_model_arch == 'Whisper'",
- textInput("asr_language", "Language (for Whisper)", "english"),
- textInput("asr_language_code", "Language Code (for Whisper)", "en")
- ),
- textInput("asr_speaker_id_column", "Speaker ID Column (for disjoint split)", ""),
- textInput("asr_text_column", "Text/Transcript Column", "sentence")
- ),
- collapsible_panel("Preprocessing & Filtering", open = FALSE,
- numericInput("asr_target_sampling_rate", "Target Sampling Rate", 16000),
- numericInput("asr_min_duration_s", "Min Duration (s)", 1.0),
- numericInput("asr_max_duration_s", "Max Duration (s)", 30.0),
- numericInput("asr_min_transcript_len", "Min Transcript Length", 10),
- numericInput("asr_max_transcript_len", "Max Transcript Length", 300),
- checkboxInput("asr_apply_outlier_filtering", "Apply Outlier Filtering", TRUE),
- conditionalPanel(
- condition = "input.asr_apply_outlier_filtering == true",
- numericInput("asr_outlier_std_devs", "Outlier Std Devs", 2.0)
- )
- ),
- collapsible_panel("Training Parameters", open = FALSE,
- numericInput("asr_max_train_hours", "Max Train Hours (Optional)", value = NA, min = 0),
- numericInput("asr_epochs", "Epochs", 5, min = 1),
- numericInput("asr_learning_rate", "Learning Rate", 3e-4, step = 1e-5),
- selectInput("asr_lr_scheduler_type", "LR Scheduler", choices = c("linear", "cosine", "constant")),
- numericInput("asr_warmup_ratio", "Warmup Ratio", 0.1),
- numericInput("asr_train_batch_size", "Train Batch Size", 16),
- numericInput("asr_eval_batch_size", "Eval Batch Size", 16),
- numericInput("asr_gradient_accumulation_steps", "Gradient Accumulation", 1),
- selectInput("asr_optimizer", "Optimizer", choices = c("adamw_torch", "adamw_hf", "adafactor"))
- ),
- collapsible_panel("Execution & Reproducibility", open = FALSE,
- numericInput("asr_seed", "Seed", 42),
- numericInput("asr_num_proc", "Number of Processes", 8),
- checkboxInput("asr_gradient_checkpointing", "Enable Gradient Checkpointing", value = FALSE)
- ),
- collapsible_panel("Saving & Early Stopping", open = FALSE,
- numericInput("asr_early_stopping_patience", "Early Stopping Patience", 5),
- numericInput("asr_early_stopping_threshold", "Early Stopping Threshold", 1e-3)
- ),
- collapsible_panel("Hub & Logging", open = FALSE,
- checkboxInput("asr_push_to_hub", "Push to Hub", FALSE),
- conditionalPanel(
- condition = "input.asr_push_to_hub == true",
- textInput("asr_hub_user_id", "Hub User/Org Name", ""),
- checkboxInput("asr_hub_private_repo", "Private Hub Repo", FALSE)
- ),
- checkboxInput("asr_log_to_wandb", "Log to W&B", FALSE),
- conditionalPanel(
- condition = "input.asr_log_to_wandb == true",
- textInput("asr_wandb_project", "W&B Project", ""),
- textInput("asr_wandb_entity", "W&B Entity", "")
- )
- ),
- actionButton("start_asr_job", "Start ASR Job", class = "btn-success", style="margin-top: 15px; width: 100%;")
- )
- ),
+ # -- Object Detection Model --
+ conditionalPanel(
+ condition = "input.task_selector == 'object_detection'",
+ selectInput("obj_model_arch", label_with_help("Select Architecture", "Base model architecture to fine-tune."), choices = c("Loading..." = "")),
+ selectInput("obj_model_checkpoint", label_with_help("Select Checkpoint", "Specific pre-trained weights to start from."), choices = NULL),
+ textInput("obj_run_name", label_with_help("Run Name", "Unique identifier for this training run."), "shiny-obj-run"),
+ textInput("obj_version", label_with_help("Version", "Version string for model tracking."), "1.0.0")
+ ),
- # -- Image Classification UI --
- shinyjs::hidden(
- div(
- id = "img_class_panel",
- h5("Image Classification Training", style="font-weight:bold; margin-top:20px; border-bottom: 1px solid #ddd; padding-bottom: 5px;"),
- collapsible_panel("Paths & Naming", open = TRUE,
- selectInput("img_class_dataset_id", "Select Dataset", choices = c("Loading..." = "")),
- selectInput("img_class_model_arch", "Select Architecture", choices = c("Loading..." = "")),
- selectInput("img_class_model_checkpoint", "Select Checkpoint", choices = NULL),
- textInput("img_class_run_name", "Run Name", "shiny-img-class-run"),
- textInput("img_class_version", "Version", "1.0.0")
- ),
- collapsible_panel("Data Splitting", open = FALSE,
- checkboxInput("img_class_is_presplit", "Is Data Pre-Split?", value = TRUE),
- conditionalPanel(
- condition = "input.img_class_is_presplit == false",
- numericInput("img_class_train_ratio", "Train Ratio", 0.8, min = 0, max = 1),
- numericInput("img_class_dev_ratio", "Dev Ratio", 0.1, min = 0, max = 1)
- )
- ),
- collapsible_panel("Training Parameters", open = FALSE,
- numericInput("img_class_epochs", "Epochs", 5, min = 1),
- numericInput("img_class_learning_rate", "Learning Rate", 2e-5, step = 1e-6),
- numericInput("img_class_weight_decay", "Weight Decay", 0.01, step = 1e-3),
- numericInput("img_class_train_batch_size", "Train Batch Size", 32, min = 1),
- numericInput("img_class_eval_batch_size", "Eval Batch Size", 32, min = 1),
- numericInput("img_class_max_image_size", "Max Image Size", 224, min = 64),
- numericInput("img_class_grad_accum", "Gradient Accumulation", 1, min = 1)
- ),
- collapsible_panel("Execution & Reproducibility", open = FALSE,
- numericInput("img_class_seed", "Seed", 42),
- numericInput("img_class_num_proc", "Number of Processes", 4, min = 0),
- checkboxInput("img_class_grad_check", "Enable Gradient Checkpointing", value = FALSE),
- checkboxInput("img_class_fp16", "Use FP16 Precision", value = TRUE)
- ),
- collapsible_panel("Saving & Early Stopping", open = FALSE,
- numericInput("img_class_early_stop", "Early Stopping Patience", 3)
- ),
- collapsible_panel("Hub & Logging", open = FALSE,
- checkboxInput("img_class_push_to_hub", "Push to Hub", FALSE),
- conditionalPanel(
- condition = "input.img_class_push_to_hub == true",
- textInput("img_class_hub_user_id", "Hub User/Org Name", "")
- ),
- checkboxInput("img_class_log_to_wandb", "Log to W&B", FALSE),
- conditionalPanel(
- condition = "input.img_class_log_to_wandb == true",
- textInput("img_class_wandb_project", "W&B Project", ""),
- textInput("img_class_wandb_entity", "W&B Entity", "")
- )
- ),
- actionButton("start_img_class_job", "Start Image Classification Job", class = "btn-warning", style="margin-top: 15px; width: 100%;")
- )
- ),
-
- # --- Image Segmentation Training UI ---
- shinyjs::hidden(
- div(
- id = "seg_panel",
- h5("Image Segmentation Training", style="font-weight:bold; margin-top:20px; border-bottom: 1px solid #ddd; padding-bottom: 5px;"),
- collapsible_panel("Paths & Naming", open = TRUE,
- selectInput("seg_dataset_id", "Select Dataset", choices = c("Loading..." = "")),
- selectInput("seg_model_arch", "Select Architecture", choices = c("Loading..." = "")),
- selectInput("seg_model_checkpoint", "Select Checkpoint", choices = NULL),
- textInput("seg_run_name", "Run Name", "shiny-seg-run"),
- textInput("seg_version", "Version", "1.0.0")
- ),
- collapsible_panel("Data Splitting", open = FALSE,
- checkboxInput("seg_is_presplit", "Is Data Pre-Split?", value = TRUE),
- conditionalPanel(
- condition = "input.seg_is_presplit == false",
- numericInput("seg_train_ratio", "Train Ratio", 0.8, min = 0, max = 1),
- numericInput("seg_dev_ratio", "Dev Ratio", 0.1, min = 0, max = 1)
- )
- ),
- collapsible_panel("Training Parameters", open = FALSE,
- numericInput("seg_epochs", "Epochs", 10, min = 1),
- numericInput("seg_learning_rate", "Learning Rate", 6e-5, step = 1e-6),
- numericInput("seg_weight_decay", "Weight Decay", 0.01, step = 1e-3),
- numericInput("seg_train_batch_size", "Train Batch Size", 8, min = 1),
- numericInput("seg_eval_batch_size", "Eval Batch Size", 8, min = 1),
- numericInput("seg_max_image_size", "Image Size", 512, min = 64),
- numericInput("seg_grad_accum", "Gradient Accumulation", 1, min = 1)
- ),
- collapsible_panel("Execution & Reproducibility", open = FALSE,
- numericInput("seg_seed", "Seed", 42),
- numericInput("seg_num_proc", "Number of Processes", 4, min = 0),
- checkboxInput("seg_grad_check", "Enable Gradient Checkpointing", value = FALSE),
- checkboxInput("seg_fp16", "Use FP16 Precision", value = TRUE)
- ),
- collapsible_panel("Saving & Early Stopping", open = FALSE,
- numericInput("seg_early_stop", "Early Stopping Patience", 5)
- ),
- collapsible_panel("Hub & Logging", open = FALSE,
- checkboxInput("seg_push_to_hub", "Push to Hub", FALSE),
- conditionalPanel(
- condition = "input.seg_push_to_hub == true",
- textInput("seg_hub_user_id", "Hub User/Org Name", "")
- ),
- checkboxInput("seg_log_to_wandb", "Log to W&B", FALSE),
- conditionalPanel(
- condition = "input.seg_log_to_wandb == true",
- textInput("seg_wandb_project", "W&B Project", ""),
- textInput("seg_wandb_entity", "W&B Entity", "")
- )
- ),
- actionButton("start_seg_job", "Start Image Segmentation Job", class = "btn-info", style="margin-top: 15px; width: 100%;")
- )
- )
- ),
-
- mainPanel(
- width = 8,
- tabsetPanel(
- id = "main_tabs",
- type = "tabs",
-
- tabPanel("Data Management",
- h4("Register a New Dataset", style="margin-top:20px;"),
- sidebarLayout(
- sidebarPanel(
- width = 4,
- textInput("new_data_name", "Dataset Name (e.g., 'my-coco-dataset')"),
- selectInput("new_data_task_type", "Task Type",
- choices = c("Object Detection" = "object_detection",
- "ASR" = "asr",
- "Image Classification" = "image_classification",
- "Image Segmentation" = "image_segmentation")
- ),
- fileInput("new_data_zip", "Upload Data (zip file)", accept = ".zip"),
- actionButton("start_data_upload", "Upload and Process Dataset", class = "btn-primary", style="width: 100%;"),
- br(),
- textOutput("data_upload_status")
- ),
- mainPanel(
- width = 8,
- collapsible_panel("View Registered Datasets", open = TRUE,
- p("This table shows datasets that are processed and ready for training."),
- DTOutput("dataset_table")
- )
- )
- )
- ),
-
- tabPanel("Live Training",
-
- tags$details(
- open = TRUE,
- tags$summary("Job Status", style = "font-weight: bold; cursor: pointer; margin-top: 20px;"),
- wellPanel(
- strong("Task:"), textOutput("job_task_display", inline = TRUE), br(),
- strong("Job ID:"), textOutput("job_id_display", inline = TRUE), br(),
- strong("Status:"), textOutput("job_status_display", inline = TRUE)
- )
- ),
-
- tags$details(
- open = FALSE,
- tags$summary("Full Log", style = "font-weight: bold; cursor: pointer; margin-top: 15px;"),
- wellPanel(
- style = "background-color: #f8f9fa; border: 1px solid #dee2e6; border-radius: 5px; padding: 10px; margin-top: 5px; max-height: 400px; overflow-y: auto; font-family: monospace; white-space: pre-wrap;",
- verbatimTextOutput("log_output")
- )
- ),
+ # -- Image Classification Model --
+ conditionalPanel(
+ condition = "input.task_selector == 'image_classification'",
+ selectInput("img_class_model_arch", label_with_help("Select Architecture", "Base model architecture to fine-tune."), choices = c("Loading..." = "")),
+ selectInput("img_class_model_checkpoint", label_with_help("Select Checkpoint", "Specific pre-trained weights to start from."), choices = NULL),
+ textInput("img_class_run_name", label_with_help("Run Name", "Unique identifier for this training run."), "shiny-img-run"),
+ textInput("img_class_version", label_with_help("Version", "Version string for model tracking."), "1.0.0")
+ ),
+ # -- Segmentation Model --
+ conditionalPanel(
+ condition = "input.task_selector == 'semantic_segmentation'",
+ selectInput("seg_model_arch", label_with_help("Select Architecture", "Base model architecture to fine-tune."), choices = c("Loading..." = "")),
+ selectInput("seg_model_checkpoint", label_with_help("Select Checkpoint", "Specific pre-trained weights to start from."), choices = NULL),
+ textInput("seg_run_name", label_with_help("Run Name", "Unique identifier for this training run."), "shiny-seg-run"),
+ textInput("seg_version", label_with_help("Version", "Version string for model tracking."), "1.0.0")
+ ),
+ br(),
+ div(
+ class = "text-right",
+ actionButton("wiz_back_2", "Task & Data", icon = icon("arrow-left"), class = "btn btn-outline-success"),
+ actionButton("wiz_next_2", "Hyperparameters", icon = icon("arrow-right"), class = "btn btn-success")
+ )
+ ),
- tags$details(
- open = FALSE,
- tags$summary("Metrics Table", style = "font-weight: bold; cursor: pointer; margin-top: 15px;"),
- wellPanel(
- DTOutput("eval_table")
- )
- ),
+ # === STEP 3: Hyperparameters ===
+ tabPanel(
+ "step3",
- h4("Live Metric Visualization", style="margin-top: 20px;"),
- wellPanel(
- uiOutput("metric_selector_ui")
- ),
- dygraphOutput("dynamic_metric_plot", height = "600px")
- ),
+ # -- Object Detection Params --
+ conditionalPanel(
+ condition = "input.task_selector == 'object_detection'",
+ collapsible_panel("Basic Configuration",
+ open = TRUE,
+ numericInput("obj_epochs", label_with_help("Epochs", "Number of complete passes through the training dataset."), 5, min = 1),
+ numericInput("obj_train_batch_size", label_with_help("Train Batch Size", "Number of training samples per batch."), 8, min = 1)
+ ),
+ collapsible_panel("Advanced Configuration",
+ open = FALSE,
+ numericInput("obj_max_image_size", label_with_help("Max Image Size", "Resize images to this dimension."), 640, min = 64),
+ numericInput("obj_seed", label_with_help("Random Seed", "Seed for reproducibility."), 42),
+ numericInput("obj_early_stopping_patience", label_with_help("Early Stopping Patience", "Epochs to wait before stopping if no improvement."), 5, min = 1),
- tabPanel("Training History",
- h4("Browse Past Training Jobs", style="margin-top:20px;"),
- wellPanel(
- fluidRow(
- column(6,
- selectInput("history_task_filter", "Filter by Task:",
- choices = c("All" = "all",
- "Object Detection" = "object_detection",
- "ASR" = "asr",
- "Image Classification" = "image_classification",
- "Image Segmentation" = "image_segmentation")
- )
- ),
- column(6,
- selectInput("history_status_filter", "Filter by Status:",
- choices = c("Completed" = "completed",
- "All" = "all",
- "Failed" = "failed",
- "Running" = "running",
- "Queued" = "queued"),
- selected = "completed"
- )
- )
- ),
- selectInput("history_job_selector", "Select a Job to Review:", choices = c("Loading jobs..." = "")),
- textOutput("history_job_details")
- ),
-
- collapsible_panel("Historical Evaluation Results", open = TRUE,
- DTOutput("history_eval_table")
- ),
-
- collapsible_panel("Historical Metrics Plot", open = TRUE,
- wellPanel(
- uiOutput("history_metric_selector_ui")
- ),
- dygraphOutput("history_metric_plot", height = "600px")
- )
- ),
-
- tabPanel("Inference",
- h4("Inference", style="margin-top:20px;"),
- selectInput("inference_task_selector", "Select Inference Task:",
- choices = c("Object Detection" = "object_detection",
- "ASR" = "asr",
- "Image Classification" = "image_classification",
- "Image Segmentation" = "image_segmentation")
- ),
- hr(),
+ # HF Specific
+ conditionalPanel(
+ condition = "input.obj_model_checkpoint.indexOf('.pt') == -1",
+ numericInput("obj_eval_batch_size", label_with_help("Eval Batch Size", "Batch size for validation."), 8, min = 1),
+ numericInput("obj_learning_rate", label_with_help("Learning Rate", "Step size for optimizer."), 5e-5, step = 1e-6),
+ numericInput("obj_weight_decay_hf", label_with_help("Weight Decay", "Regularization factor for Transformers."), 1e-4, step = 0.0001),
+ numericInput("obj_gradient_accumulation_steps", label_with_help("Gradient Accumulation", "Steps to accumulate gradients before update."), 1, min = 1),
+ checkboxInput("obj_gradient_checkpointing", label_with_help("Gradient Checkpointing", "Save memory at cost of speed."), value = FALSE),
+ numericInput("obj_early_stopping_threshold", label_with_help("Early Stop Threshold", "Minimum change to qualify as improvement."), 0.0, step = 0.001),
- conditionalPanel(
- condition = "input.inference_task_selector == 'object_detection'",
- h4("Object Detection Inference"),
- wellPanel(
- textInput("infer_run_name", "Enter Run Name to Find Checkpoints", ""),
- selectInput("infer_checkpoint_dropdown", "Select Checkpoint", choices = NULL),
- fileInput("infer_obj_image_upload", "Upload Image for Detection", accept = c('image/png', 'image/jpeg', 'image/jpg')),
- sliderInput("infer_obj_threshold", "Confidence Threshold", min = 0.01, max = 1.0, value = 0.25, step = 0.01),
- conditionalPanel(
- condition = "input.infer_checkpoint_dropdown && input.infer_checkpoint_dropdown.includes('yolo11')",
- numericInput("infer_obj_iou", "IoU Threshold (NMS)", 0.7, min = 0.01, max = 1.0, step = 0.05),
- numericInput("infer_obj_max_det", "Max Detections", 300, min = 1)
- ),
+ # Added for Production Audit (YOLOS/HF Support)
+ selectInput("obj_optimizer_hf", label_with_help("Optimizer", "Optimizer algorithm."), choices = c("AdamW" = "adamw_torch", "SGD" = "sgd", "Adafactor" = "adafactor"), selected = "adamw_torch"),
+ selectInput("obj_scheduler_hf", label_with_help("LR Scheduler", "Learning rate schedule."), choices = c("Linear" = "linear", "Cosine" = "cosine", "Constant" = "constant"), selected = "linear"),
+ numericInput("obj_warmup_epochs_hf", label_with_help("Warmup Epochs", "Epochs to warm up learning rate."), 1.0, min = 0.0, step = 0.1)
+ ),
- actionButton("start_obj_inference", "Run Inference", class = "btn-info", style="margin-top: 10px;")
- ),
- hr(),
- h5("Inference Result"),
- uiOutput("inference_status_ui"),
- imageOutput("inference_image_output", height = "auto")
- ),
- conditionalPanel(
- condition = "input.inference_task_selector == 'asr'",
- h4("ASR Inference"),
- wellPanel(
- textInput("infer_asr_run_name", "Enter Run Name to Find Checkpoints", ""),
- selectInput("infer_asr_checkpoint_dropdown", "Select Checkpoint", choices = NULL),
- fileInput("infer_asr_audio_upload", "Upload Audio File", accept = c('audio/wav', 'audio/mp3', 'audio/flac')),
- actionButton("start_asr_inference", "Run Inference", class = "btn-info", style="margin-top: 10px;")
- ),
- hr(),
- h5("Transcription Result"),
- uiOutput("asr_inference_status_ui"),
- div(
- style = "background-color: #f8f9fa; border: 1px solid #dee2e6; border-radius: 5px; padding: 15px; margin-top: 5px; min-height: 100px; font-size: 1.1em;",
- textOutput("asr_transcription_output")
- )
- ),
- conditionalPanel(
- condition = "input.inference_task_selector == 'image_classification'",
- h4("Image Classification Inference"),
- wellPanel(
- textInput("infer_img_class_run_name", "Enter Run Name to Find Checkpoints", ""),
- selectInput("infer_img_class_checkpoint_dropdown", "Select Checkpoint", choices = NULL),
- fileInput("infer_img_class_upload", "Upload Image for Classification"),
- actionButton("start_img_class_inference", "Run Inference", class = "btn-info", style="margin-top: 10px;")
- ),
- hr(),
- h5("Prediction"),
- uiOutput("img_class_inference_status_ui"),
- div(
- style = "background-color: #f8f9fa; border: 1px solid #dee2e6; border-radius: 5px; padding: 15px; margin-top: 5px; min-height: 50px; font-size: 1.1em;",
- textOutput("img_class_prediction_output")
- )
- ),
-
- conditionalPanel(
- condition = "input.inference_task_selector == 'image_segmentation'",
- h4("Image Segmentation Inference"),
- wellPanel(
- textInput("infer_seg_run_name", "Enter Run Name to Find Checkpoints", ""),
- selectInput("infer_seg_checkpoint_dropdown", "Select Checkpoint", choices = NULL),
- fileInput("infer_seg_image_upload", "Upload Image for Segmentation", accept = c('image/png', 'image/jpeg', 'image/jpg')),
- actionButton("start_seg_inference", "Run Inference", class = "btn-info", style="margin-top: 10px;")
- ),
- hr(),
- h5("Inference Result (Overlay)"),
- uiOutput("seg_inference_status_ui"),
- imageOutput("seg_inference_image_output", height = "auto")
- )
- )
- )
- )
- )
- )
- )
-
-
-# #CNN
-# tabItem(tabName = "dashboard",
-# fluidRow(
-# box(
-# title = "API Status", status = "primary", solidHeader = TRUE, width = 6,
-# actionButton("check_status", "Check API Status", class = "btn-primary"),
-# br(), br(),
-# verbatimTextOutput("api_status")
-# ),
-# box(
-# title = "MLflow Server", status = "info", solidHeader = TRUE, width = 6,
-# actionButton("start_mlflow", "Start MLflow Server", class = "btn-info"),
-# br(), br(),
-# verbatimTextOutput("mlflow_output")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "All Jobs Overview", status = "success", solidHeader = TRUE, width = 12,
-# actionButton("refresh_dashboard_jobs", "Refresh Jobs List", class = "btn-success"),
-# br(), br(),
-# DT::dataTableOutput("dashboard_jobs_table")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Quick Info", status = "warning", solidHeader = TRUE, width = 12,
-# h4("Welcome to the No-Code AI Platform"),
-# p("This R Shiny interface provides full functionality for the FastAPI backend."),
-# p("Available features:"),
-# tags$ul(
-# tags$li("Dashboard: Check API status and view all jobs"),
-# tags$li("Create Pipeline: Set up new ML training pipelines"),
-# tags$li("Train Model: Upload datasets and start training"),
-# tags$li("Make Predictions: Use trained models for inference"),
-# tags$li("View Jobs: Monitor all training jobs"),
-# tags$li("View Datasets: Browse available datasets"),
-# tags$li("Delete Job: Remove unwanted jobs")
-# ),
-# div(class = "success-box",
-# strong("Ready: "),
-# "Full functionality available with proper HTTP requests using the 'httr' package. ",
-# "All features including file uploads, training, and predictions are supported."
-# )
-# )
-# )
-# )
-#
-# # Create Pipeline Tab
-# tabItem(tabName = "create",
-# fluidRow(
-# box(
-# title = "Create New Pipeline", status = "primary", solidHeader = TRUE, width = 12,
-# fluidRow(
-# column(6,
-# textInput("pipeline_name", "Pipeline Name", value = "My Image Classifier"),
-# selectInput("task_type", "Task Type",
-# choices = list("Image Classification" = "image_classification",
-# "Object Detection" = "object_detection"),
-# selected = "image_classification"),
-# selectInput("architecture", "Model Architecture",
-# choices = list("ResNet-18" = "resnet18",
-# "ResNet-50" = "resnet50",
-# "VGG-16" = "vgg16",
-# "MobileNet" = "mobilenet",
-# "EfficientNet" = "efficientnet"),
-# selected = "resnet18"),
-# numericInput("num_classes", "Number of Classes", value = 2, min = 2, max = 1000)
-# ),
-# column(6,
-# numericInput("batch_size", "Batch Size", value = 8, min = 1, max = 128),
-# numericInput("epochs", "Epochs", value = 5, min = 1, max = 1000),
-# numericInput("learning_rate", "Learning Rate", value = 0.001, min = 0.0001, max = 1, step = 0.0001),
-# textInput("image_size", "Image Size (width, height)", value = "224, 224")
-# )
-# ),
-# fluidRow(
-# column(6,
-# checkboxInput("augmentation", "Enable Data Augmentation", value = TRUE)
-# ),
-# column(6,
-# checkboxInput("early_stopping", "Enable Early Stopping", value = TRUE)
-# )
-# ),
-# br(),
-# actionButton("create_pipeline", "Create Pipeline", class = "btn-primary btn-lg"),
-# br(), br(),
-# verbatimTextOutput("create_output")
-# )
-# )
-# )
-#
-# # Train Model Tab
-# tabItem(tabName = "train",
-# fluidRow(
-# box(
-# title = "Current Job Status", status = "info", solidHeader = TRUE, width = 12,
-# p("Shows the most recently created job ready for training"),
-# actionButton("refresh_current_job", "Refresh Current Job", class = "btn-info"),
-# br(), br(),
-# verbatimTextOutput("current_job_status")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Upload Dataset to Job", status = "success", solidHeader = TRUE, width = 12,
-# div(class = "success-box",
-# strong("File Upload Ready: "),
-# "Upload dataset files directly to a specific job. Maximum file size: 500MB. ",
-# "Select a job first, then upload your dataset ZIP file."
-# ),
-# fluidRow(
-# column(6,
-# h4("Job Selection"),
-# selectInput("upload_job_dropdown", "Select Job for Dataset Upload", choices = list()),
-# actionButton("refresh_upload_jobs", "Refresh Jobs", class = "btn-info"),
-# br(), br(),
-# checkboxInput("is_coco_format_upload", "COCO Format Dataset (Object Detection)", value = FALSE)
-# ),
-# column(6,
-# h4("File Upload"),
-# fileInput("dataset_file", "Choose Dataset ZIP File",
-# accept = c(".zip"),
-# multiple = FALSE),
-# p("Supported formats (Max 500MB):"),
-# tags$ul(
-# tags$li("ZIP files with image folders"),
-# tags$li("For Classification: folders with class subfolders"),
-# tags$li("For Object Detection: COCO format structure")
-# )
-# )
-# ),
-# br(),
-# actionButton("upload_dataset", "Upload Dataset to Job", class = "btn-success btn-lg"),
-# br(), br(),
-# verbatimTextOutput("upload_dataset_output")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Link Dataset to Job", status = "primary", solidHeader = TRUE, width = 12,
-# p("Connect a pending job to a dataset (either newly uploaded or existing)"),
-# fluidRow(
-# column(6,
-# selectInput("pending_job_dropdown", "Select Pending Job", choices = list()),
-# actionButton("refresh_pending_jobs", "Refresh Pending Jobs", class = "btn-info")
-# ),
-# column(6,
-# selectInput("dataset_dropdown", "Select Dataset", choices = list()),
-# actionButton("refresh_datasets_dropdown", "Refresh Datasets", class = "btn-success")
-# )
-# ),
-# actionButton("link_dataset", "Link Dataset to Job", class = "btn-primary"),
-# br(), br(),
-# verbatimTextOutput("link_output")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Start Training", status = "warning", solidHeader = TRUE, width = 12,
-# p("Start training jobs that have datasets linked"),
-# selectInput("trainable_job_dropdown", "Select Job Ready for Training", choices = list()),
-# actionButton("refresh_trainable_jobs", "Refresh Trainable Jobs", class = "btn-info"),
-# br(), br(),
-# actionButton("start_training_btn", "Start Training", class = "btn-warning btn-lg"),
-# br(), br(),
-# verbatimTextOutput("training_output")
-# )
-# )
-# )
-#
-# # Make Predictions Tab
-# tabItem(tabName = "predict",
-# fluidRow(
-# box(
-# title = "Model Selection", status = "primary", solidHeader = TRUE, width = 12,
-# selectInput("predict_job_dropdown", "Select Trained Model", choices = list()),
-# actionButton("refresh_prediction_models", "Refresh Available Models", class = "btn-info"),
-# br(), br(),
-# verbatimTextOutput("prediction_models_status")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Image Upload & Prediction", status = "success", solidHeader = TRUE, width = 12,
-# fluidRow(
-# column(6,
-# h4("Upload Image"),
-# fileInput("prediction_image", "Choose Image File",
-# accept = c(".jpg", ".jpeg", ".png", ".bmp", ".tiff"),
-# multiple = FALSE),
-# p("Supported formats: JPG, PNG, BMP, TIFF")
-# ),
-# column(6,
-# h4("Prediction Settings"),
-# sliderInput("confidence_threshold",
-# "Confidence Threshold",
-# value = 0.5, min = 0.1, max = 0.95, step = 0.05,
-# post = "%"),
-# p(class = "help-text", style = "font-size: 12px; color: #666;",
-# "Higher values show fewer, more confident detections. Lower values show more detections but may include false positives."),
-# checkboxInput("show_probabilities", "Show All Class Probabilities", value = TRUE)
-# )
-# ),
-# br(),
-# actionButton("make_prediction", "Make Prediction", class = "btn-primary btn-lg"),
-# br(), br(),
-# fluidRow(
-# column(6,
-# h4("Prediction Results"),
-# verbatimTextOutput("prediction_output")
-# ),
-# column(6,
-# h4("Uploaded Image"),
-# imageOutput("prediction_image_display", height = "400px"),
-# br(),
-# textOutput("image_info")
-# )
-# )
-# )
-# )
-# )
-#
-# # Jobs Tab
-# tabItem(tabName = "jobs",
-# fluidRow(
-# box(
-# title = "All Jobs", status = "info", solidHeader = TRUE, width = 12,
-# actionButton("refresh_jobs", "Refresh Jobs List", class = "btn-info"),
-# br(), br(),
-# DT::dataTableOutput("jobs_table")
-# )
-# ),
-# fluidRow(
-# box(
-# title = "Job Details", status = "success", solidHeader = TRUE, width = 12,
-# textInput("job_status_id", "Job ID", placeholder = "Enter Job ID to view details"),
-# actionButton("get_job_details", "Get Job Status", class = "btn-success"),
-# br(), br(),
-# verbatimTextOutput("job_details_output")
-# )
-# )
-# )
-#
-# # Datasets Tab
-# tabItem(tabName = "datasets",
-# fluidRow(
-# box(
-# title = "Available Datasets", status = "success", solidHeader = TRUE, width = 12,
-# actionButton("refresh_datasets", "Refresh Datasets", class = "btn-success"),
-# br(), br(),
-# DT::dataTableOutput("datasets_table")
-# )
-# )
-# )
-#
-# # Delete Job Tab
-# tabItem(tabName = "delete",
-# fluidRow(
-# box(
-# title = "Delete Job", status = "danger", solidHeader = TRUE, width = 12,
-# div(class = "warning-box",
-# strong("Warning: "),
-# "Deleting a job will permanently remove all associated data including trained models, datasets, and logs. This action cannot be undone."
-# ),
-# selectInput("delete_job_dropdown", "Select Job to Delete", choices = list()),
-# actionButton("refresh_delete_jobs", "Refresh Jobs List", class = "btn-info"),
-# br(), br(),
-# actionButton("delete_job_btn", "Delete Selected Job", class = "btn-danger btn-lg"),
-# br(), br(),
-# verbatimTextOutput("delete_output")
-# )
-# )
-# )
-#
-
-
-
-
-
-
-}
\ No newline at end of file
+ # Ultralytics/YOLO Specific
+ conditionalPanel(
+ condition = "input.obj_model_checkpoint.indexOf('.pt') > -1 || input.obj_model_checkpoint.indexOf('rtdetr') > -1",
+ numericInput("obj_weight_decay", label_with_help("Weight Decay", "Regularization factor."), 0.0005, step = 0.0001),
+ selectInput("obj_optimizer", label_with_help("Optimizer", "Optimizer algorithm."), choices = c("auto", "sgd", "adam", "adamw"), selected = "auto"),
+ numericInput("obj_warmup_epochs", label_with_help("Warmup Epochs", "Number of epochs for learning rate warmup."), 3.0, min = 0.0),
+ numericInput("obj_momentum", label_with_help("Momentum", "Momentum factor for SGD."), 0.937, step = 0.001),
+ numericInput("obj_lr0", label_with_help("Initial Learning Rate", "Initial learning rate."), 0.01, step = 0.001)
+ ),
+ br(),
+ h4("Data Augmentation"),
+ checkboxInput("obj_enable_augment", "Enable Augmentation", value = FALSE),
+ conditionalPanel(
+ condition = "input.obj_enable_augment == true",
+ wellPanel(
+ style = "background-color: #f9f9f9; border-left: 3px solid #7BC148;",
+ numericInput("obj_flip_prob", label_with_help("Horizontal Flip Prob.", "Probability of flipping image horizontally."), 0.5, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("obj_rotate_limit", label_with_help("Rotation Limit", "Random rotation in range (-limit, +limit)."), 15, min = 0, max = 180),
+ numericInput("obj_brightness", label_with_help("Brightness Jitter", "Random brightness adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("obj_contrast", label_with_help("Contrast Jitter", "Random contrast adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1),
+
+ # YOLO Specific Augmentations
+ conditionalPanel(
+ condition = "input.obj_model_checkpoint.indexOf('.pt') > -1 || input.obj_model_checkpoint.indexOf('rtdetr') > -1",
+ numericInput("obj_mosaic", label_with_help("Mosaic Prob.", "Probability of Mosaic augmentation (0-1)."), 1.0, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("obj_mixup", label_with_help("Mixup Prob.", "Probability of Mixup augmentation (0-1)."), 0.0, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("obj_hsv_h", label_with_help("HSV-H Gain", "Hue adjustment gain."), 0.015, step = 0.001),
+ numericInput("obj_hsv_s", label_with_help("HSV-S Gain", "Saturation adjustment gain."), 0.7, step = 0.1),
+ numericInput("obj_hsv_v", label_with_help("HSV-V Gain", "Value (Brightness) adjustment gain."), 0.4, step = 0.1)
+ )
+ )
+ )
+ )
+ ),
+
+ # -- Image Classification Params --
+ conditionalPanel(
+ condition = "input.task_selector == 'image_classification'",
+ collapsible_panel("Training Parameters",
+ open = TRUE,
+ numericInput("img_class_num_train_epochs", label_with_help("Epochs", "Number of complete passes through the training dataset."), 5, min = 1),
+ numericInput("img_class_per_device_train_batch_size", label_with_help("Train Batch Size", "Number of training samples per batch."), 16, min = 1)
+ ),
+ collapsible_panel("Advanced Configuration",
+ open = FALSE,
+ numericInput("img_class_eval_batch_size", label_with_help("Eval Batch Size", "Batch size for validation."), 16, min = 1),
+ numericInput("img_class_learning_rate", label_with_help("Learning Rate", "Step size for optimizer."), 2e-5, step = 1e-6),
+ numericInput("img_class_weight_decay", label_with_help("Weight Decay", "Regularization factor."), 0.01, step = 0.001),
+ numericInput("img_class_max_image_size", label_with_help("Max Image Size", "Resize images to this dimension (square)."), 224, min = 32),
+ numericInput("img_class_gradient_accumulation_steps", label_with_help("Gradient Accumulation", "Steps to accumulate gradients before update."), 1, min = 1),
+ checkboxInput("img_class_gradient_checkpointing", label_with_help("Gradient Checkpointing", "Save memory at cost of speed."), value = FALSE),
+ numericInput("img_class_early_stopping_patience", label_with_help("Early Stopping Patience", "Epochs to wait without improvement."), 3, min = 1),
+ numericInput("img_class_early_stopping_threshold", label_with_help("Early Stop Threshold", "Minimum change to qualify as improvement."), 0.0, step = 0.001),
+ numericInput("img_class_seed", label_with_help("Random Seed", "Seed for reproducibility."), 42),
+
+ # Added for Production Audit
+ selectInput("img_class_optimizer", label_with_help("Optimizer", "Optimizer algorithm."), choices = c("AdamW" = "adamw_torch", "SGD" = "sgd", "Adafactor" = "adafactor"), selected = "adamw_torch"),
+ selectInput("img_class_scheduler", label_with_help("LR Scheduler", "Learning rate schedule."), choices = c("Linear" = "linear", "Cosine" = "cosine", "Constant" = "constant"), selected = "linear"),
+ numericInput("img_class_warmup_epochs", label_with_help("Warmup Epochs", "Epochs to warm up learning rate."), 1.0, min = 0.0, step = 0.1),
+ br(),
+ h4("Data Augmentation"),
+ checkboxInput("img_class_enable_augment", "Enable Augmentation", value = FALSE),
+ conditionalPanel(
+ condition = "input.img_class_enable_augment == true",
+ wellPanel(
+ style = "background-color: #f9f9f9; border-left: 3px solid #7BC148;",
+ numericInput("img_class_flip_prob", label_with_help("Horizontal Flip Prob.", "Probability of flipping image horizontally."), 0.5, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("img_class_rotate_limit", label_with_help("Rotation Limit", "Random rotation in range (-limit, +limit)."), 15, min = 0, max = 180),
+ numericInput("img_class_brightness", label_with_help("Brightness Jitter", "Random brightness adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("img_class_contrast", label_with_help("Contrast Jitter", "Random contrast adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1)
+ )
+ )
+ )
+ ),
+ # -- Segmentation Params --
+ conditionalPanel(
+ condition = "input.task_selector == 'semantic_segmentation'",
+ collapsible_panel("Training Parameters",
+ open = TRUE,
+ numericInput("seg_num_train_epochs", label_with_help("Epochs", "Number of complete passes through the training dataset."), 10, min = 1),
+ numericInput("seg_per_device_train_batch_size", label_with_help("Train Batch Size", "Number of training samples per batch."), 4, min = 1)
+ ),
+ collapsible_panel("Advanced Configuration",
+ open = FALSE,
+ numericInput("seg_eval_batch_size", label_with_help("Eval Batch Size", "Batch size for validation."), 4, min = 1),
+ numericInput("seg_learning_rate", label_with_help("Learning Rate", "Step size for optimizer."), 6e-5, step = 1e-6),
+ numericInput("seg_weight_decay", label_with_help("Weight Decay", "Regularization factor."), 0.01, step = 0.001),
+ numericInput("seg_max_image_size", label_with_help("Max Image Size", "Resize images to this dimension (square)."), 512, min = 128),
+ numericInput("seg_gradient_accumulation_steps", label_with_help("Gradient Accumulation", "Steps to accumulate gradients before update."), 1, min = 1),
+ checkboxInput("seg_gradient_checkpointing", label_with_help("Gradient Checkpointing", "Save memory at cost of speed."), value = FALSE),
+ numericInput("seg_early_stopping_patience", label_with_help("Early Stopping Patience", "Epochs to wait without improvement."), 5, min = 1),
+ numericInput("seg_early_stopping_threshold", label_with_help("Early Stop Threshold", "Minimum change to qualify as improvement."), 0.0, step = 0.001),
+ numericInput("seg_seed", label_with_help("Random Seed", "Seed for reproducibility."), 42),
+
+ # Added for Production Audit
+ selectInput("seg_optimizer", label_with_help("Optimizer", "Optimizer algorithm."), choices = c("AdamW" = "adamw_torch", "SGD" = "sgd", "Adafactor" = "adafactor"), selected = "adamw_torch"),
+ selectInput("seg_scheduler", label_with_help("LR Scheduler", "Learning rate schedule."), choices = c("Linear" = "linear", "Cosine" = "cosine", "Constant" = "constant"), selected = "linear"),
+ numericInput("seg_warmup_epochs", label_with_help("Warmup Epochs", "Epochs to warm up learning rate."), 1.0, min = 0.0, step = 0.1),
+ br(),
+ h4("Data Augmentation"),
+ checkboxInput("seg_enable_augment", "Enable Augmentation", value = FALSE),
+ conditionalPanel(
+ condition = "input.seg_enable_augment == true",
+ wellPanel(
+ style = "background-color: #f9f9f9; border-left: 3px solid #7BC148;",
+ numericInput("seg_flip_prob", label_with_help("Horizontal Flip Prob.", "Probability of flipping image horizontally."), 0.5, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("seg_rotate_limit", label_with_help("Rotation Limit", "Random rotation in range (-limit, +limit)."), 15, min = 0, max = 180),
+ numericInput("seg_brightness", label_with_help("Brightness Jitter", "Random brightness adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1),
+ numericInput("seg_contrast", label_with_help("Contrast Jitter", "Random contrast adjustment factor (0-1)."), 0.2, min = 0.0, max = 1.0, step = 0.1)
+ )
+ )
+ )
+ ),
+ br(),
+ div(
+ class = "text-right",
+ actionButton("wiz_back_3", "Model Setup", icon = icon("arrow-left"), class = "btn btn-outline-success"),
+ actionButton("wiz_next_3", "Review & Launch", icon = icon("arrow-right"), class = "btn btn-success")
+ )
+ ),
+
+ # === STEP 4: Review & Launch ===
+ tabPanel(
+ "step4",
+ box(
+ width = NULL, status = "success",
+ h5("Ready to Start Training"),
+ p("Please review your settings."),
+ p("You can go back to change them."),
+ tableOutput("wizard_review_table"), # Dynamic Review Table
+
+ # Launch Buttons
+ conditionalPanel(
+ condition = "input.task_selector == 'object_detection'",
+ actionButton("start_obj_job", "Launch Object Detection", class = "btn btn-success btn-lg btn-block", icon = icon("rocket"))
+ ),
+ conditionalPanel(
+ condition = "input.task_selector == 'image_classification'",
+ actionButton("start_img_class_job", "Launch Image Classification", class = "btn btn-success btn-lg btn-block", icon = icon("rocket"))
+ ),
+ conditionalPanel(
+ condition = "input.task_selector == 'semantic_segmentation'",
+ actionButton("start_seg_job", "Launch Segmentation Job", class = "btn btn-success btn-lg btn-block", icon = icon("rocket"))
+ )
+ ),
+ br(),
+ div(
+ class = "text-right",
+ actionButton("wiz_back_4", "Hyperparameters", icon = icon("arrow-left"), class = "btn btn-outline-success")
+ )
+ )
+ ) # End wizard tabset
+ ) # End box
+ ) # End column
+ ) # End fluidRow
+ ), # End New Training tabPanel
+
+ # --- Tab: Data Management ---
+ tabPanel(
+ "Data Management",
+ # h4 removed as per request to remove redundancy
+ fluidRow(
+ column(
+ width = 4,
+ box(
+ width = NULL, title = tagList(icon("upload"), "Register a New Dataset"), status = "success", solidHeader = FALSE,
+ textInput("new_data_name", label_with_help("Dataset Name", "Unique name for the dataset.")),
+ selectInput("new_data_task_type", label_with_help("Task Type", "The type of Deep Learning task this data is for."),
+ choices = c(
+ "Object Detection" = "object_detection",
+ "Image Classification" = "image_classification",
+ "Semantic Segmentation" = "semantic_segmentation"
+ )
+ ),
+ fileInput("new_data_zip", label_with_help("Upload Data", "Zip (Images) or CSV/Parquet (Tabular/Timeseries)."), accept = c(".zip", ".csv", ".parquet")),
+ actionButton("start_data_upload", "Register & Process", class = "btn btn-success", style = "width: 100%;"),
+ br(),
+ textOutput("data_upload_status")
+ )
+ ),
+ column(
+ width = 8,
+ box(
+ width = NULL, title = "Registered Datasets", status = "success", solidHeader = FALSE,
+ p("This table shows datasets that are processed and ready for training."),
+ DTOutput("dataset_table")
+ )
+ )
+ )
+ ),
+
+ # --- Tab: Prediction ---
+ tabPanel(
+ "Prediction",
+ br(),
+ tabsetPanel(
+ id = "inference_task_selector",
+ type = "pills",
+ tabPanel(
+ title = "Object Detection",
+ value = "object_detection",
+ br(),
+ fluidRow(
+ column(
+ 5,
+ box(
+ width = NULL, title = "Configuration", status = "success", solidHeader = TRUE,
+ selectInput("infer_run_name", label_with_help("Select Run", "Choose a completed training run."), choices = NULL),
+ selectInput("infer_checkpoint_dropdown", label_with_help("Select Checkpoint", "Choose a model checkpoint."), choices = NULL),
+ fileInput("infer_obj_image_upload", label_with_help("Upload Image", "Image to detect objects in."), accept = c("image/png", "image/jpeg", "image/jpg")),
+ sliderInput("infer_obj_threshold", label_with_help("Confidence Threshold", "Minimum confidence for detections."), min = 0.01, max = 1.0, value = 0.25, step = 0.01),
+ conditionalPanel(
+ condition = "input.infer_checkpoint_dropdown && (input.infer_checkpoint_dropdown.indexOf('.pt') > -1 || input.infer_checkpoint_dropdown.indexOf('rtdetr') > -1)",
+ numericInput("infer_obj_iou", label_with_help("IoU Threshold (NMS)", "Intersection over Union threshold for Non-Max Suppression."), 0.7, min = 0.01, max = 1.0, step = 0.05),
+ numericInput("infer_obj_max_det", label_with_help("Max Detections", "Maximum number of objects to detect per image."), 300, min = 1),
+ # New Params
+ numericInput("infer_obj_imgsz", label_with_help("Image Size", "Inference image size (pixels)."), 640, min = 32),
+ textInput("infer_obj_classes", label_with_help("Classes Filter", "Filter by class IDs (comma-separated, e.g. '0, 2'). Leave empty for all."), "")
+ ),
+ actionButton("start_obj_inference", "Run Inference", class = "btn btn-success", style = "margin-top: 10px; width: 100%;")
+ )
+ ),
+ column(
+ 7,
+ box(
+ width = NULL, title = "Result", status = "success", solidHeader = TRUE,
+ uiOutput("inference_status_ui"),
+ imageOutput("inference_image_output", height = "auto")
+ )
+ )
+ )
+ ),
+ tabPanel(
+ title = "Image Classification",
+ value = "image_classification",
+ br(),
+ fluidRow(
+ column(
+ 5,
+ box(
+ width = NULL, title = "Configuration", status = "success", solidHeader = TRUE,
+ selectInput("infer_img_class_run_name", label_with_help("Select Run", "Choose a completed training run."), choices = NULL),
+ selectInput("infer_img_class_checkpoint_dropdown", label_with_help("Checkpoint", "Choose a model checkpoint."), choices = NULL),
+ fileInput("infer_img_class_upload", label_with_help("Upload Image", "Image to classify.")),
+ actionButton("start_img_class_inference", "Run Inference", class = "btn btn-success", style = "margin-top: 10px; width: 100%;")
+ )
+ ),
+ column(
+ 7,
+ box(
+ width = NULL, title = "Prediction", status = "success", solidHeader = TRUE,
+ uiOutput("img_class_inference_status_ui"),
+ verbatimTextOutput("img_class_prediction_output", placeholder = TRUE)
+ )
+ )
+ )
+ ),
+ tabPanel(
+ title = "Semantic Segmentation",
+ value = "semantic_segmentation",
+ br(),
+ fluidRow(
+ column(
+ 5,
+ box(
+ width = NULL, title = "Configuration", status = "success", solidHeader = TRUE,
+ selectInput("infer_seg_run_name", label_with_help("Select Run", "Choose a completed training run."), choices = NULL),
+ selectInput("infer_seg_checkpoint_dropdown", label_with_help("Checkpoint", "Choose a model checkpoint."), choices = NULL),
+ fileInput("infer_seg_image_upload", label_with_help("Upload Image", "Image to segment."), accept = c("image/png", "image/jpeg", "image/jpg")),
+ actionButton("start_seg_inference", "Run Inference", class = "btn btn-success", style = "margin-top: 10px; width: 100%;")
+ )
+ ),
+ column(
+ 7,
+ box(
+ width = NULL, title = "Segmentation Overlay", status = "success", solidHeader = TRUE,
+ uiOutput("seg_inference_status_ui"),
+ imageOutput("seg_inference_image_output", height = "auto")
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+}
diff --git a/users.sqlite b/users.sqlite
deleted file mode 100644
index 256d1b8..0000000
Binary files a/users.sqlite and /dev/null differ