tests/testthat/test-ring-matrix.R

In ring: Circular / Ring Buffers

context("ring_matrix")

test_that("basic use", {
  load_ring_matrix()
  set.seed(1)
  nc <- 5L

  for (environment in c(TRUE, FALSE)) {
    for (type in names(sizes)) {
      m <- ring_matrix(100, nc, type, environment)
      if (!environment) {
        expect_equal(m$buf$stride(), nc * sizes[[type]])
      }
      expect_equal(dim(m), c(0, nc))

      nr <- 3
      nn <- nr * m$nc
      dat <- matrix(pool(type, nr * m$nc), nr, m$nc)

      expect_equal(m[], dat[integer(0), ])

      expect_equal(head(m), dat[integer(0), ])
      expect_equal(tail(m), dat[integer(0), ])

      ring_matrix_push(m, dat)

      expect_equal(ring_matrix_get(m), dat)
      expect_equal(ring_matrix_get(m, 1:2), dat[1:2, , drop = FALSE])

      expect_equal(m[], dat[])
      expect_equal(m[, ], dat[, ])
      expect_equal(m[1:2, ], dat[1:2, ])
      expect_equal(m[1, ], dat[1, ])
      expect_equal(m[1, , drop = FALSE], dat[1, , drop = FALSE])
      expect_equal(m[, 1], dat[, 1])
      expect_equal(m[, 1, drop = FALSE], dat[, 1, drop = FALSE])

      idx <- cbind(sample(nrow(dat), nc, TRUE),
                   sample(ncol(dat), nc, TRUE))
      expect_equal(m[idx], dat[idx])

      expect_equal(dim(m), c(nr, nc))
      expect_equal(head(m), dat)
      expect_equal(head(m, 1), dat[1, , drop = FALSE])
      expect_equal(tail(m), dat)
      expect_equal(tail(m, 1), dat[nr, , drop = FALSE])

      expect_null(dimnames(m))
      expect_null(colnames(m))

      colnames(m) <- letters[1:nc]
      expect_equal(colnames(m), letters[1:nc])
      expect_equal(dimnames(m), list(NULL, letters[1:nc]))
      colnames(m) <- NULL
      expect_null(dimnames(m))
      expect_null(colnames(m))

      expect_error(rownames(m) <- letters[1:nr],
                   "Cannot set rownames of a ring matrix")
      expect_error(dimnames(m) <- list(letters[1:nr], letters[1:nc]),
                   "Cannot set rownames of a ring matrix")

      next
      ## These are disabled as they don't currently work as rbind is
      ## not a "real" S3 generic and has odd dispatch (possibly).
      m2 <- rbind(m, dat)
      expect_identical(m, m2) # reference
      expect_equal(nrow(m), nr * 2)
      expect_equal(as.matrix(m), rbind(dat, dat))

      m3 <- rbind(m, dat[nr:1, ], dat[nr, ])
      expect_equal(as.matrix(m), rbind(dat, dat, dat[nr:1, ], dat[nr, ]))

      expect_equal(rbind(dat, m), rbind(dat, as.matrix(m)))
    }
  }
})

test_that("S3", {
  load_ring_matrix()
  nc <- 5L
  m <- ring_matrix(100, nc, "integer")
  dat <- matrix(sample(as.integer(1:50), nc * 4), 4, nc)
  push(m, dat)
  expect_equal(length(m), length(dat))
  expect_equal(nrow(m), nrow(dat))
})

test_that("indexing", {
  load_ring_matrix()
  for (environment in c(TRUE, FALSE)) {
    for (type in names(sizes)) {
      n <- 100L
      nc <- 6L
      m <- 20
      mat <- ring_matrix(n, nc, type, environment)
      dat <- matrix(pool(type, m * nc), m, nc)
      push(mat, dat)

      i <- runif(m) < 0.5
      expect_equal(mat[i, ], dat[i, ])

      i <- runif(m / 2) < 0.5
      expect_equal(mat[i, ], dat[i, ])

      ## Interestingly, dat[i, ] throws an error here, being different
      ## to behaviour for the vector case...
      ##
      ## i <- runif(m * 2) < 0.5
      ## expect_equal(mat[i, ], dat[i, ])

      i <- runif(m - 1) < 0.5
      expect_equal(mat[i, ], dat[i, ])

      i <- sample(m, m / 2)
      expect_equal(mat[i, ], dat[i, ])

      j <- -i
      expect_equal(mat[j, ], dat[j, ])

      ## matixed:
      expect_error(mat[c(i, j)], "only 0's may be mixed with negative")

      k <- c(0, j)
      expect_equal(mat[k, ], dat[k, ])

      expect_error(mat["one", ], "Invalid type for index")
    }
  }
})