Merge remote-tracking branch 'upstream/master'

.Rbuildignore

@@ -6,4 +6,3 @@
 ^\.dll$
 cran-comments.md
 NEWS.md
-pinfsc50.png

DESCRIPTION

@@ -1,25 +1,27 @@
 Package: vcfR
 Title: Manipulate and Visualize VCF Data
 Description: Facilitates easy manipulation of variant call format (VCF) data.
-    Functions are provided to rapidly read from and write to VCF files.
-    Once VCF data is read into R a parser function extracts matrices of data.
-    This information can then be used for quality control or other purposes.
-    Additional functions provide visualization of genomic data.
-    Once processing is complete data may be written to a VCF file (*.vcf.gz).
-    It also may be converted into other popular R objects (e.g., genlight, DNAbin).
-    VcfR provides a link between VCF data and familiar R software.
-Version: 1.4.0
-Authors@R: c(person(c('Brian', 'J.'), 'Knaus', role = c('cre', 'aut'),
-    email = '[email protected]'),
-    person(c('Niklaus', 'J.'), 'Grunwald', role = 'aut',
-    email = '[email protected]'),
-    person(c('Eric', 'C.'), 'Anderson', role = 'ctb',
-    email = '[email protected]'),
-    person(c('David', 'J.'), 'Winter', role = 'ctb',
-    email = '[email protected]'),
-    person(c('Zhian', 'N.'), 'Kamvar', role = 'ctb',
-    email = '[email protected]'))
+    Functions are provided to rapidly read from and write to VCF files. Once
+    VCF data is read into R a parser function extracts matrices of data. This
+    information can then be used for quality control or other purposes. Additional
+    functions provide visualization of genomic data. Once processing is complete
+    data may be written to a VCF file (*.vcf.gz). It also may be converted into
+    other popular R objects (e.g., genlight, DNAbin). VcfR provides a link between
+    VCF data and familiar R software.
+Version: 1.5.0
+Authors@R: c(person(c("Brian", "J."), "Knaus", role = c("cre", "aut"),
+    email = "[email protected]"),
+    person(c("Niklaus", "J."), "Grunwald", role = "aut",
+    email = "[email protected]"),
+    person(c("Eric", "C."), "Anderson", role = "ctb",
+    email = "[email protected]"),
+    person(c("David", "J."), "Winter", role = "ctb",
+    email = "[email protected]"),
+    person(c("Zhian", "N."), "Kamvar", role = "ctb",
+    email = "[email protected]"))
 Maintainer: Brian J. Knaus <[email protected]>
+URL: https://github.com/knausb/vcfR, https://knausb.github.io/
+    vcfR_documentation/
 Depends:
     R (>= 3.0.1)
 LinkingTo: Rcpp
@@ -50,4 +52,4 @@ Suggests:
     testthat
 VignetteBuilder: knitr
 License: GPL
-RoxygenNote: 5.0.1
+RoxygenNote: 6.0.1

NAMESPACE

@@ -19,6 +19,7 @@ export(extract.info)
 export(extract_gt_tidy)
 export(extract_info_tidy)
 export(freq_peak)
+export(genetic_diff)
 export(get.alleles)
 export(getALT)
 export(getCHROM)
@@ -69,6 +70,7 @@ exportClasses(chromR)
 exportClasses(vcfR)
 exportMethods(dim)
 exportMethods(head)
+exportMethods(length)
 exportMethods(nrow)
 exportMethods(plot)
 exportMethods(print)
@@ -82,4 +84,4 @@ importFrom(magrittr,"%>%")
 importFrom(stats,setNames)
 importFrom(utils,object.size)
 importFrom(viridisLite,viridis)
-useDynLib(vcfR)
+useDynLib(vcfR, .registration = TRUE)

NEWS.md

@@ -1,4 +1,29 @@
 
+# vcfR 2.0.0.
+There is currently no plan to release vcfR 2.0.0.
+If and when this 'major' release occurs it will include changes that will break backward compatibility.
+At the present, this is simply a to-do list for ideas to include in the next major release.
+
+* Move 'FORMAT' column to its own slot. We can then cbind FORMAT and gt when passing to compiled code.
+This may have been addressed at 64a308ba50b9119108e8946737460de5997b805b by adding `samples` to vcfR method `[`.
+
+
+
+# vcfR 1.5.0
+Released on CRAN 2017-05-18.
+
+* Created `genetic_diff()` to calculate fixation indicies.
+* Addressed symbol recognition NOTE: https://github.com/RcppCore/Rcpp/issues/636#issuecomment-280985661.
+* Moved `pinfsc50.png` to tools.
+* Added `samples` parameter to vcfR method `[`.
+* Deprecated the parameters 'chrom.s' and 'chrom.e' of 'chromo()', please use 'xlim' instead.
+* Added `length()` method for chromR objects.
+* `[` method throws warning if FORMAT is omitted.
+* `plot()` for signature 'chromR' handles INFO column when its all NA.
+* `create.chrom()` subsets to first chromosome when more than one is provided.
+* adegenet::nLoc(NULL) appears to generate an error when converting data types.
+
+
 # vcfR 1.4.0
 Released on CRAN 2017-01-07.
 

R/RcppExports.R

@@ -64,6 +64,10 @@ extract_haps <- function(ref, alt, gt, unphased_as_NA, verbose) {
     .Call('vcfR_extract_haps', PACKAGE = 'vcfR', ref, alt, gt, unphased_as_NA, verbose)
 }
 
+grepa <- function() {
+    invisible(.Call('vcfR_grepa', PACKAGE = 'vcfR'))
+}
+
 #' 
 #' @rdname freq_peak
 #' 

R/chromR-method.R

@@ -2,7 +2,7 @@
 #' @rdname chromR-method
 #' @title chromR-method
 #'
-#' @aliases chromR-method
+#' @aliases chromR,chromR-method
 #'
 #' @description Methods that act on objects of class chromR
 #'
@@ -69,6 +69,7 @@ setMethod( f="show",
 
 
 #' @rdname chromR-method
+#' @aliases plot
 #' @export
 #'
 setMethod( f="plot",
@@ -85,21 +86,21 @@ setMethod( f="plot",
     }
 
     graphics::par(mfrow=c(2,2))
-    if( length(DP) > 0 ){
+    if( length(stats::na.omit(DP)) > 0 ){
       graphics::hist(DP, col=3, main="Read depth (DP)", xlab="")
       graphics::rug(DP)
     } else {
       plot(1:2,1:2, type='n', xlab="", ylab="")
       graphics::title(main="No depths found")
     }
-    if( length(MQ) > 0 ){
+    if( length(stats::na.omit(MQ)) > 0 ){
       graphics::hist(MQ, col=4, main="Mapping quality (MQ)", xlab="")
       graphics::rug(MQ)
     } else {
       plot(1:2,1:2, type='n', xlab="", ylab="")
       graphics::title(main="No mapping qualities found")
     }
-    if( length(QUAL) > 0 ){
+    if( length(stats::na.omit(QUAL)) > 0 ){
       graphics::hist(QUAL, col=5, main="Quality (QUAL)", xlab="")
       graphics::rug(QUAL)
     } else {
@@ -114,6 +115,7 @@ setMethod( f="plot",
       graphics::title(main="No SNP densities found")
     }
     graphics::par(mfrow=c(1,1))
+    return(invisible(NULL))
   }
 )
 
@@ -230,4 +232,16 @@ setMethod(f="names<-",
 )
 
 
+
+#' @rdname chromR-method
+#' @export
+#'
+setMethod( f="length",
+  signature = "chromR",
+  definition=function(x){
+    return(x@len)
+  }
+)
+
+
 # EOF.

R/chromR_functions.R

@@ -19,6 +19,8 @@
 #' @param max_DP maximum cumulative depth
 #' @param min_MQ minimum mapping quality
 #' @param max_MQ maximum mapping quality
+#' @param preserve a logical indicating whether or not to preserve the state of
+#'   the current mask field. Defaults to \code{FALSE}
 #' @param ... arguments to be passed to methods
 #' 
 #' @details
@@ -34,30 +36,40 @@
 #' This vector is stored in the var.info$mask slot of a chromR object.
 #' 
 #masker <- function(x, min_QUAL=999, min_DP=0.25, max_DP=0.75, minmq=20, maxmq=50, ...){
-masker <- function(x, min_QUAL=1, min_DP=1, max_DP=1e4, min_MQ=20, max_MQ=100, ...){
+masker <- function(x, min_QUAL=1, min_DP=1, max_DP=1e4, min_MQ=20, max_MQ=100, preserve=FALSE, ...){
   quals <- getQUAL(x)
 #  quals  <- [email protected]$QUAL
 #  info <- [email protected][,grep("DP|MQ",names([email protected])), drop=FALSE]
 #  mask <- rep(TRUE, times=nrow(info))
-  mask <- rep(TRUE, times=nrow(x@var.info))
-
+  if (preserve){
+    mask <- x@var.info$mask
+  } else {
+    mask <- rep(TRUE, times=nrow(x@var.info))
+  }
   # Mask on QUAL
   if(sum(is.na(quals)) < length(quals)){
-    mask[quals < min_QUAL] <- FALSE
+    # mask[quals < min_QUAL] <- FALSE
+    mask <- mask & quals >= min_QUAL
   }
 
   # Mask on DP
   if( !is.null( x@var.info$DP ) ){
     if(sum(is.na(x@var.info$DP)) < length(x@var.info$DP)){
-      mask[x@var.info$DP < min_DP] <- FALSE
-      mask[x@var.info$DP > max_DP] <- FALSE
+      # mask[[email protected]$DP < min_DP] <- FALSE
+      # mask[[email protected]$DP > max_DP] <- FALSE
+      mask <- mask & 
+        x@var.info$DP >= min_DP & 
+        x@var.info$DP <= max_DP
     }
   }
 
   if( !is.null( x@var.info$MQ ) ){
     if(sum(is.na(x@var.info$MQ)) < length(x@var.info$MQ)){
-      mask[x@var.info$MQ < min_MQ] <- FALSE
-      mask[x@var.info$MQ > max_MQ] <- FALSE
+      # mask[[email protected]$MQ < min_MQ] <- FALSE
+      # mask[[email protected]$MQ > max_MQ] <- FALSE
+      mask <- mask & 
+        x@var.info$MQ >= min_MQ & 
+        x@var.info$MQ <= max_MQ
     }
   }
   x@var.info$mask <- mask

R/chromo_plot.R

@@ -11,8 +11,8 @@
 #' @param chrom an object of class chrom.
 #' @param boxp logical specifying whether marginal boxplots should be plotted [T/F].
 #' @param dp.alpha degree of transparency applied to points in dot plots [0-255].
-#' @param chrom.s	start position for the chromosome.
-#' @param chrom.e	end position for the chromosome.
+#' @param chrom.s	start position for the chromosome. (Deprecated. use xlim)
+#' @param chrom.e	end position for the chromosome. (Deprecated. use xlim)
 #' @param drlist1 a named list containing elements to create a drplot
 #' @param drlist2 a named list containing elements to create a drplot
 #' @param drlist3 a named list containing elements to create a drplot
@@ -51,6 +51,20 @@ chromo <- function( chrom,
     stop("Expecting object of class chromR")
   }
 
+  if( chrom.s != 1 | !is.null(chrom.e) ){
+    stop("The parameters 'chrom.s' and 'chrom.e' were deprecated in vcfR v1.5.0. Please use 'xlim' instead")
+  }
+
+  myDots <- list(...)
+
+  if( !is.null( myDots$xlim ) ){
+    chrom.s <- myDots$xlim[1]
+    chrom.e <- myDots$xlim[2]
+  } else {
+    chrom.s <- 1
+    chrom.e <- length(chrom)
+  }
+
   # Test to see if the mask is populated.
 #  if( length(grep('mask', colnames([email protected]))) < 1 ){
 #    [email protected]$mask <- rep( TRUE, times=nrow(chrom@vcf@fix) )
@@ -463,7 +477,7 @@ chromoqc <- function( chrom,
   )
 
   chromo( chrom, boxp = boxp, 
-          chrom.e = chrom@len, 
+#          chrom.e = chrom@len,
           drlist1 = myList1,
           drlist2 = myList2,
           drlist3 = myList3,
@@ -481,4 +495,4 @@ chromoqc <- function( chrom,
 
 
 ##### ##### ##### ##### #####
-# EOF.
+# EOF.

R/create_chromR.R

@@ -88,6 +88,31 @@ create.chromR <- function(vcf, name="CHROM", seq=NULL, ann=NULL, verbose=TRUE){
   # Determine whether we received the expected classes.
   stopifnot(class(vcf) == "vcfR")
 
+  if( length( unique( getCHROM(vcf) ) ) > 1 ){
+    myChroms <- unique( getCHROM(vcf) )
+    message('vcfR object includes more than one chromosome (CHROM).')
+    message( paste(myChroms, collapse = ", ") )
+    message("Subsetting to the first chromosome")
+    vcf <- vcf[ getCHROM(vcf) == myChroms[1],]
+  }
+
+  if( length( names(seq) ) > 1 ){
+    mySeqs <- names(seq)
+    message('DNAbin object includes more than one chromosome.')
+    message( paste(mySeqs, collapse = ", ") )
+    message("Subsetting to the first chromosome")
+    seq <- seq[ mySeqs[1] ]
+  }
+
+  if( length( unique( ann[,1] ) ) > 1 ){
+    myChroms <- unique( ann[,1] )
+    message('Annotations include more than one chromosome.')
+    message( paste(myChroms, collapse = ", ") )
+    message("Subsetting to the first chromosome")
+    ann <- ann[ann[,1] == myChroms[1], , drop = FALSE]
+  }
+
+
   # Initialize chromR object.  
   x <- new(Class="chromR")
   names(x) <- name