Skip to content

Commit 58ea45f

Browse files
douwedouwe
committed
refactoring
1 parent 45d6a88 commit 58ea45f

File tree

4 files changed

+154
-49
lines changed

4 files changed

+154
-49
lines changed

‎R/guide.R‎

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,9 @@ read_guide <- function(path) {
2424
# Ensure reserved 'File path' and '.sourcefile' mapping
2525
if (!(".sourcefile" %in% guide$translations$short)) {
2626
if ("File path" %in% guide$translations$long) {
27-
rlang::abort("The 'long' variable name 'File path' is reserved for the 'short' name '.sourcefile' exclusively.")
27+
rlang::abort(
28+
"The 'long' variable name 'File path' is reserved for the 'short' name '.sourcefile' exclusively."
29+
)
2830
}
2931
guide$translations <- dplyr::bind_rows(
3032
guide$translations,
@@ -80,10 +82,14 @@ check_guide <- function(guide) {
8082
#'
8183
validate_plate_format <- function(guide) {
8284
if (!"plate.format" %in% names(guide)) {
83-
rlang::abort("The spreadsheet guide must contain the 'plate.format' element when 'platedata' is present in the locations.")
85+
rlang::abort(
86+
"The spreadsheet guide must contain the 'plate.format' element when 'platedata' is present in the locations."
87+
)
8488
}
8589
if (!(as.character(guide$plate.format) %in% names(.plateformats))) {
86-
rlang::abort(glue::glue("The plate format in the spreadsheet guide is not valid. It must be one of '24', '48', '96', or '384'."))
90+
rlang::abort(glue::glue(
91+
"The plate format in the spreadsheet guide is not valid. It must be one of '24', '48', '96', or '384'."
92+
))
8793
}
8894
}
8995

@@ -121,7 +127,7 @@ validate_platedata_ranges <- function(ranges, plate_format) {
121127
#' @param ranges A list of ranges for cells
122128
#' @return An error message or nothing
123129
#' @noRd
124-
#'
130+
#'
125131
validate_cells <- function(ranges) {
126132
dims <- dim(cellranger::as.cell_limits(ranges[1]))
127133
# TODO: add additional validation logic for cells if needed
@@ -136,7 +142,9 @@ validate_cells <- function(ranges) {
136142
#'
137143
check_dim <- function(range, required_rows = NA, required_cols = NA) {
138144
if (is.na(required_rows) && is.na(required_cols)) {
139-
rlang::abort("You must specify at least one of 'required_rows' or 'required_cols'.")
145+
rlang::abort(
146+
"You must specify at least one of 'required_rows' or 'required_cols'."
147+
)
140148
}
141149

142150
dims <- dim(cellranger::as.cell_limits(range))

‎R/read.R‎

Lines changed: 86 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,14 @@
88
#' @return A named list
99
#' @noRd
1010
#'
11-
read_cells <- function(drfile, sheet, variables, translate = FALSE, translations = NULL, atomicclass = 'character') {
11+
read_cells <- function(
12+
drfile,
13+
sheet,
14+
variables,
15+
translate = FALSE,
16+
translations = NULL,
17+
atomicclass = 'character'
18+
) {
1219
# Process each variable
1320
result <- lapply(variables, function(v) {
1421
# Ensure the cell address points to a single cell
@@ -18,7 +25,12 @@ read_cells <- function(drfile, sheet, variables, translate = FALSE, translations
1825

1926
# Read the cell value
2027
cell_data <- suppressMessages(
21-
readxl::read_excel(drfile, sheet = sheet, range = v$cell, col_names = FALSE)
28+
readxl::read_excel(
29+
drfile,
30+
sheet = sheet,
31+
range = v$cell,
32+
col_names = FALSE
33+
)
2234
)
2335

2436
# Handle empty cells
@@ -53,11 +65,25 @@ read_cells <- function(drfile, sheet, variables, translate = FALSE, translations
5365
#' @return A named list. Values are coerced to character
5466
#' @noRd
5567
#'
56-
read_keyvalue <- function(drfile, sheet, ranges, translate = FALSE, translations = NULL, atomicclass = "character", ...) {
68+
read_keyvalue <- function(
69+
drfile,
70+
sheet,
71+
ranges,
72+
translate = FALSE,
73+
translations = NULL,
74+
atomicclass = "character",
75+
...
76+
) {
5777
# Read and combine key-value pairs from the specified ranges
5878
kvtable <- lapply(ranges, function(range) {
59-
readxl::read_excel(drfile, sheet = sheet, range = range, col_names = c("key", "value"))
60-
}) |> dplyr::bind_rows()
79+
readxl::read_excel(
80+
drfile,
81+
sheet = sheet,
82+
range = range,
83+
col_names = c("key", "value")
84+
)
85+
}) |>
86+
dplyr::bind_rows()
6187

6288
# Translate keys if required
6389
if (translate) {
@@ -88,18 +114,29 @@ read_keyvalue <- function(drfile, sheet, ranges, translate = FALSE, translations
88114
#' @return A data frame in long format
89115
#' @noRd
90116
#'
91-
read_table <- function(drfile, sheet, ranges, translate = FALSE, translations = NULL, atomicclass = "character", ...) {
117+
read_table <- function(
118+
drfile,
119+
sheet,
120+
ranges,
121+
translate = FALSE,
122+
translations = NULL,
123+
atomicclass = "character",
124+
...
125+
) {
92126
# Read and combine data from the specified ranges
93127
tbl <- lapply(ranges, function(range) {
94128
readxl::read_excel(drfile, sheet = sheet, range = range)
95-
}) |> dplyr::bind_rows()
129+
}) |>
130+
dplyr::bind_rows()
96131

97132
# Coerce columns to the specified atomic class
98133
if (length(atomicclass) == 1) {
99134
tbl[] <- lapply(tbl, coerce, atomicclass)
100135
} else {
101136
if (length(atomicclass) != ncol(tbl)) {
102-
rlang::abort("The number of atomic classes must be 1 or equal to the number of columns in the table.")
137+
rlang::abort(
138+
"The number of atomic classes must be 1 or equal to the number of columns in the table."
139+
)
103140
}
104141
tbl[] <- Map(coerce, tbl, atomicclass)
105142
}
@@ -136,11 +173,20 @@ plate_to_df <- function(d) {
136173
#' @inherit read_keyvalue
137174
#' @return A data frame in long format
138175
#' @noRd
139-
read_key_plate <- function(drfile, sheet, ranges, translate = FALSE, translations = NULL, atomicclass = "character", ...) {
176+
read_key_plate <- function(
177+
drfile,
178+
sheet,
179+
ranges,
180+
translate = FALSE,
181+
translations = NULL,
182+
atomicclass = "character",
183+
...
184+
) {
140185
# Read and convert each range to a long-format data frame
141186
chunks <- lapply(ranges, function(range) {
142187
plate <- readxl::read_excel(drfile, sheet = sheet, range = range) |>
143188
plate_to_df()
189+
plate
144190
})
145191

146192
# Combine all chunks into a single data frame
@@ -184,11 +230,24 @@ gentranslator <- function(type = 'long-short') {
184230
function(v, translations) {
185231
matchdf <- data.frame(v)
186232
names(matchdf) <- col_from
187-
matches <- dplyr::left_join(matchdf, translations, by = {{col_from}})
233+
matches <- dplyr::left_join(matchdf, translations, by = {{ col_from }})
188234
if (any(is.na(matches[[col_to]]))) {
189-
missing_translations <- paste0("'", matches[[col_from]][is.na(matches[[col_to]])], "'", collapse=", ")
190-
rlang::warn(c(glue::glue("Missing translations for: {missing_translations}."), "i" = glue::glue("Will use original {col_from} names.")), use_cli_format = TRUE)
191-
matches[[col_to]][is.na(matches[[col_to]])] <- matches[[col_from]][is.na(matches[[col_to]])]
235+
missing_translations <- paste0(
236+
"'",
237+
matches[[col_from]][is.na(matches[[col_to]])],
238+
"'",
239+
collapse = ", "
240+
)
241+
rlang::warn(
242+
c(
243+
glue::glue("Missing translations for: {missing_translations}."),
244+
"i" = glue::glue("Will use original {col_from} names.")
245+
),
246+
use_cli_format = TRUE
247+
)
248+
matches[[col_to]][is.na(matches[[col_to]])] <- matches[[
249+
col_from
250+
]][is.na(matches[[col_to]])]
192251
}
193252
return(matches[[col_to]])
194253
}
@@ -254,7 +313,11 @@ read_data <- function(drfile, guide, checkname = FALSE) {
254313
)
255314

256315
# The default atomic class is "character"
257-
atomicclass <- if (!is.null(location$atomicclass)) location$atomicclass else "character"
316+
atomicclass <- if (!is.null(location$atomicclass)) {
317+
location$atomicclass
318+
} else {
319+
"character"
320+
}
258321

259322
# Read data using the appropriate function
260323
chunk <- if (location$type == "cells") {
@@ -300,12 +363,16 @@ read_data <- function(drfile, guide, checkname = FALSE) {
300363
}
301364
}
302365
} else {
303-
rlang::abort("Variable '.template$version' not found under cells or keyvalue variables")
366+
rlang::abort(
367+
"Variable '.template$version' not found under cells or keyvalue variables"
368+
)
304369
}
305370
}
306371

307372
# Check template name if required
308-
if (checkname && guide$template.name != result$template.metadata$template.name) {
373+
if (
374+
checkname && guide$template.name != result$template.metadata$template.name
375+
) {
309376
rlang::abort(glue::glue(
310377
"The name of the guide ({guide$template.name}) does not match the name of the excel template ({result$template.metadata$template.name})."
311378
))
@@ -332,7 +399,9 @@ combine_results <- function(existing, chunk, type) {
332399
"table" = dplyr::bind_rows(existing, chunk),
333400
"platedata" = suppressMessages(dplyr::full_join(existing, chunk)),
334401
"cells" = c(existing, chunk),
335-
rlang::abort(glue::glue("Unsupported location type for combining results: {type}"))
402+
rlang::abort(glue::glue(
403+
"Unsupported location type for combining results: {type}"
404+
))
336405
)
337406
}
338407

‎R/utils.R‎

Lines changed: 38 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -11,12 +11,17 @@
1111
#' @export
1212
kvlist_to_table <- function(kvlist, guide, reverse.translate = TRUE) {
1313
if (reverse.translate && !("translations" %in% names(guide))) {
14-
rlang::abort("There are no translations in the guide. If reverse.translate is TRUE, translations must be provided")
14+
rlang::abort(
15+
"There are no translations in the guide. If reverse.translate is TRUE, translations must be provided"
16+
)
1517
}
16-
tbl <- tibble::tibble(key = names(kvlist), value = as.vector(unlist(lapply(kvlist, paste0, collapse=", "))))
18+
tbl <- tibble::tibble(
19+
key = names(kvlist),
20+
value = as.vector(unlist(lapply(kvlist, paste0, collapse = ", ")))
21+
)
1722
if (reverse.translate) {
1823
tbl <- tbl |>
19-
dplyr::mutate (key = short_to_longnames(.data$key, guide$translations))
24+
dplyr::mutate(key = short_to_longnames(.data$key, guide$translations))
2025
}
2126
tbl
2227
}
@@ -50,8 +55,14 @@ check_coerce <- function(x, cofun, atomicclass) {
5055
result <- suppressWarnings(do.call(cofun, list(x)))
5156
failures = is.na(result) & !is.na(x)
5257
if (any(failures)) {
53-
wrong <- paste0("'", x[failures], "'", collapse = ", ")
54-
rlang::warn(c(glue::glue("Expected {atomicclass} values but obtained {wrong}"), i="Replacing with NA"), use_cli_format = TRUE)
58+
wrong <- paste0("'", x[failures], "'", collapse = ", ")
59+
rlang::warn(
60+
c(
61+
glue::glue("Expected {atomicclass} values but obtained {wrong}"),
62+
i = "Replacing with NA"
63+
),
64+
use_cli_format = TRUE
65+
)
5566
}
5667
return(result)
5768
}
@@ -80,19 +91,25 @@ asdate <- function(x) {
8091
tryCatch(
8192
as.Date(x),
8293
error = function(e) {
83-
rlang::warn(c(
84-
glue::glue("Can't convert character '{x}' to Date: {e$message}"),
85-
"i" = "Returning NA"
86-
), use_cli_format = TRUE)
94+
rlang::warn(
95+
c(
96+
glue::glue("Can't convert character '{x}' to Date: {e$message}"),
97+
"i" = "Returning NA"
98+
),
99+
use_cli_format = TRUE
100+
)
87101
as.Date(NA)
88102
}
89103
)
90104
}
91105
} else {
92-
rlang::warn(c(
93-
glue::glue("Can't convert object of class {class(x)} to Date"),
94-
"i" = "Returning NA"
95-
), use_cli_format = TRUE)
106+
rlang::warn(
107+
c(
108+
glue::glue("Can't convert object of class {class(x)} to Date"),
109+
"i" = "Returning NA"
110+
),
111+
use_cli_format = TRUE
112+
)
96113
as.Date(NA)
97114
}
98115
}
@@ -120,11 +137,12 @@ asdate <- function(x) {
120137
#' @return A vector of the specified atomic class
121138
#' @noRd
122139
coerce <- function(x, atomicclass) {
123-
switch(atomicclass,
124-
"character" = as.character(x),
125-
"numeric" = check_coerce(x, "as.numeric", "numeric"),
126-
"integer" = check_coerce(x, "as.integer", "integer"),
127-
"logical" = check_coerce(x, "as.logical", "logical"),
128-
"date" = check_coerce(x, "asdate", "date"),
129-
)
140+
switch(
141+
atomicclass,
142+
"character" = as.character(x),
143+
"numeric" = check_coerce(x, "as.numeric", "numeric"),
144+
"integer" = check_coerce(x, "as.integer", "integer"),
145+
"logical" = check_coerce(x, "as.logical", "logical"),
146+
"date" = check_coerce(x, "asdate", "date"),
147+
)
130148
}

‎R/wells.R‎

Lines changed: 17 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ normalize_wells <- function(v, format = NULL) {
4343
#' @param returnerror A logical value indicating if the function should throw an error
4444
#' @return A vector with well names or `NA` values
4545
#' @noRd
46-
#'
46+
#'
4747
check_wells <- function(wells, format, returnerror = TRUE) {
4848
format <- as.character(format)
4949

@@ -57,7 +57,9 @@ check_wells <- function(wells, format, returnerror = TRUE) {
5757

5858
# Ensure wells is a character vector
5959
if (!is.character(wells)) {
60-
rlang::abort("Invalid 'wells' argument {wells}. The 'wells' argument must be a character vector.")
60+
rlang::abort(
61+
"Invalid 'wells' argument {wells}. The 'wells' argument must be a character vector."
62+
)
6163
}
6264

6365
# Identify invalid wells
@@ -66,7 +68,9 @@ check_wells <- function(wells, format, returnerror = TRUE) {
6668
# Handle invalid wells
6769
if (any(invalid_wells)) {
6870
if (returnerror) {
69-
rlang::abort(glue::glue("The following wells are invalid for the {format}-well format: {paste(wells[invalid_wells], collapse = ', ')}"))
71+
rlang::abort(glue::glue(
72+
"The following wells are invalid for the {format}-well format: {paste(wells[invalid_wells], collapse = ', ')}"
73+
))
7074
} else {
7175
wells[invalid_wells] <- NA
7276
}
@@ -108,7 +112,7 @@ well_from_rowcol <- function(row, col) {
108112
#' rowcol_from_well(c("A1", "B2", "C3", NA), 48)
109113
#' # The order is preserved
110114
#' rowcol_from_well(c("H12", "A1"), 96)
111-
#'
115+
#'
112116
rowcol_from_well <- function(well, format) {
113117
format <- as.character(format)
114118

@@ -118,16 +122,22 @@ rowcol_from_well <- function(well, format) {
118122
}
119123
if (!format %in% names(.plateformats)) {
120124
valid_formats <- paste(names(.plateformats), collapse = ", ")
121-
rlang::abort(glue::glue("Invalid plate format. Must be one of: {valid_formats}."))
125+
rlang::abort(glue::glue(
126+
"Invalid plate format. Must be one of: {valid_formats}."
127+
))
122128
}
123129

124130
# Validate well names
125131
if (!is.character(well)) {
126132
rlang::abort("The 'well' parameter must be a character vector.")
127133
}
128-
invalid_wells <- well[!is.na(well) & !(well %in% .plateformats[[format]]$wellnames)]
134+
invalid_wells <- well[
135+
!is.na(well) & !(well %in% .plateformats[[format]]$wellnames)
136+
]
129137
if (length(invalid_wells) > 0) {
130-
rlang::abort(glue::glue("The following wells are invalid for the {format}-well format: {paste(invalid_wells, collapse = ', ')}"))
138+
rlang::abort(glue::glue(
139+
"The following wells are invalid for the {format}-well format: {paste(invalid_wells, collapse = ', ')}"
140+
))
131141
}
132142

133143
# Map wells to rows and columns

0 commit comments

Comments
 (0)