Nothing
context("drop linearly dependent columns")
test_that("find_lin_indep_cols works", {
set.seed(20151130)
x <- cbind(1, sample(0:1, 200, repl=TRUE))
expect_equal(sort(find_lin_indep_cols(x)), c(1,2))
expect_equal(sort(find_lin_indep_cols(cbind(x, 1))), c(1,2))
expect_equal(sort(find_lin_indep_cols(cbind(x, x[,1] + 0.5*x[,2]))), c(2,3))
X <- matrix(rnorm(1000*10), ncol=10)
expect_equal(sort(find_lin_indep_cols(X)), 1:10)
expect_equal(length(find_lin_indep_cols(cbind(rowSums(X), X))), 10)
})
test_that("drop_depcols works", {
set.seed(20151130)
n.ind <- 100
x <- cbind(1,
sample(0:1, n.ind, replace=TRUE),
sample(0:1, n.ind, replace=TRUE))
expect_equal(drop_depcols(NULL), NULL)
expect_equal(drop_depcols(x), x)
for(i in 1:ncol(x))
expect_equal(drop_depcols(x[,i]), x[,i,drop=FALSE])
X <- cbind(rowSums(x), x)
expect_equal(ncol(drop_depcols(X)), 3)
})
test_that("drop_xcovar works", {
set.seed(20151202)
n <- 100
Xcovar <- sample(0:1, n, replace=TRUE)
int <- rep(1, n)
names(Xcovar) <- names(int) <- paste(1:n)
expect_equal( drop_xcovar(NULL, NULL), NULL)
expect_equal( drop_xcovar(NULL, Xcovar), Xcovar)
expect_equal( drop_xcovar(int, NULL), NULL)
expect_equal( drop_xcovar(int, Xcovar), as.matrix(Xcovar))
expect_equal( drop_xcovar(Xcovar, Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar), NULL)
pgm <- sample(0:1, n, replace=TRUE)
names(pgm) <- paste(1:n)
Xcovar <- cbind(Xcovar, pgm)
expect_equal( drop_xcovar(NULL, Xcovar), Xcovar)
expect_equal( drop_xcovar(int, Xcovar), Xcovar)
expect_equal( drop_xcovar(Xcovar, Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar[,1]), Xcovar), Xcovar[,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(int, Xcovar[,2]), Xcovar), Xcovar[,1,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(Xcovar[,1], int), Xcovar), Xcovar[,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar[,2], int), Xcovar), Xcovar[,1,drop=FALSE])
})
test_that("drop_xcovar works with NAs", {
set.seed(20151202)
n <- 100
Xcovar <- sample(0:1, n, replace=TRUE)
int <- rep(1, n)
names(Xcovar) <- names(int) <- paste(1:n)
Xcovar[3:5] <- NA
expect_equal( drop_xcovar(NULL, Xcovar), Xcovar)
expect_equal( drop_xcovar(int, Xcovar), as.matrix(Xcovar))
expect_equal( drop_xcovar(Xcovar, Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar), NULL)
# try some permutations
o <- sample(1:n)
expect_equal( drop_xcovar(int, Xcovar[o]), as.matrix(Xcovar[o]))
expect_equal( drop_xcovar(Xcovar, Xcovar[o]), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar[o]), NULL)
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar[o]), NULL)
# multiple X covar columns
pgm <- sample(0:1, n, replace=TRUE)
names(pgm) <- paste(1:n)
Xcovar <- cbind(Xcovar, pgm)
expect_equal( drop_xcovar(NULL, Xcovar), Xcovar)
expect_equal( drop_xcovar(int, Xcovar), Xcovar)
expect_equal( drop_xcovar(Xcovar, Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar[,1]), Xcovar), Xcovar[,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(int, Xcovar[,2]), Xcovar), Xcovar[,1,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar), NULL)
expect_equal( drop_xcovar(cbind(Xcovar[,1], int), Xcovar), Xcovar[,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar[,2], int), Xcovar), Xcovar[,1,drop=FALSE])
# try some permutations
o <- sample(1:n)
expect_equal( drop_xcovar(int, Xcovar[o,]), Xcovar[o,])
expect_equal( drop_xcovar(Xcovar, Xcovar[o,]), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar), Xcovar[o,]), NULL)
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar[o,]), NULL)
expect_equal( drop_xcovar(cbind(int, Xcovar[,1]), Xcovar[o,]), Xcovar[o,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(int, Xcovar[,2]), Xcovar[o,]), Xcovar[o,1,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar, int), Xcovar[o,]), NULL)
expect_equal( drop_xcovar(cbind(Xcovar[,1], int), Xcovar[o,]), Xcovar[o,2,drop=FALSE])
expect_equal( drop_xcovar(cbind(Xcovar[,2], int), Xcovar[o,]), Xcovar[o,1,drop=FALSE])
})
test_that("Fixed issue 22 re drop_depcols ", {
# https://github.com/rqtl/qtl2/issues/22
# ...case where indicators for all categories included
# create example
n_per <- 20
n_group <- 4
n <- n_per*n_group
group <- rep(1:n_group, each=n_per)
covar <- cbind(sex=rep(0:1,n_per*n_group),
diet=sample(100:200, n, replace=TRUE))
for(i in 1:n_group)
covar <- cbind(covar, (group==i)*1)
colnames(covar)[-(1:2)] <- paste0("group", 1:n_group)
# drop dependent columns
covar_indep <- drop_depcols(covar, TRUE)
# check that one of the groups got dropped
expect_true("sex" %in% colnames(covar_indep))
expect_true("diet" %in% colnames(covar_indep))
expect_true(ncol(covar_indep) == ncol(covar)-1)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.