Fix/interface bugs

DESCRIPTION

@@ -16,6 +16,8 @@ Description: A Shiny application for manual classification and validation of
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
+Depends:
+    R (>= 4.4.0)
 Imports:
     shiny,
     shinyjs,

NAMESPACE

@@ -62,6 +62,7 @@ export(save_sample_annotations)
 export(save_validation_statistics)
 export(scan_png_class_folder)
 export(update_annotator)
+export(update_settings_file)
 importFrom(DBI,dbConnect)
 importFrom(DBI,dbDisconnect)
 importFrom(DBI,dbExecute)

R/sample_loading.R

@@ -63,6 +63,9 @@ load_from_csv <- function(csv_path, use_threshold = TRUE) {
   if (!"roi_area" %in% names(classifications)) {
     classifications$roi_area <- NA_real_
   }
+  if (!"score" %in% names(classifications)) {
+    classifications$score <- NA_real_
+  }
 
   classifications
 }

R/sample_saving.R

@@ -34,7 +34,10 @@ NULL
 #'   statistics CSV files are written to a \code{validation_statistics/}
 #'   subfolder inside \code{output_folder}. Set to \code{FALSE} to skip this
 #'   export, e.g. when annotating from scratch.
-#' @return TRUE on success, FALSE on failure
+#' @return TRUE on success, FALSE when there is nothing to save (empty changes
+#'   log) or required inputs are missing. Errors raised while writing any
+#'   backend propagate to the caller, so callers can distinguish a failed save
+#'   from an empty one.
 #' @export
 #' @examples
 #' \dontrun{
@@ -82,79 +85,71 @@ save_sample_annotations <- function(sample_name,
     return(FALSE)
   }
 
-  tryCatch({
-    # Create output folders if needed
-    if (!dir.exists(output_folder)) {
-      dir.create(output_folder, recursive = TRUE)
-    }
-    if (!dir.exists(png_output_folder)) {
-      dir.create(png_output_folder, recursive = TRUE)
-    }
-
-    # Copy images to class subfolders
-    temp_annotate_folder <- tempfile(pattern = "ifcb_annotate_")
-    dir.create(temp_annotate_folder, recursive = TRUE)
-
-    copy_images_to_class_folders(
-      classifications = classifications,
-      src_folder = file.path(temp_png_folder, sample_name),
-      temp_folder = temp_annotate_folder,
-      output_folder = png_output_folder
-    )
+  # Create output folders if needed
+  if (!dir.exists(output_folder)) {
+    dir.create(output_folder, recursive = TRUE)
+  }
+  if (!dir.exists(png_output_folder)) {
+    dir.create(png_output_folder, recursive = TRUE)
+  }
 
-    # Save to SQLite (fast, no Python needed)
-    if (save_format %in% c("sqlite", "both")) {
-      # Load class list if not provided
-      c2u <- class2use
-      if (is.null(c2u)) {
-        c2u <- load_class_list(class2use_path)
-      }
-      db_path <- get_db_path(db_folder)
-      save_annotations_db(db_path, sample_name, classifications, c2u, annotator)
-    }
+  # Copy images to class subfolders
+  temp_annotate_folder <- tempfile(pattern = "ifcb_annotate_")
+  dir.create(temp_annotate_folder, recursive = TRUE)
+  on.exit(unlink(temp_annotate_folder, recursive = TRUE), add = TRUE)
 
-    # Save to .mat (requires Python + scipy)
-    if (save_format %in% c("mat", "both")) {
-      # Find ADC folder: use provided path, or fall back to get_sample_paths()
-      if (is.null(adc_folder)) {
-        paths <- get_sample_paths(sample_name, roi_folder)
-        adc_folder <- paths$adc_folder
-      }
+  copy_images_to_class_folders(
+    classifications = classifications,
+    src_folder = file.path(temp_png_folder, sample_name),
+    temp_folder = temp_annotate_folder,
+    output_folder = png_output_folder
+  )
 
-      ifcb_annotate_samples(
-        png_folder = temp_annotate_folder,
-        adc_folder = adc_folder,
-        class2use_file = class2use_path,
-        output_folder = output_folder,
-        sample_names = sample_name,
-        remove_trailing_numbers = FALSE
-      )
+  # Save to SQLite (fast, no Python needed)
+  if (save_format %in% c("sqlite", "both")) {
+    # Load class list if not provided
+    c2u <- class2use
+    if (is.null(c2u)) {
+      c2u <- load_class_list(class2use_path)
     }
+    db_path <- get_db_path(db_folder)
+    save_annotations_db(db_path, sample_name, classifications, c2u, annotator)
+  }
 
-    # Save statistics (optional)
-    if (isTRUE(export_statistics)) {
-      stats_folder <- file.path(output_folder, "validation_statistics")
-      if (!dir.exists(stats_folder)) {
-        dir.create(stats_folder, recursive = TRUE)
-      }
-      save_validation_statistics(
-        sample_name = sample_name,
-        classifications = classifications,
-        original_classifications = original_classifications,
-        stats_folder = stats_folder,
-        annotator = annotator
-      )
+  # Save to .mat (requires Python + scipy)
+  if (save_format %in% c("mat", "both")) {
+    # Find ADC folder: use provided path, or fall back to get_sample_paths()
+    if (is.null(adc_folder)) {
+      paths <- get_sample_paths(sample_name, roi_folder)
+      adc_folder <- paths$adc_folder
     }
 
-    # Clean up temp folder
-    unlink(temp_annotate_folder, recursive = TRUE)
+    ifcb_annotate_samples(
+      png_folder = temp_annotate_folder,
+      adc_folder = adc_folder,
+      class2use_file = class2use_path,
+      output_folder = output_folder,
+      sample_names = sample_name,
+      remove_trailing_numbers = FALSE
+    )
+  }
 
-    return(TRUE)
+  # Save statistics (optional)
+  if (isTRUE(export_statistics)) {
+    stats_folder <- file.path(output_folder, "validation_statistics")
+    if (!dir.exists(stats_folder)) {
+      dir.create(stats_folder, recursive = TRUE)
+    }
+    save_validation_statistics(
+      sample_name = sample_name,
+      classifications = classifications,
+      original_classifications = original_classifications,
+      stats_folder = stats_folder,
+      annotator = annotator
+    )
+  }
 
-  }, error = function(e) {
-    warning("Save failed for ", sample_name, ": ", e$message)
-    return(FALSE)
-  })
+  TRUE
 }
 
 #' Copy images to class-organized folders

R/utils.R

@@ -76,6 +76,32 @@ get_settings_path <- function() {
   file.path(config_dir, "settings.json")
 }
 
+#' Update settings file by merging new values
+#'
+#' Reads the existing settings JSON file (if any), merges the given settings
+#' into it, and writes the result back. Callers that only know a subset of
+#' settings keys can therefore update those keys without erasing the rest of
+#' the file. A key with a \code{NULL} value is removed from the file.
+#'
+#' @param settings Named list of settings to update.
+#' @param settings_file Path to the settings JSON file. Defaults to
+#'   \code{\link{get_settings_path}}.
+#' @return Invisibly, the full merged settings list.
+#' @export
+update_settings_file <- function(settings, settings_file = get_settings_path()) {
+  existing <- list()
+  if (file.exists(settings_file)) {
+    existing <- tryCatch(
+      jsonlite::fromJSON(settings_file),
+      error = function(e) list()
+    )
+    if (!is.list(existing)) existing <- list()
+  }
+  merged <- utils::modifyList(existing, settings)
+  jsonlite::write_json(merged, settings_file, auto_unbox = TRUE, pretty = TRUE)
+  invisible(merged)
+}
+
 #' Get path to file index cache
 #'
 #' Returns the path to the file index JSON cache file. The file index

_pkgdown.yml

@@ -42,6 +42,7 @@ reference:
   - init_python_env
   - get_config_dir
   - get_settings_path
+  - update_settings_file
 - title: Sample Loading
   desc: Functions for loading classifications and samples from ROI/PNG sources
   contents:

inst/app/modules/class_list_loading_server.R

@@ -7,7 +7,7 @@ setup_class_list_loading_server <- function(input, output, session, rv, config,
   observe({
     if (!is.null(rv$class2use_path)) return()
 
-    if (grepl("sqlite", config$save_format, fixed = TRUE)) {
+    if (config$save_format %in% c("sqlite", "both")) {
       db_path <- get_db_path(config$db_folder)
       if (file.exists(db_path)) {
         db_classes <- load_global_class_list_db(db_path)
@@ -70,7 +70,7 @@ setup_class_list_loading_server <- function(input, output, session, rv, config,
   last_saved_class2use <- reactiveVal(NULL)
 
   observeEvent(rv$class2use, {
-    if (!grepl("sqlite", config$save_format, fixed = TRUE)) return()
+    if (!config$save_format %in% c("sqlite", "both")) return()
     classes <- rv$class2use
     if (is.null(classes) || length(classes) == 0) return()
     if (length(classes) == 1 && classes == "unclassified") return()

inst/app/modules/class_list_server.R

@@ -359,7 +359,9 @@ setup_class_list_server <- function(input, output, session, rv, config,
       return()
     }
 
-    matches[unmatched_idx, c("class_name", "query_name", "matched_name", "accepted_name", "aphia_id", "status", "note")] <- updated_rows
+    # Assign by the result's own column names so the target list always
+    # matches what build_worms_match_rows() returns (9 columns)
+    matches[unmatched_idx, names(updated_rows)] <- updated_rows
     rv$worms_matches <- matches
 
     matched_n <- sum(!is.na(rv$worms_matches$aphia_id) & nzchar(rv$worms_matches$aphia_id))
@@ -406,17 +408,24 @@ setup_class_list_server <- function(input, output, session, rv, config,
     }
 
     updated_map <- rv$class_aphia_map
+    effective_names <- matched$class_name
     for (i in seq_len(nrow(matched))) {
       key <- matched$class_name[i]
       if (rename_requested && !is.na(matched$accepted_name[i]) && nzchar(matched$accepted_name[i])) {
         if (matched$accepted_name[i] %in% rv$class2use) {
           key <- matched$accepted_name[i]
         }
       }
+      effective_names[i] <- key
       updated_map[[key]] <- matched$aphia_id[i]
     }
     rv$class_aphia_map <- updated_map
-    save_worms_map(updated_map, db_folder = config$db_folder, matches_df = matched)
+    # Key the taxonomy lookups by the same (possibly renamed) class names as
+    # the AphiaID map; keyed by the old names, renamed classes would lose
+    # their scientific/accepted name fields in the class_taxonomy table
+    matched_for_save <- matched
+    matched_for_save$class_name <- effective_names
+    save_worms_map(updated_map, db_folder = config$db_folder, matches_df = matched_for_save)
 
     if (rename_requested) {
       updateTextAreaInput(session, "class_list_edit", value = paste(rv$class2use, collapse = "\n"))

inst/app/modules/class_review_server.R

@@ -105,7 +105,21 @@ setup_class_review_server <- function(input, output, session, rv, config,
         populate_cr_database_filters()
       }
     } else {
-      # Leaving class review mode - clear state
+      # Leaving class review mode - clear state. If a review was actually
+      # loaded, also drop the review data itself so it can't be mistaken for
+      # a regular sample and auto-saved (e.g. "__external_review__" ending up
+      # in the annotations database via save_to_cache/session cleanup).
+      if (isTRUE(rv$class_review_mode)) {
+        rv$current_sample <- NULL
+        rv$classifications <- NULL
+        rv$original_classifications <- NULL
+        rv$selected_images <- character()
+        rv$current_page <- 1
+        rv$changes_log <- create_empty_changes_log()
+        rv$is_annotation_mode <- FALSE
+        rv$has_classification <- FALSE
+        updateSelectInput(session, "class_filter", choices = c("All" = "all"), selected = "all")
+      }
       rv$class_review_mode <- FALSE
       rv$class_review_source <- "database"
       rv$class_review_class <- NULL

inst/app/modules/gallery_server.R

@@ -56,6 +56,19 @@ setup_gallery_server <- function(input, output, session, rv) {
     per_page <- as.numeric(input$images_per_page)
     if (is.null(per_page)) per_page <- 100
 
+    # Guard before slicing: images[1:0, ] on a 0-row frame would return a
+    # phantom 1-row all-NA frame (1:0 is c(1, 0)), breaking the empty check
+    if (nrow(images) == 0) {
+      return(list(
+        images = images,
+        current_page = 1,
+        total_pages = 0,
+        total_images = 0,
+        start_idx = 0,
+        end_idx = 0
+      ))
+    }
+
     total_pages <- ceiling(nrow(images) / per_page)
     current_page <- min(rv$current_page, max(1, total_pages))
 
@@ -80,17 +93,23 @@ setup_gallery_server <- function(input, output, session, rv) {
             p$start_idx, p$end_idx, p$total_images)
   })
 
+  # Navigate from the clamped page actually displayed, not rv$current_page,
+  # which can be stale/out-of-range after the image list shrinks (e.g. after
+  # relabeling away the last page of a filtered class)
   observeEvent(input$prev_page, {
-    if (rv$current_page > 1) {
-      rv$current_page <- rv$current_page - 1
+    req(paginated_images())
+    p <- paginated_images()
+    if (p$current_page > 1) {
+      rv$current_page <- p$current_page - 1
       rv$select_all_state <- "first"  # Reset select_all state when navigating
     }
   })
 
   observeEvent(input$next_page, {
     req(paginated_images())
-    if (rv$current_page < paginated_images()$total_pages) {
-      rv$current_page <- rv$current_page + 1
+    p <- paginated_images()
+    if (p$current_page < p$total_pages) {
+      rv$current_page <- p$current_page + 1
       rv$select_all_state <- "first"  # Reset select_all state when navigating
     }
   })
@@ -189,7 +208,7 @@ setup_gallery_server <- function(input, output, session, rv) {
               tags$span(style = "color: #856404;",
                         paste0(" (was: ", gsub("_\\d+$", "", original_class), ")"))
             },
-            if (!is.na(img_row$score)) {
+            if (!is.null(img_row$score) && !is.na(img_row$score)) {
               tagList(br(), tags$span(style = "color: #666;", sprintf("%.1f%%", img_row$score * 100)))
             }
           )