tweak verbose in seqBED2GDS()

zhengxwen · Jan 18, 2024 · 67bddef · 67bddef
1 parent 3cf31fe
commit 67bddef
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 17 deletions.
diff --git a/NEWS b/NEWS
@@ -1,10 +1,14 @@
-CHANGES IN VERSION 1.43.1
+CHANGES IN VERSION 1.43.2
 -------------------------
 
 UTILITIES
 
     o update the help files of `seqBlockApply()` and `seqUnitApply()`
 
+    o detect the output filename extension in `seqGDS2VCF()` without
+      considering the case of the characters, supporting .gz, .bgz, .bz and .xz
+      as a filename extension
+
 
 CHANGES IN VERSION 1.42.0
 -------------------------

diff --git a/R/Conversion.R b/R/Conversion.R
@@ -79,7 +79,7 @@ seqGDS2VCF <- function(gdsfile, vcf.fn, info.var=NULL, fmt.var=NULL,
     {
         # get the file extension
         pos <- regexpr("\\.([[:alnum:]]+)$", vcf.fn)
-        ext <- ifelse(pos > -1L, substring(vcf.fn, pos+1L), "")
+        ext <- tolower(ifelse(pos > -1L, substring(vcf.fn, pos+1L), ""))
         if (ext %in% c("gz", "bgz"))
         {
             if (.Platform$OS.type == "windows")
@@ -813,13 +813,15 @@ seqBED2GDS <- function(bed.fn, fam.fn, bim.fn, out.gdsfn,
     bed_flag <- b[3L] == 0L
     if (verbose)
     {
-        cat("    bed file: ", sQuote(bed.fn), "\n        ",
+        cat("    BED file: ", sQuote(bed.fn), "\n        ",
             .pretty_size(file.size(bed.fn)), ", ",
             ifelse(bed_flag, "sample-major mode: [SNP, sample]",
             "SNP-major mode: [sample, SNP]"), "\n", sep="")
     }
 
     ##  read fam.fn  ##
+    if (verbose)
+        cat("    FAM file: ", sQuote(fam.fn), "\n", sep="")
     f <- .open_text(fam.fn, TRUE)
     famD <- read.table(f$con, header=FALSE, comment.char="",
         stringsAsFactors=FALSE)
@@ -836,12 +838,14 @@ seqBED2GDS <- function(bed.fn, fam.fn, bim.fn, out.gdsfn,
     if (verbose)
     {
         n <- nrow(famD)
-        cat("    fam file: ", sQuote(fam.fn), "\n        ",
+        cat("        ",
             .pretty_size(file.size(fam.fn)), ", ",
             .pretty(n), " sample", .plural(n), "\n", sep="")
     }
 
     ##  read bim.fn  ##
+    if (verbose)
+        cat("    BIM file: ", sQuote(bim.fn), "\n", sep="")
     f <- .open_text(bim.fn, TRUE)
     bimD <- read.table(f$con, header=FALSE, comment.char="",
         stringsAsFactors=FALSE)
@@ -850,7 +854,7 @@ seqBED2GDS <- function(bed.fn, fam.fn, bim.fn, out.gdsfn,
     if (verbose)
     {
         n <- nrow(bimD)
-        cat("    bim file: ", sQuote(bim.fn), "\n        ",
+        cat("        ",
             .pretty_size(file.size(bim.fn)), ", ",
             .pretty(n), " variant", .plural(n), "\n", sep="")
     }
@@ -889,36 +893,36 @@ seqBED2GDS <- function(bed.fn, fam.fn, bim.fn, out.gdsfn,
     put.attr.gdsn(n, "source.format", "PLINK BED Format")
 
     # add sample.id
-    if (verbose) cat("    sample.id")
+    if (verbose) cat("    sample.id  ")
     n <- add.gdsn(dstfile, "sample.id", sample.id, compress=compress.annotation,
         closezip=TRUE)
-    .DigestCode(n, digest, verbose)
+    .DigestCode(n, digest, verbose, FALSE)
 
     # add variant.id
-    if (verbose) cat("    variant.id")
+    if (verbose) cat("    variant.id  ")
     n <- add.gdsn(dstfile, "variant.id", seq_len(nrow(bimD)),
         compress=compress.annotation, closezip=TRUE)
-    .DigestCode(n, digest, verbose)
+    .DigestCode(n, digest, verbose, FALSE)
 
     # add position
-    if (verbose) cat("    position")
+    if (verbose) cat("    position  ")
     n <- add.gdsn(dstfile, "position", bimD$pos, storage="int32",
         compress=compress.annotation, closezip=TRUE)
-    .DigestCode(n, digest, verbose)
+    .DigestCode(n, digest, verbose, FALSE)
 
     # add chromosome
-    if (verbose) cat("    chromosome")
+    if (verbose) cat("    chromosome  ")
     n <- add.gdsn(dstfile, "chromosome", bimD$chr, storage="string",
         compress=compress.annotation, closezip=TRUE)
-    .DigestCode(n, digest, verbose)
+    .DigestCode(n, digest, verbose, FALSE)
     # RLE-coded chromosome
     .optim_chrom(dstfile)
 
     # add allele
-    if (verbose) cat("    allele")
+    if (verbose) cat("    allele  ")
     n <- add.gdsn(dstfile, "allele", paste(bimD$allele2, bimD$allele1, sep=","),
         storage="string", compress=compress.annotation, closezip=TRUE)
-    .DigestCode(n, digest, verbose)
+    .DigestCode(n, digest, verbose, FALSE)
 
     # add a folder for genotypes
     if (verbose)

diff --git a/R/Internal.R b/R/Internal.R
@@ -857,7 +857,7 @@ process_count <- 1L
 #######################################################################
 # Get the unique data frame
 #
-.DigestCode <- function(node, algo=TRUE, verbose=TRUE)
+.DigestCode <- function(node, algo=TRUE, verbose=TRUE, indent=TRUE)
 {
     if (!is.null(node))
     {
@@ -868,7 +868,7 @@ process_count <- 1L
             h <- digest.gdsn(node, algo=algo, action="add")
             if (verbose)
             {
-                s <- paste0("  [", algo, ": ", h, "]")
+                s <- paste0(ifelse(indent, "  ", ""), "[", algo, ": ", h, "]")
                 if (.crayon()) s <- crayon::blurred(s)
                 cat(s, "\n", sep="")
             }