Merge branch 'development'

merging updates from the development branch

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/read.R

@@ -118,6 +118,7 @@ read_table <- function(drfile, sheet, ranges, translate = FALSE, translations =
 #' @noRd
 #'
 plate_to_df <- function(d) {
+  # TODO: handle plate formats generically
   var <- names(d)[1]
   newdf <- tibble::tibble(
     row = rep(LETTERS[1:8], 12),
@@ -126,7 +127,6 @@ plate_to_df <- function(d) {
       as.vector()
   )
 
-  # TODO: handle plate formats generically
   names(newdf) <- c("row", "col", var)
   newdf
 }

R/utils.R

@@ -57,7 +57,53 @@ has_star <- function(x) {
 #' `format(as.POSIXct(x, tz=""), format="%Y-%m-%d")` to get a string with format
 #' YYYY-MM-DD.
 #'
-#  TODO: check the previous statements
+#  TODO: check the previous and following statements
+#
+# ACCORDING TO Copilot:
+# ### **Analysis**:
+# 1. **Excel Date Storage**:
+#    - Excel does **not** store dates as the number of days since January 1, 1970. Instead:
+#      - Excel stores dates as the number of days since **January 1, 1900** (for Windows systems)
+#        or **January 1, 1904** (for macOS systems).
+#      - Excel also incorrectly assumes that 1900 was a leap year, which introduces an offset of
+#        1 day for dates before March 1, 1900.
+#
+# 2. **`read_excel` Behavior**:
+#    - When using `readxl::read_excel`, Excel dates are typically read as numeric values representing
+#      the number of days since Excel's epoch (e.g., 1900 or 1904). These values are **not
+#      automatically converted to POSIXct** by `read_excel`. The user must manually convert them.
+#
+# 3. **POSIXct Conversion**:
+#    - The description mentions converting the number to a date using `as.POSIXct(as.integer(x))`.
+#      However:
+#      - This assumes that the numeric value `x` is already in seconds since January 1, 1970, which
+#        is not the case for Excel dates.
+#      - To convert Excel dates to R's `POSIXct`, you need to account for Excel's epoch (e.g.,
+#        subtract the appropriate offset for 1900 or 1904).
+#
+# 4. **Formatting**:
+#    - The description correctly states that `format(as.POSIXct(x, tz=""), format="%Y-%m-%d")`
+#      can be used to format a `POSIXct` object as a string in the `YYYY-MM-DD` format.
+#
+# ### **Corrected Description**:
+# Here’s a revised and accurate version of the description:
+#
+# Excel stores dates as numeric values representing the number of days since
+# January 1, 1900 (Windows) or January 1, 1904 (macOS). Note that Excel's 1900
+# date system incorrectly assumes 1900 was a leap year, which introduces a
+# 1-day offset for dates before March 1, 1900.
+#
+# When read using `readxl::read_excel`, Excel dates are imported as numeric
+# values. To convert these to R's `POSIXct` class, you must account for Excel's
+# epoch. For example, subtract 25569 days (the number of days between January 1,
+# 1900, and January 1, 1970) and convert to seconds by multiplying by 86400.
+#
+# Example conversion:
+# `as.POSIXct((x - 25569) * 86400, origin = "1970-01-01", tz = "")`
+#
+# To format the date as a string in `YYYY-MM-DD` format, use:
+# `format(as.POSIXct(...), format = "%Y-%m-%d")`.
+#
 #' @return A vector of the specified atomic class
 #' @noRd
 coerce <- function(x, atomicclass) {