fix #7 (new 'mono.rm' in hlaAttrBagging())

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: HIBAG
 Type: Package
 Title: HLA Genotype Imputation with Attribute Bagging
-Version: 1.19.2
-Date: 2019-04-03
+Version: 1.19.3
+Date: 2019-04-11
 Depends: R (>= 3.2.0)
 Imports: methods
 Suggests: parallel, knitr, gdsfmt (>= 1.2.2), SNPRelate (>= 1.1.6), ggplot2,

R/HIBAG.R

@@ -5,7 +5,7 @@
 #   HIBAG -- HLA Genotype Imputation with Attribute Bagging
 #
 # HIBAG R package, HLA Genotype Imputation with Attribute Bagging
-# Copyright (C) 2011-2018   Xiuwen Zheng (zhengx@u.washington.edu)
+# Copyright (C) 2011-2019   Xiuwen Zheng (zhengx@u.washington.edu)
 # All rights reserved.
 #
 # This program is free software: you can redistribute it and/or modify
@@ -46,7 +46,7 @@
 #
 
 hlaAttrBagging <- function(hla, snp, nclassifier=100L,
-    mtry=c("sqrt", "all", "one"), prune=TRUE, na.rm=TRUE,
+    mtry=c("sqrt", "all", "one"), prune=TRUE, na.rm=TRUE, mono.rm=TRUE,
     verbose=TRUE, verbose.detail=FALSE)
 {
     # check
@@ -56,6 +56,7 @@ hlaAttrBagging <- function(hla, snp, nclassifier=100L,
     stopifnot(is.character(mtry) | is.numeric(mtry), length(mtry)>0L)
     stopifnot(is.logical(prune), length(prune)==1L)
     stopifnot(is.logical(na.rm), length(na.rm)==1L)
+    stopifnot(is.logical(mono.rm), length(mono.rm)==1L)
     stopifnot(is.logical(verbose), length(verbose)==1L)
     stopifnot(is.logical(verbose.detail), length(verbose.detail)==1L)
     if (verbose.detail) verbose <- TRUE
@@ -104,23 +105,27 @@ hlaAttrBagging <- function(hla, snp, nclassifier=100L,
     tmp.snp.allele <- snp$snp.allele
 
     # remove mono-SNPs
-    snpsel <- rowMeans(snp.geno, na.rm=TRUE)
-    snpsel[!is.finite(snpsel)] <- 0
-    snpsel <- (0 < snpsel) & (snpsel < 2)
-    if (sum(!snpsel) > 0L)
+    if (mono.rm)
     {
-        snp.geno <- snp.geno[snpsel, ]
-        if (verbose)
+        snpsel <- rowMeans(snp.geno, na.rm=TRUE)
+        snpsel[!is.finite(snpsel)] <- 0
+        snpsel <- (0 < snpsel) & (snpsel < 2)
+        if (sum(!snpsel) > 0L)
         {
-            a <- sum(!snpsel)
-            if (a > 0L)
-                cat(sprintf("Exclude %d monomorphic SNP%s\n", a, .plural(a)))
+            snp.geno <- snp.geno[snpsel, ]
+            if (verbose)
+            {
+                a <- sum(!snpsel)
+                if (a > 0L)
+                    cat(sprintf("Exclude %d monomorphic SNP%s\n", a, .plural(a)))
+            }
+            tmp.snp.id <- tmp.snp.id[snpsel]
+            tmp.snp.position <- tmp.snp.position[snpsel]
+            tmp.snp.allele <- tmp.snp.allele[snpsel]
         }
-        tmp.snp.id <- tmp.snp.id[snpsel]
-        tmp.snp.position <- tmp.snp.position[snpsel]
-        tmp.snp.allele <- tmp.snp.allele[snpsel]
     }
 
+    # check
     if (length(samp.id) <= 0L)
         stop("There is no common sample between 'hla' and 'snp'.")
     if (length(dim(snp.geno)[1L]) <= 0L)
@@ -239,7 +244,7 @@ hlaAttrBagging <- function(hla, snp, nclassifier=100L,
 
 hlaParallelAttrBagging <- function(cl, hla, snp, auto.save="",
     nclassifier=100L, mtry=c("sqrt", "all", "one"), prune=TRUE, na.rm=TRUE,
-    stop.cluster=FALSE, verbose=TRUE)
+    mono.rm=TRUE, stop.cluster=FALSE, verbose=TRUE)
 {
     # check
     stopifnot(is.null(cl) | is.numeric(cl) | inherits(cl, "cluster"))
@@ -250,6 +255,7 @@ hlaParallelAttrBagging <- function(cl, hla, snp, auto.save="",
     stopifnot(is.character(mtry) | is.numeric(mtry), length(mtry)>0L)
     stopifnot(is.logical(prune), length(prune)==1L)
     stopifnot(is.logical(na.rm), length(na.rm)==1L)
+    stopifnot(is.logical(mono.rm), length(mono.rm)==1L)
     stopifnot(is.logical(stop.cluster))
     stopifnot(is.logical(verbose))
 
@@ -302,11 +308,11 @@ hlaParallelAttrBagging <- function(cl, hla, snp, auto.save="",
         total <- 0L
 
         .DynamicClusterCall(cl,
-            fun = function(job, hla, snp, mtry, prune, na.rm)
+            fun = function(job, hla, snp, mtry, prune, na.rm, mono.rm)
             {
                 eval(parse(text="library(HIBAG)"))
                 model <- hlaAttrBagging(hla=hla, snp=snp, nclassifier=0L,
-                    mtry=mtry, prune=prune, na.rm=na.rm,
+                    mtry=mtry, prune=prune, na.rm=na.rm, mono.rm=mono.rm,
                     verbose=FALSE, verbose.detail=FALSE)
                 mobj <- hlaModelToObj(model)
                 hlaClose(model)
@@ -347,7 +353,8 @@ hlaParallelAttrBagging <- function(cl, hla, snp, auto.save="",
                 }
             },
             n = nclassifier, stop.cluster = stop.cluster,
-            hla=hla, snp=snp, mtry=mtry, prune=prune, na.rm=na.rm
+            hla=hla, snp=snp, mtry=mtry, prune=prune,
+            na.rm=na.rm, mono.rm=mono.rm
         )
     })
 

inst/CITATION

@@ -16,3 +16,18 @@ citEntry(entry="Article",
             "The Pharmacogenomics Journal.",
             "(2014)", "14, 192-200")
 )
+
+citEntry(entry="Article",
+    title = "Imputation-Based HLA Typing with SNPs in GWAS Studies",
+    author = personList(person("Xiuwen", "Zheng")),
+    journal = {"Methods in Molecular Biology"},
+    year = "2018",
+    url = "https://doi.org/10.1007/978-1-4939-8546-3_11",
+
+    textVersion =
+        paste("Zheng, X.",
+            "Imputation-Based HLA Typing with SNPs in GWAS Studies.",
+            "In: Boegel S. (eds) HLA Typing.",
+            "Methods in Molecular Biology.",
+            "(2018)", "Vol 1802. Humana Press, New York, NY.")
+)

inst/GPLv3

@@ -652,7 +652,7 @@ Also add information on how to contact you by electronic and paper mail.
   If the program does terminal interaction, make it output a short
 notice like this when it starts in an interactive mode:
 
-    HIBAG    Copyright (C) 2011-2018    Xiuwen Zheng
+    HIBAG    Copyright (C) 2011-2019    Xiuwen Zheng
     This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
     This is free software, and you are welcome to redistribute it
     under certain conditions; type `show c' for details.

man/hlaAttrBagging.Rd

@@ -8,7 +8,7 @@
 }
 \usage{
 hlaAttrBagging(hla, snp, nclassifier=100L, mtry=c("sqrt", "all", "one"),
-    prune=TRUE, na.rm=TRUE, verbose=TRUE, verbose.detail=FALSE)
+    prune=TRUE, na.rm=TRUE, mono.rm=TRUE, verbose=TRUE, verbose.detail=FALSE)
 }
 \arguments{
     \item{hla}{the training HLA types, an object of
@@ -21,6 +21,7 @@ hlaAttrBagging(hla, snp, nclassifier=100L, mtry=c("sqrt", "all", "one"),
     \item{prune}{if TRUE, to perform a parsimonious forward variable selection,
         otherwise, exhaustive forward variable selection. See details}
     \item{na.rm}{if TRUE, remove the samples with missing HLA types}
+    \item{mono.rm}{if TRUE, remove monomorphic SNPs}
     \item{verbose}{if TRUE, show information}
     \item{verbose.detail}{if TRUE, show more information}
 }

man/hlaParallelAttrBagging.Rd

@@ -9,7 +9,7 @@
 \usage{
 hlaParallelAttrBagging(cl, hla, snp, auto.save="",
     nclassifier=100L, mtry=c("sqrt", "all", "one"), prune=TRUE, na.rm=TRUE,
-    stop.cluster=FALSE, verbose=TRUE)
+    mono.rm=TRUE, stop.cluster=FALSE, verbose=TRUE)
 }
 \arguments{
     \item{cl}{if a cluster object, created by the package
@@ -25,6 +25,7 @@ hlaParallelAttrBagging(cl, hla, snp, auto.save="",
     \item{prune}{if TRUE, to perform a parsimonious forward variable selection,
         otherwise, exhaustive forward variable selection. See details}
     \item{na.rm}{if TRUE, remove the samples with missing HLA types}
+    \item{mono.rm}{if TRUE, remove monomorphic SNPs}
     \item{stop.cluster}{\code{TRUE}: stop cluster nodes after computing}
     \item{verbose}{if TRUE, show information}
 }