diff --git a/DESCRIPTION b/DESCRIPTION index a2591d7..25785f4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rvat Title: Rare variant analysis toolkit -Version: 0.4.0 +Version: 0.4.1 Authors@R: c(person(given='Kevin',family='Kenna',email='K.P.Kenna@umcutrecht.nl',role = c("aut")),person(given='Paul',family='Hop',email='P.J.Hop-2@umcutrecht.nl',role = c("aut", "cre"))) Description: RVAT is an R package that allows for the conversion of large genetic datasets from variant call format (.vcf) to a compressed SQLite representation (.gdb). Gdb files allow for rapid loading of compressed sample genotype strings into R BioConductor-compatible classes. They also allow for the upload and integration of variant and sample annotation data and complex data querying. RVAT includes a range of methods for SQL and non-SQL based querying, as well as methods for single variant association testing, aggregate association testing, gene set analyses, (interactive) visualization and the generation of various population genetic summary statistics. RVAT methods can be called directly in R sessions or used outside of the R environment through a provided command line tool. License: GPL-3 diff --git a/R/assocTest-helper.R b/R/assocTest-helper.R index 27b3adc..7f412ff 100644 --- a/R/assocTest-helper.R +++ b/R/assocTest-helper.R @@ -1073,12 +1073,20 @@ ) { if (is.character(outputResampling) || outputResampling) { if (is.character(outputResampling)) { + is_gz <- grepl("\\.gz$", outputResampling) + open_mode <- if (append) "a" else "w" + con <- if (is_gz) { + gzfile(outputResampling, open_mode) + } else { + file(outputResampling, open_mode) + } + on.exit(close(con), add = TRUE) write.table( as.data.frame(results), - file = outputResampling, + file = con, sep = "\t", quote = FALSE, - append = append, + append = FALSE, row.names = FALSE, col.names = !append ) diff --git a/R/rvatResult.R b/R/rvatResult.R index f30d9ee..6ed293d 100644 --- a/R/rvatResult.R +++ b/R/rvatResult.R @@ -21,11 +21,17 @@ setMethod( qmethod = c("escape", "double"), fileEncoding = "" ) { + is_gz <- grepl("\\.gz$", file) + + open_mode <- if (append) "a" else "w" + con <- if (is_gz) gzfile(file, open_mode) else file(file, open_mode) + on.exit(close(con), add = TRUE) + if (append) { write.table( object, - file = file, - append = append, + file = con, + append = FALSE, quote = quote, sep = sep, eol = eol, @@ -37,22 +43,19 @@ setMethod( fileEncoding = fileEncoding ) } else { - file <- file(file, "w") - on.exit(close(file), add = TRUE) - # write metadata metadata <- metadata(object) metadata <- metadata[names(metadata) %in% metadata_rvatresult] .write_rvat_header( filetype = as.character(class(object)[1L]), metadata = metadata, - con = file + con = con ) # write results write.table( object, - file = file, + file = con, append = FALSE, quote = quote, sep = sep, diff --git a/tests/testthat/test-assocTest-resampling.R b/tests/testthat/test-assocTest-resampling.R index 64473e5..043ab4e 100644 --- a/tests/testthat/test-assocTest-resampling.R +++ b/tests/testthat/test-assocTest-resampling.R @@ -108,3 +108,40 @@ test_that("outputting resamplings works", { ) expect_equal(as.data.frame(outputresampling), as.data.frame(test)) }) + +test_that("outputting resamplings to gz works", { + outputresampling_gz <- withr::local_tempfile(fileext = ".txt.gz") + set.seed(10) + test <- assocTest( + GTsmall, + pheno = "pheno", + covar = paste0("PC", 1:4), + test = c("skat"), + methodResampling = "permutation", + nResampling = 10, + outputResampling = outputresampling_gz, + verbose = FALSE + ) + expect_equal( + readBin(outputresampling_gz, raw(), n = 2), + as.raw(c(0x1f, 0x8b)) + ) + outputresampling_gz <- readr::read_tsv( + outputresampling_gz, + show_col_types = FALSE, + col_types = list(MAFweight = "character") + ) + + set.seed(10) + test <- assocTest( + GTsmall, + pheno = "pheno", + covar = paste0("PC", 1:4), + test = c("skat"), + methodResampling = "permutation", + nResampling = 10, + outputResampling = TRUE, + verbose = FALSE + ) + expect_equal(as.data.frame(outputresampling_gz), as.data.frame(test)) +}) diff --git a/tests/testthat/test-rvatResult-io.R b/tests/testthat/test-rvatResult-io.R index 5282a90..9caaed0 100644 --- a/tests/testthat/test-rvatResult-io.R +++ b/tests/testthat/test-rvatResult-io.R @@ -109,6 +109,72 @@ test_that("readResults infers singlevarResult type correctly", { }) +test_that("rvbResult gz read/write roundtrip preserves data", { + data(rvbresults, envir = environment()) + + resultfile <- withr::local_tempfile(fileext = ".txt.gz") + writeResult(rvbresults, file = resultfile) + + # verify file is actually gzip-compressed + expect_equal(readBin(resultfile, raw(), n = 2), as.raw(c(0x1f, 0x8b))) + + rvbresults_read <- rvbResult(resultfile) + expect_equal(rvbresults, rvbresults_read) +}) + +test_that("rvbResult gz appending works correctly", { + data(rvbresults, envir = environment()) + resultfile <- withr::local_tempfile(fileext = ".txt.gz") + + writeResult(rvbresults[1:100, ], file = resultfile) + writeResult( + rvbresults[101:nrow(rvbresults), ], + file = resultfile, + append = TRUE + ) + + expect_equal(readBin(resultfile, raw(), n = 2), as.raw(c(0x1f, 0x8b))) + + resultfile_onechunk <- withr::local_tempfile(fileext = ".txt.gz") + writeResult(rvbresults, file = resultfile_onechunk) + + expect_equal( + rvbResult(resultfile), + rvbResult(resultfile_onechunk) + ) +}) + +test_that("singlevarResult gz read/write roundtrip preserves data", { + resultfile <- withr::local_tempfile(fileext = ".txt.gz") + writeResult(sv_results, file = resultfile) + + expect_equal(readBin(resultfile, raw(), n = 2), as.raw(c(0x1f, 0x8b))) + + sv_results_read <- singlevarResult(resultfile) + expect_equal(sv_results, sv_results_read) +}) + +test_that("singlevarResult gz appending works correctly", { + resultfile <- withr::local_tempfile(fileext = ".txt.gz") + + writeResult(sv_results[1:20, ], file = resultfile) + writeResult( + sv_results[21:nrow(sv_results), ], + file = resultfile, + append = TRUE + ) + + expect_equal(readBin(resultfile, raw(), n = 2), as.raw(c(0x1f, 0x8b))) + + resultfile_onechunk <- withr::local_tempfile(fileext = ".txt.gz") + writeResult(sv_results, file = resultfile_onechunk) + + expect_equal( + singlevarResult(resultfile), + singlevarResult(resultfile_onechunk) + ) +}) + test_that("reading and writing rvatResults input validation works", { # reading rvbResult as singlevarResult fails data(rvbresults, envir = environment())