restore gz-compressed output in writeResult and outputResampling

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

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
       )

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,

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))
+})

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())