From 665d64edd5cabbba756b30b12d7bf953e8e9cfb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs?= Date: Tue, 7 May 2024 23:01:18 +0200 Subject: [PATCH] Allow to remove rows and columns Improves position handling via a helper Close #52 --- DESCRIPTION | 2 +- NEWS.md | 6 +++- R/spatial.R | 59 ++++++++++++++++++++++------------- R/utils.R | 4 +-- tests/testthat/test-spatial.R | 27 ++++++++++++++++ 5 files changed, 73 insertions(+), 25 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8a40a1d..384ac65 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: experDesign Title: Design Experiments for Batches -Version: 0.3.0.9002 +Version: 0.3.0.9003 Authors@R: c( person("Lluís", "Revilla Sancho", , "lluis.revilla@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9747-2570")), diff --git a/NEWS.md b/NEWS.md index cb0ddf5..dd1454f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # experDesign (development version) -* Check that index used in `inspect` has a valid length, positions and +* Check that index used in `inspect()` has a valid length, positions and replications matching the data provided. * `check_data()` gains a new omit argument (#49). @@ -8,6 +8,10 @@ * Omitting non existing columns now creates a warning. +* Now it is possible to remove full rows or columns from `spatial()`: like `remove_positions = "A"` (#52). + +* Spatial indexes are returned in row, column order: A1, A2, A3, ... A10, B1,. + # experDesign 0.3.0 * Fixed a bug in `spatial()` where multiple samples could be assigned to the diff --git a/R/spatial.R b/R/spatial.R index f3ee2be..d9190bf 100644 --- a/R/spatial.R +++ b/R/spatial.R @@ -22,30 +22,13 @@ spatial <- function(index, pheno, omit = NULL, remove_positions = NULL, rows = L stopifnot(length(dim(pheno)) == 2) stopifnot(is_numeric(iterations)) - nrow <- length(rows) - ncol <- length(columns) - - if (is.null(rows) || length(rows) == 0) { - stop("Please provide at least one row.", call. = FALSE) - } - if (is.null(columns) || length(columns) == 0) { - stop("Please provide at least one column.", call. = FALSE) - } - if ((nrow*ncol - length(remove_positions)) < max(lengths(index))) { + position <- handle_positions(rows, columns, remove_positions) + if (length(position) < max(lengths(index))) { stop("The size for the batch is smaller than the samples it must contain.", "\n\tPlease check the rows and columns or how you created the index.", call. = FALSE) } - positions <- position_name(rows, columns) - if (any(!remove_positions %in% positions$name)) { - stop("Unrecognized position to remove.", - "\n\tCheck that it is a combination of rows and columns: A1, A3...", - call. = FALSE) - } - - position <- positions$name[!positions$name %in% remove_positions] - opt <- Inf # Calculate batches @@ -69,7 +52,6 @@ spatial <- function(index, pheno, omit = NULL, remove_positions = NULL, rows = L eval_n <- evaluations(num) - n_positions <- length(position) for (j in seq_len(iterations)) { i <- create_index4index(i2, name = position) @@ -89,5 +71,40 @@ spatial <- function(index, pheno, omit = NULL, remove_positions = NULL, rows = L "It allocated more sample to the previous index than possible.", call. = FALSE) } - val + # Return positions ordered by row and column + m <- match(position_name(rows, columns)$name, names(val)) + val[m[!is.na(m)]] } + +handle_positions <- function(rows, columns, remove_positions) { + + if (is.null(rows) || length(rows) == 0) { + stop("Please provide at least one row.", call. = FALSE) + } + if (is.null(columns) || length(columns) == 0) { + stop("Please provide at least one column.", call. = FALSE) + } + + positions <- position_name(rows, columns) + + k_position <- !positions$name %in% remove_positions + k_rows <- !positions$row %in% remove_positions + k_columns <- !positions$column %in% remove_positions + mix_positions <- any(!k_position) && (any(!k_rows) || any(!k_columns)) + if (mix_positions) { + warning("There is a mix of specific positions and rows or columns.") + } + p <- positions[k_position & k_rows & k_columns, ,drop = FALSE] + + if (nrow(p) == 0L) { + stop("No position is left. Did you remove too many positions?", + call. = FALSE) + } + + if (length(remove_positions) > (nrow(positions) - nrow(p))) { + stop("Unrecognized position to remove.", + "\n\tCheck that it is a combination of rows and columns: A1, A3, or full rows and columns ...", + call. = FALSE) + } + p$name +} \ No newline at end of file diff --git a/R/utils.R b/R/utils.R index 8b68ad1..7e46e19 100644 --- a/R/utils.R +++ b/R/utils.R @@ -70,9 +70,9 @@ translate_index <- function(index, position_name <- function(rows, columns) { positions <- expand.grid(rows, columns, stringsAsFactors = FALSE) - positions$Var2 <- as.character(positions$Var2) - positions$name <- apply(positions, 1, paste0, collapse = "") colnames(positions)[1:2] <- c("row", "column") + positions <- positions[order(positions$row, positions$column), ] + positions$name <- paste0(positions$row, positions$column) positions } diff --git a/tests/testthat/test-spatial.R b/tests/testthat/test-spatial.R index 6892ea1..52855b7 100644 --- a/tests/testthat/test-spatial.R +++ b/tests/testthat/test-spatial.R @@ -39,3 +39,30 @@ test_that("spatial don't duplicate samples", { expect_false(any(table(batch_names(index), batch_names(index2)) > 1)) }) +test_that("Removing rows works", { + data(survey, package = "MASS") + set.seed(21829) + nas <- c(137, 70) + index <- design(survey[-nas, c("Sex", "Smoke", "Age")], size_subset = 50, + iterations = 25) + index2 <- spatial(index, survey[-nas, c("Sex", "Smoke", "Age")], + rows = LETTERS[1:9], remove_positions = "B", + columns = 1:12, iterations = 25) + expect_lte(length(index2), 9*12) + expect_true(all(names(index2) %in% position_name(rows = LETTERS[1:9], 1:12)$name)) + expect_false(any(table(batch_names(index), batch_names(index2)) > 1)) +}) + +test_that("Removing columns works", { + data(survey, package = "MASS") + set.seed(21289) + nas <- c(137, 70) + index <- design(survey[-nas, c("Sex", "Smoke", "Age")], size_subset = 50, + iterations = 25) + index2 <- spatial(index, survey[-nas, c("Sex", "Smoke", "Age")], + rows = LETTERS[1:9], remove_positions = "A", + columns = 1:12, iterations = 25) + expect_lte(length(index2), 9*12) + expect_true(all(names(index2) %in% position_name(rows = LETTERS[1:9], 1:12)$name)) + expect_false(any(table(batch_names(index), batch_names(index2)) > 1)) +}) \ No newline at end of file