tests/testthat/test-DSArray-class.R

In PeteHaitch/DRMatrix: Compressed In-Memory Representation of 3-Dimensional Arrays That Contain Many Duplicate Slices

### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### DSArray-class
###

context("DSArray validity methods")

test_that(".valid.DSArray.key and validObject work", {
  expect_null(.valid.DSArray.key(xx), NULL)
  expect_error(validObject(xx), NA)
  msg <- paste0("'key' slot of a DSArray must be a matrix of ",
                "positive integers \\(NAs not permitted\\)")
  yy <- xx
  slot(yy, "key") <- -slot(yy, "key")
  expect_output(print(.valid.DSArray.key(yy)), msg)
  expect_error(validObject(yy), msg)
  yy <- xx
  slot(yy, "key")[1] <- NA_integer_
  expect_output(print(.valid.DSArray.key(yy)), msg)
  expect_error(validObject(yy), msg)
  yy <- xx
  slot(yy, "key", check = FALSE) <- array(slot(yy, "key"), dim = c(100, 2, 2))
  expect_output(print(.valid.DSArray.key(yy)), msg)
  expect_error(validObject(yy),
               "invalid object for slot \"key\" in class \"DSArray\"")
  yy <- xx
  storage.mode(slot(yy, "key")) <- "double"
  expect_output(print(.valid.DSArray.key(yy)), msg)
  expect_error(validObject(yy), msg)
  yy <- xx
  msg <- "Element\\(s\\) of key > nrow\\(val\\)"
  slot(yy, "key", check = FALSE) <- slot(yy, "key") + 1L
  expect_output(print(.valid.DSArray.key(yy)), msg)
  expect_error(validObject(yy), msg)
})

test_that(".valid.DSArray.val and validObject work", {
  expect_null(.valid.DSArray.val(xx))
  expect_error(validObject(xx), NA)
  msg <- "'val' slot of a DSArray must be a matrix"
  yy <- xx
  slot(yy, "val", check = FALSE) <- array(slot(yy, "val"), dim = c(nrow(yy), 4, 2))
  expect_output(print(.valid.DSArray.val(yy)), msg)
  expect_error(validObject(yy),
               "invalid object for slot \"val\" in class \"DSArray\"")
  yy <- xx
  msg <- "complex numbers not currently supported"
  slot(yy, "val", check = FALSE) <- slot(yy, "val") + 1i
  expect_output(print(.valid.DSArray.val(yy)), msg)
  expect_error(validObject(yy), msg)
})

context("DSArray constructor")

test_that("DSArray,matrix-method works", {
  m <- matrix(1:10, ncol = 2, dimnames = list(letters[1:5], LETTERS[1:2]))
  expect_is(DSArray(m), "DSArray")
  expect_identical(dimnames(DSArray(m)), list(rownames(m), NULL, colnames(m)))
  expect_null(dimnames(DSArray(unname(m))))
  dn <- list(LETTERS[1:5], LETTERS[6], LETTERS[7:8])
  expect_error(DSArray(m, dimnames = dn[1:2]),
               "supplied 'dimnames' must have length 3")
  expect_identical(dimnames(DSArray(m, dimnames = dn)), dn)
  dn <- list(LETTERS[1:5], LETTERS[6], LETTERS[7:9])
  expect_error(DSArray(m, dimnames = dn))
})

test_that("DSArray,missing-method works", {
  expect_true(dsa_identical_to_array(DSArray(), array(dim = c(1, 1, 1))))
})

test_that("DSArray,list-method works", {
  l <- lapply(seq_len(dim(x)[3]), function(k) x[, , k, drop = TRUE])
  expect_is(DSArray(l), "DSArray")
  expect_identical(dimnames(DSArray(l)), list(rownames(x), NULL, colnames(x)))
  expect_null(dimnames(unname(DSArray(l))))
  dn <- list(as.character(seq_len(nrow(l[[1]]))),
             as.character(rev(seq_len(length(l)))),
             as.character(-seq_len(ncol(l[[1]]))))
  expect_error(DSArray(l, dimnames = dn[1:2]),
               "supplied 'dimnames' must have length 3")
  expect_identical(dimnames(DSArray(l, dimnames = dn)), dn)
  dn <- list(as.character(seq_len(nrow(l[[1]]))),
             as.character(rev(seq_len(length(l)))),
             as.character(-seq_len(ncol(l[[1]]) + 1)))
  expect_error(DSArray(m, dimnames = dn))
  l2 <- lapply(seq_len(dim(x)[3]), function(k) x[, , k, drop = FALSE])
  expect_error(DSArray(l2), "All elements of 'x' must be matrix objects")
  l3 <- list(matrix(1:10, ncol = 2), matrix(1:100, ncol = 4))
  expect_error(DSArray(l3), "All elements of 'x' must have same dimensions")
})

test_that("DSArray,array-method works", {
  expect_error(DSArray(x + 1i),
               "complex numbers not currently supported")
  expect_error(DSArray(array(1:16, dim = rep(2, 4))),
               "array must have 3 dimensions")
  expect_error(DSArray(x, MARGIN = c(1, 2)), "incorrect value for 'MARGIN'")
  expect_error(DSArray(x, MARGIN = 4), "incorrect value for 'MARGIN'")
  a1 <- array(c(1L, 5L, 2L, 6L, 3L, 7L, 4L, 8L), dim = rep(2, 3))
  a2 <- array(c(1L, 2L, 5L, 6L, 3L, 4L, 7L, 8L), dim = rep(2, 3))
  a3 <- array(c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L), dim = rep(2, 3))
  expect_true(dsa_identical_to_array(DSArray(a1, MARGIN = 1L), a2))
  expect_true(dsa_identical_to_array(DSArray(a2, MARGIN = 2L), a2))
  expect_true(dsa_identical_to_array(DSArray(a3, MARGIN = 3L), a2))
  dn <- split(letters[1:6], rep(1:3, each = 2))
  A1 <- array(c(1L, 5L, 2L, 6L, 3L, 7L, 4L, 8L), dim = rep(2, 3), dn)
  A2 <- array(c(1L, 2L, 5L, 6L, 3L, 4L, 7L, 8L), dim = rep(2, 3), dn)
  A3 <- array(c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L), dim = rep(2, 3), dn)
  expect_identical(DSArray(a1, MARGIN = 1L, dimnames = c(dn[2], dn[1], dn[3])),
                   DSArray(A1, MARGIN = 1L))
  expect_identical(DSArray(a2, MARGIN = 2L, dimnames = c(dn[1], dn[2], dn[3])),
                   DSArray(A2, MARGIN = 2L))
  expect_identical(DSArray(a3, MARGIN = 3L, dimnames = c(dn[1], dn[3], dn[2])),
                   DSArray(A3, MARGIN = 3L))
  expect_true(dsa_identical_to_array(
    DSArray(array(10, dim = c(3, 1, 4)), MARGIN = 1L),
    array(10, dim = c(1, 3, 4))))
  expect_true(dsa_identical_to_array(
    DSArray(array(10, dim = c(1, 3, 4)), MARGIN = 2L),
    array(10, dim = c(1, 3, 4))))
  expect_true(dsa_identical_to_array(
    DSArray(array(10, dim = c(1, 4, 3)), MARGIN = 3L),
    array(10, dim = c(1, 3, 4))))
})

context("dimension-related getters and setters")

test_that("dim works", {
  expect_identical(dim(x), dim(xx))
})

test_that("nslice works", {
  expect_identical(nslice(xx), dim(x)[3])
})

test_that("length works", {
  expect_identical(length(x), length(xx))
})

test_that("dimnames works", {
  expect_identical(dimnames(x), dimnames(xx))
})

test_that("slicenames works", {
  expect_identical(slicenames(xx), dimnames(x)[[3]])
})

test_that("dimnames<- works", {
  dn <- lapply(list(seq(nrow(xx), 1), seq(ncol(xx), 1), seq(nslice(xx), 1)),
               as.character)
  dimnames(xx) <- dn
  expect_identical(dimnames(xx), dn)
  dimnames(xx) <- NULL
  expect_null(dimnames(xx))
})

test_that("slicenames<- works", {
  sn <- as.character(seq(nslice(xx), 1))
  slicenames(xx) <- sn
  expect_identical(slicenames(xx), sn)
  slicenames(xx) <- NULL
  expect_null(slicenames(xx))
})

# TODO: Logical i, j, k
context("[,DSArray,ANY-method")

test_that("drop is ignored in [,DSArray-metho", {
  msg <- "'drop' ignored '\\[,DSArray,ANY-method'"
  expect_warning(xx[1:10, , , drop = TRUE], msg)
  expect_warning(.extract_DSArray_subset(x = xx, i = 1:10, drop = TRUE), msg)
})

test_that("subsetting a DSArray by i works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  lapply(i, function(ii) {
    expect_true(dsa_identical_to_array(xx[ii, , ], x[ii, , , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(x = xx, i = ii), xx[ii, , ])
    expect_true(dsa_identical_to_array(xx[as.character(100 + ii), , ],
                                       x[as.character(100 + ii), , , drop = FALSE]))
    expect_identical(
      .extract_DSArray_subset(x = xx, i = as.character(100 + ii)),
      xx[as.character(100 + ii), , ])

  })
  i <- lapply(c(1, 10), function(ii) rep(TRUE, times = ii))
  lapply(i, function(ii) {
    expect_true(dsa_identical_to_array(xx[ii, , ], x[ii, , , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(x = xx, i = ii), xx[ii, , ])
  })
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  msg <- "subscript i out of bounds"
  lapply(i_bad, function(ii) {
    expect_error(xx[ii, , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii), msg)
    expect_error(xx[as.character(100 + ii), , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii)),
                 msg)
  })
})

test_that("subsetting a DSArray by j works or errors on bad input", {
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  lapply(j, function(jj) {
    expect_true(dsa_identical_to_array(xx[, jj, ], x[, jj, , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, j = jj), xx[, jj, ])
    expect_true(dsa_identical_to_array(xx[, letters[jj] , ],
                                       x[, letters[jj], , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, j = letters[jj]),
                     xx[, letters[jj], , ])

  })
  j <- lapply(c(1, 2), function(jj) rep(TRUE, times = jj))
  lapply(j, function(jj) {
    expect_true(dsa_identical_to_array(xx[, jj, ], x[, jj, , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, j = jj), xx[, jj, ])
  })
  j_bad <- list(ncol(xx) + 1, 1:(ncol(x) + 1))
  msg <- "subscript j out of bounds"
  lapply(j_bad, function(jj) {
    expect_error(xx[, jj, , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj), msg)
    expect_error(xx[, letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = letters[jj]), msg)
  })
})

test_that("subsetting a DSArray by k works or errors on bad input", {
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:6, 10))
  lapply(k, function(kk) {
    expect_true(dsa_identical_to_array(xx[, , kk], x[, , kk, drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, k = kk), xx[, , kk])
    expect_true(dsa_identical_to_array(xx[, , LETTERS[kk]],
                                       x[, , LETTERS[kk], drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, k = LETTERS[kk]),
                     xx[, , LETTERS[kk], ])

  })
  k <- lapply(c(1, 6), function(kk) rep(TRUE, times = kk))
  lapply(k, function(kk) {
    expect_true(dsa_identical_to_array(xx[, , kk], x[, , kk, drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, k = kk), xx[, , kk])
  })
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript k out of bounds"
  lapply(k_bad, function(kk) {
    expect_error(xx[, , kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, k = kk), msg)
    expect_error(xx[, , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, k = letters[kk]), msg)
  })
})

test_that("subsetting a DSArray by (i, j) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  Map(function(ii, jj) {
    expect_true(dsa_identical_to_array(xx[ii, jj, ], x[ii, jj, , drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = ii, j = jj), xx[ii, jj, ])
    expect_true(dsa_identical_to_array(xx[as.character(100 + ii), letters[jj], ],
                                       x[as.character(100 + ii), letters[jj], ,
                                         drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = as.character(100 + ii),
                                             j = letters[jj]),
                     xx[as.character(100 + ii), letters[jj], , ])
  }, ii = i, jj = j)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  msg <- "subscript j out of bounds"
  Map(function(ii, jj) {
    expect_error(xx[ii, jj, , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj]), msg)
  }, ii = i, jj = j_bad)
  msg <- "subscript i out of bounds"
  Map(function(ii, jj) {
    expect_error(xx[ii, jj, , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj]), msg)
  }, ii = c(i_bad, i_bad), jj = c(j[1:2], j_bad))
})

test_that("subsetting a DSArray by (i, k) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:6, 10))
  Map(function(ii, kk) {
    expect_true(dsa_identical_to_array(xx[ii, , kk], x[ii, , kk, drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = ii, k = kk), xx[ii, , kk])
    expect_true(dsa_identical_to_array(xx[as.character(100 + ii), , LETTERS[kk]],
                                       x[as.character(100 + ii), , LETTERS[kk],
                                         drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = as.character(100 + ii),
                                             k = LETTERS[kk]),
                     xx[as.character(100 + ii), , LETTERS[kk], ])
  }, ii = i, kk = k)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript k out of bounds"
  Map(function(ii, kk) {
    expect_error(xx[ii, , kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, k = kk), msg)
    expect_error(xx[as.character(100 + ii), , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         k = LETTERS[kk]), msg)
  }, ii = i, kk = k_bad)
  msg <- "subscript i out of bounds"
  Map(function(ii, kk) {
    expect_error(xx[ii, , kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, k = kk), msg)
    expect_error(xx[as.character(100 + ii), , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         k = LETTERS[kk]), msg)
  }, ii = c(i_bad, i_bad), kk = c(k[1:2], k_bad))
})

test_that("subsetting a DSArray by (j, k) works or errors on bad input", {
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:6, 10))
  Map(function(jj, kk) {
    expect_true(dsa_identical_to_array(xx[, jj, kk], x[, jj, kk, drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, j = jj, k = kk), xx[, jj, kk])
    expect_true(dsa_identical_to_array(xx[, letters[jj], LETTERS[kk]],
                                       x[, letters[jj], LETTERS[kk],
                                         drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, j = letters[jj],
                                             k = LETTERS[kk]),
                     xx[, letters[jj], LETTERS[kk], ])
  }, jj = j, kk = k)
  j_bad <- list(ncol(xx) + 1, 1:(ncol(x) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript k out of bounds"
  Map(function(jj, kk) {
    expect_error(xx[, jj, kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj, k = kk), msg)
    expect_error(xx[, letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, jj = j, kk = k_bad)
  msg <- "subscript j out of bounds"
  Map(function(jj, kk) {
    expect_error(xx[, jj, kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj, k = kk), msg)
    expect_error(xx[, letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, jj = c(j_bad, j_bad), kk = c(k[1:2], k_bad))
})

test_that("subsetting a DSArray by (i, j, k) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:6, 10))
  Map(function(ii, jj, kk) {
    expect_true(dsa_identical_to_array(xx[ii, jj, kk],
                                       x[ii, jj, kk, drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = ii, j = jj, k = kk),
                     xx[ii, jj, kk])
    expect_true(dsa_identical_to_array(
      xx[as.character(100 + ii), letters[jj], LETTERS[kk]],
      x[as.character(100 + ii), letters[jj], LETTERS[kk], drop = FALSE]))
    expect_identical(.extract_DSArray_subset(xx, i = as.character(100 + ii),
                                             j = letters[jj],
                                             k = LETTERS[kk]),
                     xx[as.character(100 + ii), letters[jj], LETTERS[kk], ])
  }, ii = i, jj = j, kk = k)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript i out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]),
                 msg)
  }, ii = c(i_bad, i_bad, i_bad, i_bad), jj = c(j[1:2], j_bad, j[1:2], j_bad),
  kk = c(k[1:2], k[1:2], k_bad, k_bad))
  msg <- "subscript j out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]),
                 msg)
  }, ii = c(i[1:2], i[1:2]), jj = c(j_bad, j_bad), kk = c(k[1:2], k_bad))
  msg <- "subscript k out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]),
                 msg)
  }, ii = i[1:2], jj = j[1:2], kk = k_bad)
})

# TODO: Logical i, j, k
context("[<-,DSArray-method")

test_that("Warning is emitted due to non-optimised method", {
  msg <- "Densifying. This can cause a large increase in memory usage"
  expect_warning(xx[1, , ] <- xx[2, , ], msg)
})

test_that("replacing a DSArray by i works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  y <- x
  yy <- xx
  lapply(i, function(ii) {
    v <- array(-99, dim = list(length(ii), ncol(xx), nslice(xx)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[ii, , ] <- v
    xx <- yy
    suppressWarnings(xx[ii, , ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[ii, , ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    i = ii,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[as.character(100 + ii), , ] <- v
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), , ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), , ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    i = as.character(100 + ii),
                                                    value = vv))
    expect_identical(xx, xxx)
  })
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  msg <- "subscript i out of bounds"
  lapply(i_bad, function(ii) {
    expect_error(xx[ii, , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii), msg)
    expect_error(xx[as.character(100 + ii), , ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii)),
                 msg)
  })
})

test_that("replacing a DSArray by j works or errors on bad input", {
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  y <- x
  yy <- xx
  lapply(j, function(jj) {
    v <- array(-99, dim = list(nrow(xx), length(jj), nslice(xx)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[, jj, ] <- v
    xx <- yy
    suppressWarnings(xx[, jj, ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, jj, ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    j = jj,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[, letters[jj], ] <- v
    xx <- yy
    suppressWarnings(xx[, letters[jj], ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, letters[jj], ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    j = letters[jj],
                                                    value = vv))
    expect_identical(xx, xxx)
  })
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  msg <- "subscript j out of bounds"
  lapply(j_bad, function(jj) {
    expect_error(xx[, jj, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj), msg)
    expect_error(xx[, letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = letters[jj]), msg)
  })
})

test_that("replacing a DSArray by k works or errors on bad input", {
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:2, 2))
  y <- x
  yy <- xx
  lapply(k, function(kk) {
    v <- array(-99, dim = list(nrow(xx), ncol(xx), length(kk)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[, , kk] <- v
    xx <- yy
    suppressWarnings(xx[, , kk] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, , kk] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    k = kk,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[, , LETTERS[kk]] <- v
    xx <- yy
    suppressWarnings(xx[, , LETTERS[kk]] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, , LETTERS[kk]] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    k = LETTERS[kk],
                                                    value = vv))
    expect_identical(xx, xxx)
  })
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript k out of bounds"
  lapply(k_bad, function(kk) {
    expect_error(xx[, , kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, k = kk), msg)
    expect_error(xx[, , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx, k = LETTERS[kk]), msg)
  })
})

test_that("replacing a DSArray by (i, j) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  y <- x
  yy <- xx
  Map(function(ii, jj) {
    v <- array(-99, dim = list(length(ii), length(jj), nslice(xx)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[ii, jj, ] <- v
    xx <- yy
    suppressWarnings(xx[ii, jj, ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[ii, jj, ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    i = ii,
                                                    j = jj,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[as.character(100 + ii), letters[jj], ] <- v
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), letters[jj], ] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), letters[jj], ] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    i = as.character(100 + ii),
                                                    j = letters[jj],
                                                    value = vv))
    expect_identical(xx, xxx)
  }, ii = i, jj = j)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  msg <- "subscript i out of bounds"
  Map(function(ii, jj) {
    expect_error(xx[ii, jj, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = as.character(100 + ii),
                                         j = letters[jj]), msg)
  }, ii = c(i_bad, i_bad), jj = c(j[1:2], j_bad))
  msg <- "subscript j out of bounds"
  Map(function(ii, jj) {
    expect_error(xx[ii, jj, ], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], ], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(100 + ii),
                                         j = letters[jj]), msg)
  }, ii = i, jj = j_bad)
})

test_that("replacing a DSArray by (i, k) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:2, 2))
  y <- x
  yy <- xx
  Map(function(ii, kk) {
    v <- array(-99, dim = list(length(ii), ncol(xx), length(kk)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[ii, , kk] <- v
    xx <- yy
    suppressWarnings(xx[ii, , kk] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[ii, , kk] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    i = ii,
                                                    k = kk,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[as.character(100 + ii), , LETTERS[kk]] <- v
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), , LETTERS[kk]] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), , LETTERS[kk]] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    i = as.character(100 + ii),
                                                    k = LETTERS[kk],
                                                    value = vv))
    expect_identical(xx, xxx)
  }, ii = i, kk = k)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript i out of bounds"
  Map(function(ii, kk) {
    expect_error(xx[ii, , kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, k = kk), msg)
    expect_error(xx[as.character(i), , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(i),
                                         k = LETTERS[kk]), msg)
  }, ii = c(i_bad, i_bad), kk = c(k[1:2], k_bad))
  msg <- "subscript k out of bounds"
  Map(function(ii, kk) {
    expect_error(xx[ii, , kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, k = kk), msg)
    expect_error(xx[as.character(100 + ii), , LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(100 + ii),
                                         k = LETTERS[kk]), msg)
  }, ii = i, kk = k_bad)
})

test_that("replacing a DSArray by (j, k) works or errors on bad input", {
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:2, 2))
  y <- x
  yy <- xx
  Map(function(jj, kk) {
    v <- array(-99, dim = list(nrow(xx), length(jj), length(kk)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[, jj, kk] <- v
    xx <- yy
    suppressWarnings(xx[, jj, kk] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, jj, kk] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    j = jj,
                                                    k = kk,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[, letters[jj], LETTERS[kk]] <- v
    xx <- yy
    suppressWarnings(xx[, letters[jj], LETTERS[kk]] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[, letters[jj], LETTERS[kk]] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    j = letters[jj],
                                                    k = LETTERS[kk],
                                                    value = vv))
    expect_identical(xx, xxx)
  }, jj = j, kk = k)
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript j out of bounds"
  Map(function(jj, kk) {
    expect_error(xx[, jj, kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj, k = kk), msg)
    expect_error(xx[, letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, jj = c(j_bad, j_bad), kk = c(k[1:2], k_bad))
  msg <- "subscript k out of bounds"
  Map(function(jj, kk) {
    expect_error(xx[, jj, kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, j = jj, k = kk), msg)
    expect_error(xx[, letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, jj = j, kk = k_bad)
})

# UP TO HERE: Testing
test_that("replacing a DSArray by (i, j, k) works or errors on bad input", {
  i <- list(1, 1:10, sample(nrow(xx)), rep(1:10, 10))
  j <- list(1, 1:2, sample(ncol(xx)), rep(1:3, 10))
  k <- list(1, 1:6, sample(nslice(xx)), rep(1:2, 2))
  y <- x
  yy <- xx
  Map(function(ii, jj, kk) {
    v <- array(-99, dim = list(length(ii), length(jj), length(kk)))
    vv <- DSArray(v, MARGIN = 2L)
    x <- y
    x[ii, jj, kk] <- v
    xx <- yy
    suppressWarnings(xx[ii, jj, kk] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[ii, jj, kk] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xxx,
                                                    i = ii,
                                                    j = jj,
                                                    k = kk,
                                                    value = vv))
    expect_identical(xx, xxx)
    x <- y
    x[as.character(100 + ii), letters[jj], LETTERS[kk]] <- v
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), letters[jj], LETTERS[kk]] <- vv)
    expect_true(dsa_identical_to_array(xx, x))
    xx <- yy
    suppressWarnings(xx[as.character(100 + ii), letters[jj], LETTERS[kk]] <- vv)
    xxx <- yy
    suppressWarnings(xxx <- .replace_DSArray_subset(x = xx,
                                                    i = as.character(100 + ii),
                                                    j = letters[jj],
                                                    k = LETTERS[kk],
                                                    value = vv))
    expect_identical(xx, xxx)
  }, ii = i, jj = j, kk = k)
  i_bad <- list(nrow(xx) + 1, 1:(nrow(xx) + 1))
  j_bad <- list(ncol(xx) + 1, 1:(ncol(xx) + 1))
  k_bad <- list(nslice(xx) + 1, 1:(nslice(xx) + 1))
  msg <- "subscript i out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, ii = c(i_bad, i_bad, i_bad, i_bad), jj = c(j[1:2], j_bad, j[1:2], j_bad),
  kk = c(k[1:2], k[1:2], k_bad, k_bad))
  msg <- "subscript j out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, ii = c(i[1:2], i[1:2]), jj = c(j_bad, j_bad), kk = c(k[1:2], k_bad))
  msg <- "subscript k out of bounds"
  Map(function(ii, jj, kk) {
    expect_error(xx[ii, jj, kk], msg)
    expect_error(.extract_DSArray_subset(x = xx, i = ii, j = jj, k = kk), msg)
    expect_error(xx[as.character(100 + ii), letters[jj], LETTERS[kk]], msg)
    expect_error(.extract_DSArray_subset(x = xx,
                                         i = as.character(100 + ii),
                                         j = letters[jj],
                                         k = LETTERS[kk]), msg)
  }, ii = i, jj = j, kk = k_bad)
})

test_that("Errors if no subcript supplied", {
  msg <- "Please provide at least one 'i', 'j', or 'k'"
  yy <- xx
  expect_error(yy[] <- xx, msg)
})

test_that("Errors if value has incorrect dimensions", {
  msg <- "number of items to replace is not a multiple of replacement length"
  expect_error(xx[1, ] <- xx, msg)
})

context("arbind,DSArray-method and acbind,DSArray-method")

test_that("arbind and acbind work on good input", {
  mapply(function(bind, along) {
    expect_true(dsa_identical_to_array(
      bind(xx[1, , ], xx[1, , ]),
      abind::abind(x[1, , , drop = FALSE], x[1, , , drop = FALSE],
                   along = along)))
    expect_true(dsa_identical_to_array(
      bind(xx, xx),
      abind::abind(x, x, along = along)))
  }, bind = c(arbind, acbind), along = 1:2)
})

test_that("arbind and acbind error on bad input", {
  msg <- "Cannot arbind/acbind DSArray objects with different nslice"
  expect_error(arbind(xx, DSArray(matrix(1:10, ncol = 2))), msg)
  expect_error(acbind(xx, DSArray(matrix(1:10, ncol = 2))), msg)
  msg <- "Cannot arbind DSArray objects with different ncol"
  expect_error(arbind(DSArray(array(1:10, dim = c(5, 1, 2))),
                     DSArray(array(1:20, dim = c(5, 2, 2)))),
               msg)
  msg <- "Cannot acbind DSArray objects with different nrow"
  expect_error(acbind(DSArray(array(1:10, dim = c(1, 5, 2))),
                     DSArray(array(1:20, dim = c(2, 5, 2)))),
               msg)
})

context("densify,DSArray-method and coercion")

test_that("coercion works as expected", {
  expect_identical(densify(xx), x)
  expect_identical(as(xx, "array"), x)
})

# TODO: Test dsa[0, 0, 0] gives same result as a[0, 0, 0],
#       dsa[1, 0, 1] as a[1, 0, 1], etc. provided that in doing so I don't
#       break the show,DSArray-method