tests/whichIndex.R

source("incl/start,load-only.R")

message("*** whichIndex() ...")

dims <- list(
  c(1),
  c(1, 1),
  c(2),
  c(2, 1),
  c(3, 4, 3)
)

for (dim in dims) {
  printf("Dimensions: (%s)\n", paste(dim, collapse = ", "))
  dimnames <- lapply(dim, FUN = function(n) letters[seq_len(n)])
  X <- array(seq_len(prod(dim)), dim = dim, dimnames = dimnames)
  print(X)

  idxs <- unique(round(seq(from = 1L, to = length(X), length.out = 5)))
  print(idxs)
  stopifnot(all(X[idxs] == idxs))

  ## (a) By matrix and dimindices
  I <- arrayInd(idxs, .dim = dim(X))
  print(I)
  idxs2 <- whichIndex(I, dim = dim(X))
  print(idxs2)
  stopifnot(all(idxs2 == idxs))

  ## (b) By matrix and dimnames
  N <- array(NA_character_, dim = dim(I))
  for (kk in seq_len(ncol(N))) {
    N[, kk] <- dimnames[[kk]][I[, kk]]
  }
  print(N)
  idxs3 <- whichIndex(N, dim = dim(X), dimnames = dimnames(X))
  print(idxs3)
  stopifnot(all(idxs3 == idxs))

  ## (b) By data.frame
  D <- as.data.frame(I)
  for (cc in seq(from = 1L, to = ncol(D))) D[[cc]] <- N[, cc]
  print(D)
  idxs4 <- whichIndex(D, dim = dim(X), dimnames = dimnames(X))
  print(idxs4)
  stopifnot(all(idxs4 == idxs))
}


## Exceptions
dim <- c(2, 3)
ndim <- length(dim)
dimnames <- lapply(dim, FUN = function(n) letters[seq_len(n)])

I <- matrix(c(1, 1, 2, 4), ncol = ndim)
res <- try(idxs <- whichIndex(I, dim = dim, dimnames = dimnames), silent = TRUE)
stopifnot(inherits(res, "try-error"))

I <- matrix(c(0, 0), ncol = ndim)
res <- try(idxs <- whichIndex(I, dim = dim, dimnames = dimnames), silent = TRUE)
stopifnot(inherits(res, "try-error"))

I <- matrix(c("a", "q"), ncol = ndim)
res <- try(idxs <- whichIndex(I, dim = dim, dimnames = dimnames), silent = TRUE)
stopifnot(inherits(res, "try-error"))

D <- data.frame(a = c(1, 1), b = c(2, 4))
res <- try(idxs <- whichIndex(D, dim = dim, dimnames = dimnames), silent = TRUE)
stopifnot(inherits(res, "try-error"))

D <- data.frame(a = c("a", "q"), b = c(1, 2), stringsAsFactors = FALSE)
res <- try(idxs <- whichIndex(D, dim = dim, dimnames = dimnames), silent = TRUE)
stopifnot(inherits(res, "try-error"))

message("*** whichIndex() ... DONE")

source("incl/end.R")

Try the future package in your browser

Any scripts or data that you put into this service are public.

future documentation built on July 9, 2023, 6:31 p.m.