Add helper to test

NEWS.md

@@ -1,5 +1,8 @@
 # experDesign (development version)
 
+* Check that index used in `inspect` has a valid length, positions and 
+  replications matching the data provided.
+
 # experDesign 0.3.0
 
 * Fixed a bug in `spatial()` where multiple samples could be assigned to the 

R/reporting.R

@@ -16,6 +16,8 @@
 #' head(batches)
 inspect <- function(i, pheno, omit = NULL, index_name = "batch") {
 
+  consistent_index(i, pheno)
+
   batch <- batch_names(translate_index(i))
   pheno <- apply_index(pheno, i)
   # Remove old rows (only needed to inspect changes)

R/utils.R

@@ -1,3 +1,4 @@
+# Colum type helpers ####
 is_num <- function(x, ...) {
   if (is.null(ncol(x))) {
     is.numeric(x)
@@ -27,6 +28,7 @@ is_cat <- function(x, ...) {
   }
 }
 
+# Other ####
 
 omit <- function(pheno, omit){
   # Omit columns
@@ -125,8 +127,8 @@ release_bullets <- function() {
     "Run: cffr::cff_write()")
 }
 
-# Numbers are evaluated 4 times (mean, sd, mad, na),
-# and categories only 3:  na, entropy, independence.
+# Numbers are evaluated 4 times: mean, sd, mad, na.
+# categories  evaluated 3 times:  na, entropy, independence.
 # check this on evaluate_index
 evaluations <- function(num, eval_cat = 4, eval_num = 3) {
   eval_n <- ifelse(num, eval_cat, eval_num)
@@ -144,3 +146,26 @@ add_column <- function(x, values, name) {
   rownames(out) <- NULL
   out
 }
+
+
+consistent_index <- function(i, pheno) {
+  ui <- unlist(i, FALSE, FALSE)
+  not_matching <- sum(lengths(i)) != NROW(pheno)
+  index_longer <- sum(lengths(i)) > NROW(pheno)
+  no_replicate <- !any(table(ui) > 1)
+  bigger_position <- max(ui, na.rm = TRUE) > NROW(pheno)
+
+  if (bigger_position) {
+    stop("The index has positions that are higher than the number of rows in the data.", call. = FALSE)
+  }
+
+  if (not_matching && index_longer && no_replicate) {
+    stop("Index is longer than the data and there is no replicate.", call. = FALSE)
+  }
+
+  index_shorter <- sum(lengths(i)) < NROW(pheno)
+  if (not_matching && index_shorter) {
+    stop("Index is shorter than the data provided.", call. = FALSE)
+  }
+  TRUE
+}

tests/testthat/test-consistent_index.R

@@ -0,0 +1,13 @@
+test_that("consitent_index works", {
+  data(survey, package = "MASS")
+  index <- expect_warning(design(survey[, c("Sex", "Smoke", "Age")], size_subset = 50,
+                  iterations = 10))
+  # Test error on index larger than data:
+  # FIXME: what with replicates?
+  expect_error(consistent_index(index, survey[1:40, columns]))
+  # Test error on index shorter than data
+  expect_error(consistent_index(index[1:2], survey[, columns]))
+  index[[1]][1] <- 238
+  # Test error on index with indices not in data
+  expect_error(consistent_index(index, survey[, columns]))
+})