################################################################################ context("SUBSET") test <- snp_attachExtdata() # backing file file <- test$genotypes$backingfile # dimensions n <- nrow(test$genotypes) m <- ncol(test$genotypes) ################################################################################ for (k in 1:10) { # taking only some individuals and some SNPs at random ind.row <- sort(sample(n, size = sample(50, 1))) ind.col <- sort(sample(m, size = sample(200, 1))) test2 <- snp_attach(subset(test, ind.row, ind.col)) # classes test_that("good classes", { expect_s3_class(test2, "bigSNP") expect_s4_class(test2$genotypes, "FBM.code256") expect_s3_class(test2$fam, "data.frame") expect_s3_class(test2$map, "data.frame") }) # dimensions test_that("Check new values", { expect_equal(test2$genotypes[], test$genotypes[ind.row, ind.col]) expect_equivalent(test2$fam, test$fam[ind.row, ]) expect_equivalent(test2$map, test$map[ind.col, ]) }) # new backing files test_that("backing files' names", { expect_equal(test2$genotypes$backingfile, sub("\\.bk$", paste0("_sub", k, ".bk"), file)) }) } ################################################################################ # removing the 100th and 120th individuals ind.row.del <- c(100, 120) test3 <- snp_attach(subset(test, -ind.row.del)) # classes test_that("good classes", { expect_s3_class(test3, "bigSNP") expect_s4_class(test3$genotypes, "FBM.code256") expect_s3_class(test3$fam, "data.frame") expect_s3_class(test3$map, "data.frame") }) # dimensions test_that("Check new values", { expect_equal(test3$genotypes[], test$genotypes[-ind.row.del, ]) expect_equivalent(test3$fam, test$fam[-ind.row.del, ]) expect_equivalent(test3$map, test$map) }) # new backing files test_that("backing files' names", { expect_equal(test3$genotypes$backingfile, normalizePath(sub("\\.bk$", paste0("_sub", k + 1, ".bk"), file))) }) ################################################################################ test_that("Can subset without $fam or $map", { test4 <- test test4$fam <- NULL test5 <- snp_attach(snp_subset(test4, ind.col = 1:10)) expect_null(test5$fam) expect_identical(test5$map, test$map[1:10, ]) test6 <- test test6$map <- NULL test7 <- snp_attach(snp_subset(test6, ind.row = -(1:10))) expect_null(test7$map) expect_equal(test7$fam, test$fam[-(1:10), ], check.attributes = FALSE) }) ################################################################################