Allow to remove rows and columns

Improves position handling via a helper

Close #52

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")),

NEWS.md

@@ -1,13 +1,17 @@
 # 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). 
    If you relied on positional arguments it will break your scripts. 
 
 * 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 

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
+}

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
 }
 

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))
+})