From c39777bb5360ffa00ccfaef73c4402bc1cdfb0bd Mon Sep 17 00:00:00 2001 From: "Brian J. Knaus" Date: Fri, 15 Sep 2017 15:11:08 -0700 Subject: [PATCH] updated tests --- tests/testthat/test_014_read_vcfR.R | 21 +++ tests/testthat/test_015_write_vcfR.R | 120 ++++++++++++++ tools/testthat/test_io.R | 226 --------------------------- 3 files changed, 141 insertions(+), 226 deletions(-) create mode 100644 tests/testthat/test_015_write_vcfR.R delete mode 100644 tools/testthat/test_io.R diff --git a/tests/testthat/test_014_read_vcfR.R b/tests/testthat/test_014_read_vcfR.R index f3708377..3daec499 100644 --- a/tests/testthat/test_014_read_vcfR.R +++ b/tests/testthat/test_014_read_vcfR.R @@ -147,5 +147,26 @@ test_that("VCF with no GT",{ }) +test_that("read.vcfR works for files in other directories",{ + data("vcfR_example") + test_dir <- tempdir() + setwd(test_dir) + + + if( !dir.exists('subdir') ){ + dir.create('subdir') + } + + setwd('subdir') + write.vcf(vcf, "test.vcf.gz") + setwd(test_dir) + vcf1 <- read.vcfR("./subdir/test.vcf.gz", verbose = FALSE) + unlink("./subdir/test.vcf.gz") + + expect_equal(nrow(vcf@fix), nrow(vcf1@fix)) +}) + + + ##### ##### ##### ##### ##### # EOF. \ No newline at end of file diff --git a/tests/testthat/test_015_write_vcfR.R b/tests/testthat/test_015_write_vcfR.R new file mode 100644 index 00000000..bbd7c45c --- /dev/null +++ b/tests/testthat/test_015_write_vcfR.R @@ -0,0 +1,120 @@ + + +#detach(package:vcfR, unload=TRUE) +library(vcfR) +#library(testthat) +context("write.vcf R functions") + + +##### ##### ##### ##### ##### +# write.vcf + + +test_that("read/write.vcf works for vcfR objects",{ + data("vcfR_example") + test_dir <- tempdir() + setwd(test_dir) + write.vcf(vcf, "test.vcf.gz") + test <- read.vcfR("test.vcf.gz", verbose = FALSE) + unlink("test.vcf.gz") +# setwd(original_dir) + + expect_is(test, "vcfR") + + expect_identical(colnames(test@fix)[1], "CHROM") + expect_equal(nrow(test@gt), nrow(vcf@gt)) + expect_equal(ncol(test@gt), ncol(vcf@gt)) +}) + + + +test_that("write.vcf APPEND=TRUE does not include header",{ + data("vcfR_example") + test_dir <- tempdir() + setwd(test_dir) + write.vcf(vcf, "test.vcf.gz", APPEND=TRUE) + test <- read.vcfR("test.vcf.gz", verbose = FALSE) + unlink("test.vcf.gz") +# setwd(original_dir) +}) + + +test_that("write.vcf.gz works for Chrom objects",{ + data("chromR_example") + test_dir <- tempdir() + setwd(test_dir) + write.vcf(chrom, "test.vcf.gz") + test <- read.vcfR("test.vcf.gz", verbose = FALSE) + unlink("test.vcf.gz") +# setwd(original_dir) + + expect_is(test, "vcfR") + expect_identical(colnames(test@fix)[1], "CHROM") + expect_equal(nrow(test@gt), nrow(vcf@gt)) + expect_equal(ncol(test@gt), ncol(vcf@gt)) +}) + + +test_that("write.vcf.gz works for Chrom objects with mask",{ + data("chromR_example") + test_dir <- tempdir() + setwd(test_dir) + chrom@var.info$mask <- FALSE + chrom@var.info$mask[1:50] <- TRUE + + write.vcf(chrom, "test.vcf.gz", mask=TRUE) + test <- read.vcfR("test.vcf.gz", verbose = FALSE) + unlink("test.vcf.gz") +# setwd(original_dir) + chrom@var.info$mask <- TRUE + + expect_is(test, "vcfR") + expect_identical(colnames(test@fix)[1], "CHROM") + expect_equal(ncol(test@gt), ncol(vcf@gt)) + expect_equal( nrow(test@fix), 50 ) +}) + + +test_that("write.var.info works for chromR objects",{ + data("chromR_example") + test_dir <- tempdir() + setwd(test_dir) + write.var.info(chrom, "test.csv") + test <- read.table("test.csv", header=TRUE, sep=",") + unlink("test.csv") +# setwd(original_dir) + + expect_is(test, "data.frame") + expect_equal(nrow(test), nrow(vcf@fix)) + expect_equal(length(grep("CHROM", colnames(test))), 1) + expect_equal(length(grep("POS", colnames(test))), 1) + expect_equal(length(grep("mask", colnames(test))), 1) +}) + + +test_that("write.win.info works for Chrom objects",{ + data("chromR_example") + chrom <- proc.chromR(chrom, verbose = FALSE) + test_dir <- tempdir() + setwd(test_dir) + write.win.info(chrom, "test.csv") + test <- read.table("test.csv", header=TRUE, sep=",") + unlink("test.csv") +# setwd(original_dir) + + expect_is(test, "data.frame") + expect_equal(nrow(test), nrow(chrom@win.info)) +# expect_equal(ncol(test), 12) + expect_equal(grep("CHROM", names(test), value=TRUE), "CHROM") + expect_equal(grep("window", names(test), value=TRUE), "window") + expect_equal(grep("start", names(test), value=TRUE), "start") + expect_equal(grep("end", names(test), value=TRUE), "end") +# expect_equal(length(grep("window", names(test))), 1) +# expect_equal(length(grep("start", names(test))), 1) +# expect_equal(length(grep("end", names(test))), 1) +}) + + + +##### ##### ##### ##### ##### +# EOF. \ No newline at end of file diff --git a/tools/testthat/test_io.R b/tools/testthat/test_io.R deleted file mode 100644 index 95aacd1f..00000000 --- a/tools/testthat/test_io.R +++ /dev/null @@ -1,226 +0,0 @@ -#detach(package:vcfR, unload=TRUE) -library(vcfR) -library(testthat) - -context("io functions") - -# Load data - - -data(vcfR_example) - -chrom <- create.chromR(name="Supercontig_1.50", vcf=vcf, seq=dna, ann=gff, verbose=FALSE) -chrom <- proc.chromR(chrom, verbose = FALSE) - - - -# Manage directories. -original_dir <- getwd() -test_dir <- tempdir() - -##### ##### ##### ##### ##### - -test_that("vcfR_vcf_stats_gz works",{ - setwd(test_dir) - write.vcf(chrom, "test.vcf.gz") - x <- .Call('vcfR_vcf_stats_gz', PACKAGE = 'vcfR', "test.vcf.gz") - # test <- read.vcfR("test.vcf") - unlink("test.vcf.gz") - setwd(original_dir) - - expect_equal(as.numeric(x["meta"]), length(chrom@vcf@meta)) - expect_equal(as.numeric(x["header"]), c(length(chrom@vcf@meta) + 1) ) - expect_equal(as.numeric(x["variants"]), nrow(chrom@vcf@fix)) - expect_equal(as.numeric(x["columns"]), ncol(chrom@vcf@fix) + ncol(chrom@vcf@gt)) -}) - - -test_that("vcfR_vcf_meta_gz works",{ - setwd(test_dir) - write.vcf(chrom, "test.vcf.gz") - stats <- .Call('vcfR_vcf_stats_gz', PACKAGE = 'vcfR', "test.vcf.gz") - x <- .Call('vcfR_read_meta_gz', PACKAGE = 'vcfR', "test.vcf.gz", stats, 0) - unlink("test.vcf.gz") - setwd(original_dir) - - expect_equal(length(x), length(chrom@vcf@meta)) -}) - - - -##### ##### ##### ##### ##### -# read_body - -test_that("vcfR_read_body_gz works",{ - setwd(test_dir) - write.vcf(chrom, "test.vcf.gz") - stats <- .Call('vcfR_vcf_stats_gz', PACKAGE = 'vcfR', "test.vcf.gz") - body <- .Call('vcfR_read_body_gz', PACKAGE = 'vcfR', "test.vcf.gz", stats, - nrows = -1, skip = 0, cols=1:stats['columns'], - convertNA = 1, verbose = 0) - unlink("test.vcf.gz") - setwd(original_dir) - - expect_equal(colnames(body)[1], "CHROM") - expect_equal(ncol(body), as.integer(stats['columns'])) - expect_equal(nrow(body), as.integer(stats['variants'])) - -}) - - -##### ##### ##### ##### ##### -# write.vcf - - -test_that("read/write.vcf works for vcfR objects",{ - setwd(test_dir) - write.vcf(vcf, "test.vcf.gz") - test <- read.vcfR("test.vcf.gz", verbose = FALSE) - unlink("test.vcf.gz") - setwd(original_dir) - - expect_is(test, "vcfR") - - expect_identical(colnames(test@fix)[1], "CHROM") - expect_equal(nrow(test@gt), nrow(vcf@gt)) - expect_equal(ncol(test@gt), ncol(vcf@gt)) -}) - - - -test_that("write.vcf APPEND=TRUE does not include header",{ - setwd(test_dir) - write.vcf(vcf, "test.vcf.gz", APPEND=TRUE) - test <- read.vcfR("test.vcf.gz", verbose = FALSE) - unlink("test.vcf.gz") - setwd(original_dir) - -}) - - -test_that("read.vcfR works for files in other directories",{ -# orig.dir <- getwd() -# test_dir <- tempdir() - setwd(test_dir) - - if( !dir.exists('subdir') ){ - dir.create('subdir') - } - - setwd('subdir') - write.vcf(vcf, "test.vcf.gz") - setwd(test_dir) - - vcf1 <- read.vcfR("./subdir/test.vcf.gz", verbose = FALSE) - expect_equal(nrow(vcf@fix), nrow(vcf1@fix)) - - setwd(original_dir) -# unlink(test_dir, recursive = TRUE) -}) - -#test_that("read/write.vcf works for Chrom objects",{ -# setwd(test_dir) -# write.vcf(chrom, "test.vcf") -# test <- read.vcfR("test.vcf", verbose = FALSE) -# unlink("test.vcf") -# setwd(original_dir) - -# expect_is(test, "vcfR") -# expect_identical(colnames(test@fix)[1], "CHROM") -# expect_equal(nrow(test@gt), nrow(vcf@gt)) -# expect_equal(ncol(test@gt), ncol(vcf@gt)) -#}) - - -test_that("write.vcf.gz works for Chrom objects",{ - setwd(test_dir) - write.vcf(chrom, "test.vcf.gz") - test <- read.vcfR("test.vcf.gz", verbose = FALSE) - unlink("test.vcf.gz") - setwd(original_dir) - - expect_is(test, "vcfR") - expect_identical(colnames(test@fix)[1], "CHROM") - expect_equal(nrow(test@gt), nrow(vcf@gt)) - expect_equal(ncol(test@gt), ncol(vcf@gt)) -}) - - - -test_that("write.vcf.gz works for Chrom objects with mask",{ - setwd(test_dir) - chrom@var.info$mask <- FALSE - chrom@var.info$mask[1:50] <- TRUE - - write.vcf(chrom, "test.vcf.gz", mask=TRUE) - test <- read.vcfR("test.vcf.gz", verbose = FALSE) - unlink("test.vcf.gz") - setwd(original_dir) - chrom@var.info$mask <- TRUE - - expect_is(test, "vcfR") - expect_identical(colnames(test@fix)[1], "CHROM") - expect_equal(ncol(test@gt), ncol(vcf@gt)) - expect_equal( nrow(test@fix), 50 ) - -}) - - - -test_that("write.var.info works for Chrom objects",{ - setwd(test_dir) - write.var.info(chrom, "test.csv") - test <- read.table("test.csv", header=TRUE, sep=",") - unlink("test.csv") - setwd(original_dir) - - expect_is(test, "data.frame") - expect_equal(nrow(test), nrow(vcf@fix)) - expect_equal(length(grep("CHROM", colnames(test))), 1) - expect_equal(length(grep("POS", colnames(test))), 1) - expect_equal(length(grep("mask", colnames(test))), 1) -}) - - -test_that("write.win.info works for Chrom objects",{ - setwd(test_dir) - write.win.info(chrom, "test.csv") - test <- read.table("test.csv", header=TRUE, sep=",") - unlink("test.csv") - setwd(original_dir) - - expect_is(test, "data.frame") - expect_equal(nrow(test), nrow(chrom@win.info)) -# expect_equal(ncol(test), 12) - expect_equal(grep("CHROM", names(test), value=TRUE), "CHROM") - expect_equal(grep("window", names(test), value=TRUE), "window") - expect_equal(grep("start", names(test), value=TRUE), "start") - expect_equal(grep("end", names(test), value=TRUE), "end") -# expect_equal(length(grep("window", names(test))), 1) -# expect_equal(length(grep("start", names(test))), 1) -# expect_equal(length(grep("end", names(test))), 1) -}) - - - - - -test_that("write_fasta works",{ - -#invisible(.Call('vcfR_write_fasta', PACKAGE = 'vcfR', seq, seqname, filename, rowlength, verbose)) -#invisible(.Call('vcfR_write_fasta', PACKAGE = 'vcfR', as.character(pinf_dna)[1,], "myseq", "test.fasta", 10, 1)) - -# write_fasta(pinf_mt, file="pinf_mt.fasta", gt_split="/", rowlength=1141) -}) - - - -#data(vcfR_example) -#write.vcf.gz(pinf_vcf, "test.vcf.gz") - -#.Call('vcfR_vcf_stats_gz', PACKAGE = 'vcfR', "test.vcf.gz") -#.Call('vcfR_vcf_stats_gz', PACKAGE = 'vcfR', "../vcf_data/gatk_hc/sc_1.100.vcf.gz") -#.Call('vcfR_write_vcf_body_gz', PACKAGE = 'vcfR', pinf_vcf@fix, pinf_vcf@gt, "test.vcf.gz", 0) - - -