adopted improvements from copilot

Author: douwe

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
     glue,
     readxl,
     rlang,
+    stats,
     stringr,
     tibble,
     yaml

NAMESPACE

@@ -11,3 +11,4 @@ export(short_to_longnames)
 export(star_to_number)
 export(well_from_rowcol)
 importFrom(rlang,.data)
+importFrom(stats,setNames)

R/excelDataGuide-package.R

@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom stats setNames
+## usethis namespace: end
+NULL

R/guide.R

@@ -14,32 +14,43 @@ read_guide <- function(path) {
   guide <- yaml::read_yaml(path)
   check_guide(guide)
 
-  if ('translations' %in% names(guide)) {
-
+  if ("translations" %in% names(guide)) {
     guide$translations <- dplyr::bind_rows(guide$translations)
 
-    # translation long and short names must be unique
-    if (anyDuplicated(guide$translations$long)) {
-      dup <- unique(guide$translations$long[duplicated(guide$translations$long)])
-      rlang::abort("Duplicate keys in long names of the translations: {paste0(dup, collapse=', ')}")
-    }
-
-    if (anyDuplicated(guide$translations$short)) {
-      dup <- unique(guide$translations$short[duplicated(guide$translations$short)])
-      rlang::abort("Duplicate keys in short names of the translations: {paste0(dup, collapse=', ')}")
-    }
+    # Ensure unique long and short names in translations
+    validate_unique_names(guide$translations$long, "long")
+    validate_unique_names(guide$translations$short, "short")
 
+    # Ensure reserved 'File path' and '.sourcefile' mapping
     if (!(".sourcefile" %in% guide$translations$short)) {
-      if ('File path' %in% guide$translations$long) {
+      if ("File path" %in% guide$translations$long) {
         rlang::abort("The 'long' variable name 'File path' is reserved for the 'short' name '.sourcefile' exclusively.")
       }
-      guide$translations <- dplyr::bind_rows(guide$translations, list(long='File path', short='.sourcefile'))
+      guide$translations <- dplyr::bind_rows(
+        guide$translations,
+        list(long = "File path", short = ".sourcefile")
+      )
     }
   }
 
   structure(guide, class = "guide")
 }
 
+#' Helper function to validate unique names in translations
+#' @param names_vector A vector of names to check for uniqueness
+#' @param name_type The type of names to check (e.g., "long" or "short")
+#' @return An error message or nothing
+#' @noRd
+#'
+validate_unique_names <- function(names_vector, name_type) {
+  if (anyDuplicated(names_vector)) {
+    duplicates <- unique(names_vector[duplicated(names_vector)])
+    rlang::abort(glue::glue(
+      "Duplicate keys in {name_type} names of the translations: {paste0(duplicates, collapse = ', ')}"
+    ))
+  }
+}
+
 #' Abort if the guide does not contain all required elements
 #' @param guide A spreadsheet guide object
 #' @return An error message or nothing
@@ -48,40 +59,74 @@ read_guide <- function(path) {
 check_guide <- function(guide) {
   ## NOTE: Most of the validation of a guide should be performed using the JSON schema
 
-  # TODO: make translations optional
+  # Ensure translations are optional
+  if (!"translations" %in% names(guide)) {
+    guide$translations <- NULL
+  }
 
-  # Conditionally required element plate.format in case we have platedata
-  types <- unique(sapply(guide$locations, function(x) x$type))
-  if ('platedata' %in% types) {
-    if (!('plate.format' %in% names(guide))) {
-      rlang::abort("The spreadsheet guide must contain the 'plate.format' element when 'platedata' is present in the locations.")
-    }
-    if (!(as.character(guide$plate.format) %in% names(.plateformats))) {
-      rlang::abort(glue::glue("The plate format in the spreadsheet guide is not valid. It must be one of '24', '48', '96' or '384'."))
-    }
+  # Validate plate.format if platedata is present
+  if ("platedata" %in% unique(sapply(guide$locations, `[[`, "type"))) {
+    validate_plate_format(guide)
   }
 
-  # Check content of locations
-  for (i in seq_along(guide$locations)) {
-    if (guide$locations[[i]]$type == 'platedata') {
-      for (range in guide$locations[[i]]$ranges) {
-        check_dim(
-          range,
-          required_rows = .plateformats[[as.character(guide$plate.format)]]$rows + 1,
-          required_cols = .plateformats[[as.character(guide$plate.format)]]$cols + 1
-        )
-      }
-    } else {
-      if (guide$locations[[i]]$type == 'cells') {
-        dims <- dim(cellranger::as.cell_limits(guide$locations[[i]]$ranges[1]))
-        # if (range.dim[range.dim > 1] != length(varnames)) {
-        #   rlang::abort(glue::glue("The length of the range ({range.dim[range.dim > 1]}) differs from the number of variables given ({length(varnames)})."))
-        # }
-      }
-    }
+  # Validate each location in the guide
+  lapply(guide$locations, validate_location, guide)
+}
+
+#' Helper function to validate plate.format
+#' @param guide A spreadsheet guide object
+#' @return An error message or nothing
+#' @noRd
+#'
+validate_plate_format <- function(guide) {
+  if (!"plate.format" %in% names(guide)) {
+    rlang::abort("The spreadsheet guide must contain the 'plate.format' element when 'platedata' is present in the locations.")
+  }
+  if (!(as.character(guide$plate.format) %in% names(.plateformats))) {
+    rlang::abort(glue::glue("The plate format in the spreadsheet guide is not valid. It must be one of '24', '48', '96', or '384'."))
   }
 }
 
+#' Helper function to validate a single location
+#' @param location A location object from the guide
+#' @param guide A spreadsheet guide object
+#' @return An error message or nothing
+#' @noRd
+#'
+validate_location <- function(location, guide) {
+  if (location$type == "platedata") {
+    validate_platedata_ranges(location$ranges, guide$plate.format)
+  } else if (location$type == "cells") {
+    validate_cells(location$ranges)
+  }
+}
+
+#' Helper function to validate platedata ranges
+#' @param ranges A list of ranges for platedata
+#' @param plate_format The plate format specified in the guide
+#' @return An error message or nothing
+#' @noRd
+#'
+validate_platedata_ranges <- function(ranges, plate_format) {
+  for (range in ranges) {
+    check_dim(
+      range,
+      required_rows = .plateformats[[as.character(plate_format)]]$rows + 1,
+      required_cols = .plateformats[[as.character(plate_format)]]$cols + 1
+    )
+  }
+}
+
+#' Helper function to validate cell ranges
+#' @param ranges A list of ranges for cells
+#' @return An error message or nothing
+#' @noRd
+#' 
+validate_cells <- function(ranges) {
+  dims <- dim(cellranger::as.cell_limits(ranges[1]))
+  # TODO: add additional validation logic for cells if needed
+}
+
 #' Function to check the dimensions of a range
 #' @param range A range object
 #' @param required_rows The required number of rows
@@ -91,16 +136,32 @@ check_guide <- function(guide) {
 #'
 check_dim <- function(range, required_rows = NA, required_cols = NA) {
   if (is.na(required_rows) && is.na(required_cols)) {
-    rlang::abort("You must specify at least one of 'required_rows' or 'required_cols'")
+    rlang::abort("You must specify at least one of 'required_rows' or 'required_cols'.")
   }
+
   dims <- dim(cellranger::as.cell_limits(range))
-  if (all(!is.na(c(required_rows, required_cols))) && any(dims != c(required_rows, required_cols))) {
-    rlang::abort(glue::glue("The range {range} does not have the required dimensions. Expected: {required_rows} rows and {required_cols} columns"))
+
+  # Validate both rows and columns if both are specified
+  if (!is.na(required_rows) && !is.na(required_cols)) {
+    if (!all(dims == c(required_rows, required_cols))) {
+      rlang::abort(glue::glue(
+        "The range {range} does not have the required dimensions. Expected: {required_rows} rows and {required_cols} columns."
+      ))
+    }
+    return() # Exit early if both dimensions are validated
   }
+
+  # Validate rows if specified
   if (!is.na(required_rows) && dims[1] != required_rows) {
-    rlang::abort(glue::glue("The range {range} does not have the required number of rows. Expected: {required_rows}"))
+    rlang::abort(glue::glue(
+      "The range {range} does not have the required number of rows. Expected: {required_rows}."
+    ))
   }
+
+  # Validate columns if specified
   if (!is.na(required_cols) && dims[2] != required_cols) {
-    rlang::abort(glue::glue("The range {range} does not have the required number of columns. Expected: {required_cols}"))
+    rlang::abort(glue::glue(
+      "The range {range} does not have the required number of columns. Expected: {required_cols}."
+    ))
   }
 }

R/wells.R

@@ -15,16 +15,20 @@
 #' normalize_wells(c("a01", "A 2", "0", " A 4 ", "A05", "H012", "K12"), 96)
 #' normalize_wells(c("a01", "A 2", "0", " A 4 ", "A05", "H012", "K12"))
 #'
-#'
 normalize_wells <- function(v, format = NULL) {
+  # Normalize well names
   v <- as.character(v) |>
     stringr::str_remove_all(" ") |>
     stringr::str_to_upper() |>
     stringr::str_replace("(?<=[A-Z])0+", "")
+
+  # Validate well names if format is provided
   if (!is.null(format)) {
-    v <- check_wells(v , format, returnerror = FALSE)
+    v <- check_wells(v, format, returnerror = FALSE)
   }
-  v[!stringr::str_detect(v, "^[A-Z]+\\d++$")] <- NA
+
+  # Mark invalid well names as NA
+  v[!stringr::str_detect(v, "^[A-Z]+\\d+$")] <- NA
   v
 }
 
@@ -38,24 +42,33 @@ normalize_wells <- function(v, format = NULL) {
 #' @param format A single element character or numeric vector with the format of the plate
 #' @param returnerror A logical value indicating if the function should throw an error
 #' @return A vector with well names or `NA` values
-#'
 #' @noRd
+#' 
 check_wells <- function(wells, format, returnerror = TRUE) {
   format <- as.character(format)
+
+  # Validate plate format
   if (!format %in% names(.plateformats)) {
-    rlang::abort("format must be one of '24', '48', '96', or '384'")
+    rlang::abort("Invalid plate format. Must be one of '24', '48', '96', or '384'.")
   }
+
+  # Ensure wells is a character vector
   if (!is.character(wells)) {
-    rlang::abort("wells must be a character vector")
+    rlang::abort("The 'wells' parameter must be a character vector.")
   }
-  wrongwells <- !(wells %in% .plateformats[[format]]$wellnames)
-  if (any(wrongwells)) {
+
+  # Identify invalid wells
+  invalid_wells <- !(wells %in% .plateformats[[format]]$wellnames)
+
+  # Handle invalid wells
+  if (any(invalid_wells)) {
     if (returnerror) {
-      rlang::abort(glue::glue("wells not present in {format}-wells format"))
+      rlang::abort(glue::glue("The following wells are invalid for the {format}-well format: {paste(wells[invalid_wells], collapse = ', ')}"))
     } else {
-      wells[wrongwells] <- NA
+      wells[invalid_wells] <- NA
     }
   }
+
   wells
 }
 
@@ -70,13 +83,16 @@ check_wells <- function(wells, format, returnerror = TRUE) {
 #' @export
 #'
 well_from_rowcol <- function(row, col) {
+  # Validate inputs
   if (any(is.na(row)) || any(is.na(col))) {
-    rlang::abort("row and col must not contain NA values")
+    rlang::abort("Both 'row' and 'col' must not contain NA values.")
   }
   if (length(row) != length(col)) {
-    rlang::abort("The length of row and col must be the same")
+    rlang::abort("The lengths of 'row' and 'col' must be the same.")
   }
-  paste0(row, sprintf("%02.f", as.numeric(col)))
+
+  # Generate well names
+  paste0(row, sprintf("%02d", as.numeric(col)))
 }
 
 #' Calculate row and column from well name.
@@ -89,21 +105,29 @@ well_from_rowcol <- function(row, col) {
 #' rowcol_from_well(c("A1", "B2", "C3", NA), 48)
 #' # The order is preserved
 #' rowcol_from_well(c("H12", "A1"), 96)
+#' 
 rowcol_from_well <- function(well, format) {
   format <- as.character(format)
-  if (!length(format) == 1) {
-    rlang::abort("Plate format must be a single element character vector")
+
+  # Validate plate format
+  if (length(format) != 1) {
+    rlang::abort("Plate format must be a single-element character vector.")
   }
-  plfs <- names(.plateformats)
-  if (!as.character(format) %in% plfs) {
-    rlang::abort(glue::glue("Plate format must be one of ", paste0("'", plfs, "'", collapse = ", "), "."))
+  if (!format %in% names(.plateformats)) {
+    valid_formats <- paste(names(.plateformats), collapse = ", ")
+    rlang::abort(glue::glue("Invalid plate format. Must be one of: {valid_formats}."))
   }
+
+  # Validate well names
   if (!is.character(well)) {
-    rlang::abort("Well must be a character vector")
+    rlang::abort("The 'well' parameter must be a character vector.")
   }
-  if (any(!well[!is.na(well)] %in% .plateformats[[format]]$wellnames)) {
-    rlang::abort(glue::glue("Wells not present in {format}-wells format"))
+  invalid_wells <- well[!is.na(well) & !(well %in% .plateformats[[format]]$wellnames)]
+  if (length(invalid_wells) > 0) {
+    rlang::abort(glue::glue("The following wells are invalid for the {format}-well format: {paste(invalid_wells, collapse = ', ')}"))
   }
+
+  # Map wells to rows and columns
   indices <- match(well, .plateformats[[format]]$map$well)
-  .plateformats[[format]]$map[indices, c('row', 'col')]
+  .plateformats[[format]]$map[indices, c("row", "col")]
 }