tests/testthat/test-subset_input.R

In fboehm/qtl2pleio: Testing Pleiotropy in Multiparental Populations

library(qtl2pleio)
library(testthat)
context("testing correct subsetting - based on common ids - of inputs (with proper
        ordering of subject ids): phenotypes, allele probabilities,
        covariates, and kinship")

# setup
## define subject ids
s_id <- paste0("s", 101:200)
## define probs
probs_pre <- rbinom(n = 100 * 10, size = 1, prob = 1 / 2)
probs <- array(data = probs_pre, dim = c(100, 1, 10))
dimnames(probs)[[3]] <- paste0("Marker", 1:10)
colnames(probs) <- "A"
rownames(probs) <- s_id
# define Y
Y_pre <- runif(200)
Y <- matrix(data = Y_pre, nrow = 100)
colnames(Y) <- c("y1", "y2")
rownames(Y) <- s_id
# define covariates
covariates <- matrix(c(runif(99), NA), nrow = 100, ncol = 1)
colnames(covariates) <- "c1"
rownames(covariates) <- s_id
cov2 <- matrix(c(covariates[1:99], 10), nrow = 100, ncol = 1)
colnames(cov2) <- "c1"
rownames(cov2) <- s_id

Y2 <- Y
Y2[1, 2] <- NA
# define kinship
K1 <- diag(100)
rownames(K1) <- s_id
colnames(K1) <- s_id


# tests

test_that("subset_input, with covariates, when not NULL,
          returns a matrix with the correct number of rows and correct
          subject ids in row names", {
  expect_equal(nrow(subset_input(input = covariates,
                                id2keep = paste0("s", 101:110))),
               10)
  expect_equal(ncol(subset_input(input = covariates,
                                           id2keep = paste0("s", 101:110))),
                         ncol(covariates))

  expect_identical(rownames(subset_input(input = covariates,
                                    id2keep = paste0("s", 101:110))),
                   paste0("s", 101:110))
  expect_identical(rownames(subset_input(input = covariates,
                                         id2keep = paste0("s", 110:101))),
                   paste0("s", 110:101))

})

test_that("subset_input, with pheno, returns
          a matrix with the correct number of
          rows and correct subject ids in row names", {
  expect_equal(nrow(subset_input(input = Y,
                                id2keep = paste0("s", 101:110)
  )), 10)
  expect_equal(ncol(subset_input(input = Y,
                                 id2keep = paste0("s", 101:110)
            )), ncol(Y))
  expect_identical(rownames(subset_input(input = Y,
                                         id2keep = paste0("s", 101:110)
                                         )), paste0("s", 101:110))
  expect_true(is.matrix(subset_input(input = Y,
                                     id2keep = paste0("s", 101:110))))
})

test_that("subset_input, with allele probabilities array,
          returns a matrix with the correct number of rows
          and correct subject ids in row names and that
          dimension = 3 is preserved", {
  expect_equal(nrow(subset_input(input = probs,
                                id2keep = paste0("s", 101:110)
                                )), 10)
  expect_identical(rownames(subset_input(input = probs,
                                         id2keep = paste0("s", 101:110)
                                         )), paste0("s", 101:110))
  expect_equal(length(dim(subset_input(input = probs,
                                         id2keep = paste0("s", 101:110)
                                       ))), 3)
})

test_that("subset_kinship returns a matrix with the correct number of
          rows & columns and correct subject ids in row names and column names", {
  expect_equal(dim(subset_kinship(kinship = K1,
                                  id2keep = paste0("s", 101:110)))[1],
               10)
  expect_equal(dim(subset_kinship(kinship = K1,
                                  id2keep = paste0("s", 101:110))
                   )[2],
               10)
  expect_identical(rownames(subset_kinship(kinship = K1,
                                         id2keep = paste0("s", 101:110))),
                   paste0("s", 101:110))
  expect_identical(colnames(subset_kinship(kinship = K1,
                                         id2keep = paste0("s", 101:110)
  )), paste0("s", 101:110))
  expect_identical(colnames(subset_kinship(kinship = K1,
                                           id2keep = paste0("s", 110:101)
  )), paste0("s", 110:101))
  expect_identical(rownames(subset_kinship(kinship = K1,
                                           id2keep = paste0("s", 110:101)
  )), paste0("s", 110:101))

})

x <- matrix(runif(100), nrow = 10, ncol = 10)
rownames(x) <- paste0("mouse", 1:10)

y <- x[10:1, ]
rownames(y) <- rownames(x)[10:1]
z <- x[10:1, 1, drop = FALSE]
rownames(z)[10] <- "mouse11"

id2keep <- make_id2keep(probs = x, pheno = y)



test_that("subset_inputs arranges subject names in order specified in id2keep", {
  expect_identical(rownames(subset_input(input = x, id2keep = id2keep)),
                   rownames(subset_input(input = y, id2keep = id2keep))
  )
  expect_false(identical(rownames(subset_input(input = x, id2keep = id2keep)),
                         rownames(y)
  )
  )
  expect_identical(x, subset_input(input = y, id2keep = id2keep))
})