gt.format fixed

Author: piyalkarum

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 1.2.0
-Date: 2023-08-08 10:43:09 UTC
-SHA: 818caae241ff622440c90ebb6ddf40574a7670ad
+Version: 1.3.0
+Date: 2024-09-20 12:14:48 UTC
+SHA: 15152248a448defd590b98fc1f49df0e92d1cd0b

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: rCNV
 Type: Package
 Title: Detect Copy Number Variants from SNPs Data
-Version: 1.3.9000
-Date: 2024-04-30
+Version: 1.3.900
+Date: 2024-09-20
 Language: en-US
 Authors@R: c(person(given="Piyal",family="Karunarathne", email="piyalkarumail@yahoo.com", role = c("aut", "cre"),comment = c(ORCID = "0000-0002-1934-145X")),person(given="Qiujie",family="Zhou", email="qiujie.zhou@ebc.uu.se", role = c("aut"),comment = c(ORCID = "0000-0001-7351-2371")),person("Klaus", "Schliep", email="klaus.schliep@gmail.com", role = c("aut"), comment = c(ORCID = "0000-0003-2941-0161")),person(given="Pascal", family="Milesi", role = "aut",comment = c(ORCID = "0000-0001-8580-4291")))
 Maintainer: Piyal Karunarathne <piyalkarumail@yahoo.com>
@@ -20,7 +20,7 @@ Suggests:
     knitr,
     testthat (>= 3.0.0),
     covr
-##VignetteBuilder: knitr
+VignetteBuilder: knitr
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
 URL: https://piyalkarum.github.io/rCNV/, https://cran.r-project.org/package=rCNV

R/TMM_normalz.R

@@ -206,10 +206,10 @@ index_to_mean <- function(x,indx, my_mean, al=NULL){
 #' }
 #'
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path)
 #' df<-hetTgen(vcf,"AD-tot",verbose=FALSE)
-#' norm.fact(df)
+#' norm.fact(df)}
 #'
 #'
 #' @export

R/allele_tests.R

@@ -15,7 +15,7 @@
 #'
 #' @author Piyal Karunarathne
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path=vcf.file.path)
 #' het.table<-hetTgen(vcf,"GT")
 #' ad.table<-hetTgen(vcf,"AD")
@@ -24,7 +24,7 @@
 #' frQ<-allele.freq(het.table,f.typ="ind")
 #'
 #' #for population-wise and both allele depth and genotype tables
-#' \dontrun{frQ<-allele.freq(list(AD=ad.table,GT=het.table),f.typ="pop")}
+#' frQ<-allele.freq(list(AD=ad.table,GT=het.table),f.typ="pop")}
 #'
 #' @export
 allele.freq<-function(gtt,f.typ=c("pop","ind"),verbose=TRUE){

R/bias.det.R

@@ -104,12 +104,10 @@ get.pvals<-function(x,df,p.cal){
 #' }
 #'
 #' @examples
-#' \dontrun{
+#' \dontrun{data(ADtable)
 #' hz<-h.zygosity(vcf,verbose=FALSE)
 #' Fis<-mean(hz$Fis,na.rm = TRUE)
-#' data(ADtable)
-#' AI<-allele.info(ADtable,x.norm=ADnorm,Fis=0.11)
-#' }
+#' AI<-allele.info(ADtable,x.norm=ADnorm,Fis=Fis)}
 #'
 #' @export
 allele.info<-function(X,x.norm=NULL,Fis,method=c("MedR","QN","pca","TMM","TMMex"),logratioTrim = 0.3,sumTrim = 0.05,Weighting = TRUE,Acutoff = -1e+10,plot.allele.cov=TRUE,verbose = TRUE,parallel=FALSE,...){

R/raw_process.R

@@ -214,8 +214,8 @@ maf_0<-function(h.table,AD=TRUE,verbose=TRUE,parallel=FALSE){
 #' @author Piyal Karunarathne
 #'
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
-#' vcf <- readVCF(vcf.file.path)
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' vcf <- readVCF(vcf.file.path)}
 #'
 #' @export
 readVCF <- function(vcf.file.path,verbose=FALSE){
@@ -231,7 +231,7 @@ readVCF <- function(vcf.file.path,verbose=FALSE){
 #' VariantsToTable: see details)
 #'
 #' @param vcf an imported vcf file in a list using \code{readVCF}
-#' @param info.type character. \code{AD}: allele depth value, {AD-tot}:total
+#' @param info.type character. \code{AD}: allele depth value, \code{AD-tot}:total
 #' allele depth, \code{DP}=unfiltered depth (sum), \code{GT}: genotype,
 #' \code{GT-012}:genotype in 012 format, \code{GT-AB}:genotype in AB format.
 #' Default \code{AD},  See details.
@@ -251,9 +251,9 @@ readVCF <- function(vcf.file.path,verbose=FALSE){
 #' @importFrom utils setTxtProgressBar txtProgressBar
 #' @importFrom parallel parSapply makeCluster clusterExport parLapply
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path=vcf.file.path)
-#' het.table<-hetTgen(vcf)
+#' het.table<-hetTgen(vcf)}
 #'
 #' @export
 hetTgen <- function(vcf, info.type = c("AD", "AD-tot", "GT", "GT-012", "GT-AB", "DP"), verbose = TRUE, parallel = FALSE) {
@@ -429,9 +429,9 @@ hetTgen_cpp <- function(vcf, info.type = c("AD", "AD-tot", "GT", "GT-012", "GT-A
 #' Returns a data frame of allele depth or genotypes
 #'
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path=vcf.file.path)
-#' missing<-get.miss(vcf,plot=TRUE)
+#' missing<-get.miss(vcf,plot=TRUE)}
 #'
 #' @export
 get.miss<-function(data,type=c("samples","snps"),plot=TRUE,verbose=TRUE,parallel=FALSE){
@@ -549,6 +549,119 @@ get.miss<-function(data,type=c("samples","snps"),plot=TRUE,verbose=TRUE,parallel
 #'
 #' @export
 gt.format <- function(gt,info,format=c("benv","bpass"),snp.subset=NULL,parallel=FALSE) {
+  if(parallel) {
+    numCores <- detectCores() - 1
+    cl <- makeCluster(numCores)
+  }
+
+  if(is.character(gt)) {
+    gt <- as.data.frame(fread(gt))
+    gts <- gt[,-c(1,2)]
+  } else {
+    gts <- gt[,-c(1:4)]
+  }
+
+  if(is.character(info)) {
+    if(length(info) == ncol(gts)) {
+      info <- data.frame(population = info)
+    } else {
+      pop.col <- rep(NA, ncol(gts))
+      for(i in seq_along(info)) {
+        pop.col[grep(info[i], colnames(gts))] <- info[i]
+      }
+      info <- data.frame(population = pop.col)
+    }
+  }
+
+  # Ensure rownames match the original order
+  rownames(gts) <- paste(gt$CHROM, gt$POS, sep = ".")
+
+  # Keep population order consistent with input `info`
+  pp <- unique(info$population)
+  pp <- pp[order(match(pp, info$population))]  # Fix ordering issue
+
+  infos <- as.character(info$population)
+  format <- match.arg(format, several.ok = TRUE)
+
+  # Ensure lgt follows original population order
+  lgt <- split.data.frame(t(gts), f = factor(info$population, levels = pp))
+
+  if(any(format == "benv")) {
+    message("Formating BayEnv")
+
+    if(parallel) {
+      ppe <- parLapply(cl, lgt, function(X) {
+        out <- apply(X, 2, function(x) {
+          zero <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 0)
+          one <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 1)
+          return(as.data.frame(c(zero, one), col.names = FALSE))
+        }, simplify = FALSE)
+        do.call(rbind, out)
+      })
+    } else {
+      ppe <- lapply_pb(lgt, function(X) {
+        out <- apply(X, 2, function(x) {
+          zero <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 0)
+          one <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 1)
+          return(as.data.frame(c(zero, one), col.names = FALSE))
+        }, simplify = FALSE)
+        do.call(rbind, out)
+      })
+    }
+
+    ppe <- do.call(cbind, ppe)
+  } else {
+    ppe <- NULL
+  }
+
+  if(any(format == "bpass")) {
+    message("Formating BayPass")
+
+    if(parallel) {
+      ppp <- parLapply(cl, lgt, function(X) {
+        out <- apply(X, 2, function(x) {
+          zero <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 0)
+          one <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 1)
+          return(c(zero, one))
+        }, simplify = FALSE)
+        do.call(rbind, out)
+      })
+    } else {
+      ppp <- lapply_pb(lgt, function(X) {
+        out <- apply(X, 2, function(x) {
+          zero <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 0)
+          one <- sum((unlist(stringr::str_split(x, "/|\\|"))) == 1)
+          return(c(zero, one))
+        }, simplify = FALSE)
+        do.call(rbind, out)
+      })
+    }
+
+    ppp <- do.call(cbind, ppp)
+
+    # Ensure column names preserve population order
+    colnames(ppp) <- paste0(rep(pp, each = 2), "~", rep(c(1,2), ncol(ppp)/2))
+    rownames(ppp) <- paste0(gt$CHROM, ".", gt$POS)
+
+    if(!is.null(snp.subset)) {
+      rn <- sample(1:snp.subset, nrow(gts), replace = TRUE)
+      rownames(gts) <- paste0(gt$CHROM, ".", gt$POS)
+      chu.p <- split.data.frame(ppp, f = rn)
+    } else {
+      chu.p <- NULL
+    }
+  } else {
+    ppp <- NULL
+  }
+
+  if(parallel) { stopCluster(cl) }
+
+  return(list(baypass = ppp, bayenv = ppe, sub.bp = chu.p, pop = as.character(pp)))
+}
+
+
+
+gt.format0 <- function(gt,info,format=c("benv","bpass"),snp.subset=NULL,parallel=FALSE) {
   if(parallel){numCores<-detectCores()-1
   cl<-makeCluster(numCores)}
 

R/statistics.R

@@ -171,9 +171,9 @@ h.zygosity<-function(vcf,plot=FALSE,pops=NA,verbose=TRUE,parallel=FALSE){
 #'  (2010).
 #'
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path=vcf.file.path)
-#' relate<-relatedness(vcf)
+#' relate<-relatedness(vcf)}
 #'
 #' @export
 relatedness<-function(vcf,plot=TRUE,threshold=0.5,verbose=TRUE,parallel=FALSE){
@@ -286,9 +286,9 @@ relatedness<-function(vcf,plot=TRUE,threshold=0.5,verbose=TRUE,parallel=FALSE){
 #' @author Piyal Karunarathne
 #'
 #' @examples
-#' vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
+#' \dontrun{vcf.file.path <- paste0(path.package("rCNV"), "/example.raw.vcf.gz")
 #' vcf <- readVCF(vcf.file.path=vcf.file.path)
-#' statistics<-vcf.stat(vcf,plot=TRUE)
+#' statistics<-vcf.stat(vcf,plot=TRUE)}
 #'
 #' @export
 vcf.stat<-function(vcf,plot=TRUE,...){

cran-comments.md

@@ -1,5 +1,10 @@
 ## R CMD check results
 
+* Fixes to the notes:
+1. "#VignetteBuilder" line was removed
+2. Date field was updated
+3. time taken for example >10 sec seems to be an internal wind-dev issue. I checked it manually with win-dev release and all examples execute in less than 10 seconds
+
 This is the third update of the package. Several changes have been made to two major functions and new updates have been added. They're as follows:
 
 1. parallelization enabled with parallel package