Enabled custom specification of binning decimal places by the use of …

…the binner_dp global option or BINNER_DP environment variable. Added relevant tests and documentation

DESCRIPTION

@@ -45,6 +45,7 @@ Collate:
     readBinningParameters.R
     reexports.R
     access.R
+    internals.R
 Suggests: 
     knitr,
     rmarkdown,

NAMESPACE

@@ -98,6 +98,7 @@ importFrom(stats,median)
 importFrom(stringr,regex)
 importFrom(stringr,str_c)
 importFrom(stringr,str_detect)
+importFrom(stringr,str_extract)
 importFrom(stringr,str_remove_all)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_sub)

R/binneRlyse.R

@@ -10,6 +10,11 @@
 #' Parallel processing is managed by the \code{future} package. This can 
 #' be specified using the \code{plan() function}. See the example below 
 #' and \code{?future::plan} for details on how this can be specified.
+#' 
+#' By default, spectral binning is performed at the recommended 2 decimal 
+#' places. This can be altered by setting either the global option 
+#' \code{binner_dp} or the environment variable \code{BINNER_DP}.
+#' 
 #' @seealso \code{\link{Binalysis-class}}, \code{\link{binParameters}}, 
 #' \code{\link{sampleInfo}}, \code{\link{binnedData}},  \code{\link{accurateData}}
 #' @examples 

R/calc.R

@@ -18,8 +18,12 @@ calcBinMeasures <- function(pks,cls){
                               cls,
                               'polarity',
                               'bin')))) %>%
-    summarise(purity = binPurity(mz,intensity),
-              centrality = binCentrality(mz,intensity),
+    summarise(purity = binPurity(mz,
+    																													intensity,
+    																													dp = binnerDP()),
+              centrality = binCentrality(mz,
+              																											intensity,
+              																											dp = binnerDP()),
               .groups = 'drop')
 
   return(binMeasures)

R/get.R

@@ -3,13 +3,13 @@
 #' @importFrom magrittr %>%
 
 sampProcess <- function(file,scans,dp){
-    
-    pl <- getFile(file,scans) %>%
-        mutate(mz = round(mz,dp)) %>% 
-        group_by(polarity,mz) %>% 
-        summarise(intensity = sum(intensity)/length(scans)) 
-    
-    return(pl)
+	
+	pl <- getFile(file,scans) %>%
+		mutate(mz = round(mz,dp)) %>% 
+		group_by(polarity,mz) %>% 
+		summarise(intensity = sum(intensity)/length(scans)) 
+	
+	return(pl)
 }
 
 #' @importFrom mzR openMSfile peaks close
@@ -19,68 +19,70 @@ sampProcess <- function(file,scans,dp){
 #' @importFrom magrittr set_colnames set_names
 
 getFile <- function(file,scans){
-    
-    ms <- openMSfile(file,backend = 'pwiz')
-    
-    hd <- header(ms) %>%
-        select(seqNum,polarity,filterString) %>%
-        group_by(polarity,filterString) %>%
-        mutate(scan = 1:dplyr::n()) %>%
-        filter(scan %in% scans) 
-    
-    hd$polarity[hd$polarity == 0] <- 'n'
-    hd$polarity[hd$polarity == 1] <- 'p'
-    
-    file_peaks <- ms %>%
-        peaks() %>%
-        .[hd$seqNum] %>%
-        map(~{
-            d <- .
-            d %>%
-                set_colnames(c('mz','intensity')) %>%
-                as_tibble() %>%
-                filter(intensity > 0)
-        }) %>%
-        set_names(hd$seqNum) %>%
-        bind_rows(.id = 'seqNum') %>%
-        mutate(seqNum = as.numeric(seqNum)) %>%
-        left_join(hd, by = "seqNum") %>%
-        select(-filterString,-seqNum)
-    
-    return(file_peaks)
+	
+	ms <- openMSfile(file,backend = 'pwiz')
+	
+	hd <- header(ms) %>%
+		select(seqNum,polarity,filterString) %>%
+		group_by(polarity,filterString) %>%
+		mutate(scan = 1:dplyr::n()) %>%
+		filter(scan %in% scans) 
+	
+	hd$polarity[hd$polarity == 0] <- 'n'
+	hd$polarity[hd$polarity == 1] <- 'p'
+	
+	file_peaks <- ms %>%
+		peaks() %>%
+		.[hd$seqNum] %>%
+		map(~{
+			d <- .
+			d %>%
+				set_colnames(c('mz','intensity')) %>%
+				as_tibble() %>%
+				filter(intensity > 0)
+		}) %>%
+		set_names(hd$seqNum) %>%
+		bind_rows(.id = 'seqNum') %>%
+		mutate(seqNum = as.numeric(seqNum)) %>%
+		left_join(hd, by = "seqNum") %>%
+		select(-filterString,-seqNum)
+	
+	return(file_peaks)
 }
 
 #' @importFrom parallel makeCluster stopCluster parLapply clusterExport
 #' @importFrom dplyr mutate
 
 getPeaks <- function(files,scans){
-
-    pks <- future_map(files,getFile,scans = scans) %>%
-        set_names(files) %>%
-        bind_rows(.id = 'fileName') %>%
-        mutate(fileName = basename(fileName),
-               mz = round(mz,5),bin = round(mz,2))
-    return(pks)
+
+	dp <- binnerDP()
+
+	pks <- future_map(files,getFile,scans = scans) %>%
+		set_names(files) %>%
+		bind_rows(.id = 'fileName') %>%
+		mutate(fileName = basename(fileName),
+									mz = round(mz,5),bin = round(mz,dp))
+	return(pks)
 }
 
 #' @importFrom mzR header
 
 getHeaders <- function(files){
-    
-    headers <- files %>% 
-        future_map(~{
-        ms <- .x %>%
-            openMSfile(backend = 'pwiz') 
-        
-        file_header <- ms %>%
-            header()
-        
-        return(file_header)
-    }) %>%
-        set_names(files) %>%
-        bind_rows(.id = 'FileName') %>%
-        select(FileName,acquisitionNum,totIonCurrent,polarity,filterString)
-    
-    return(headers)
+	
+	headers <- files %>% 
+		future_map(~{
+			ms <- .x %>%
+				openMSfile(backend = 'pwiz') 
+			
+			file_header <- ms %>%
+				header()
+			
+			return(file_header)
+		}) %>%
+		set_names(files) %>%
+		bind_rows(.id = 'FileName') %>%
+		select(FileName,acquisitionNum,totIonCurrent,polarity,filterString)
+	
+	return(headers)
 }
 

R/internals.R

@@ -0,0 +1,66 @@
+
+binnerDPenv <- function(){
+	dp <- Sys.getenv('BINNER_DP')
+
+	if (dp != '') {
+		dp <- suppressWarnings(as.numeric(dp))
+	} else {
+		dp <- 2
+	}
+
+	if (is.na(dp)){
+		warning("The environment variable 'BINNER_DP' is not numeric. Using 2 decimal places instead.",
+										call. = FALSE)
+		dp <- 2
+	}
+
+	if (dp > 5){
+		warning("The environment variable 'BINNER_DP' is greater than 5. Using 2 decimal places instead.",
+										call. = FALSE)
+		dp <- 2
+	}
+
+	return(dp)
+}
+
+binnerDPopt <- function(){
+	dp <- options()$binner_dp
+
+	if (is.null(dp)){
+		dp <- 2
+	}
+
+	if (!is.numeric(dp)){
+		warning("The global option 'binner_dp' is not numeric. Using 2 decimal places instead.",
+										call. = FALSE)
+		dp <- 2
+	}
+
+	if (dp > 5){
+		warning("The global option 'binner_dp' is greater than 5. Using 2 decimal places instead.",
+										call. = FALSE)
+		dp <- 2
+	}
+
+	return(dp)
+}
+
+binnerDP <- function(){
+
+	dp_env <- binnerDPenv()
+
+	dp_opt <- binnerDPopt()
+
+	dp <- c(dp_opt,
+									dp_env) %>% 
+		unique()
+
+		if (length(dp) > 1) {
+			warning("The environment variable 'BINNER_DP' and global option 'binner_dp' are differentially set. Using the value of 'binner_dp'.",
+											call. = FALSE)
+
+			dp <- dp[1]
+		}
+
+	return(dp)
+}

R/plot.R

@@ -8,7 +8,7 @@
 #' @seealso \code{\link{accurateData}}, \code{\link{binneRlyse}}
 #' @importFrom ggplot2 ggplot geom_density theme_bw xlim xlab ggtitle theme
 #' @importFrom ggplot2 element_text facet_wrap aes
-#' @importFrom stringr str_replace_all str_sub
+#' @importFrom stringr str_replace_all str_sub str_extract
 #' @importFrom stats as.formula
 #' @export
 
@@ -33,10 +33,14 @@ setMethod('plotBin',signature = 'Binalysis',
 							stop('Bin not found.',call. = FALSE)
 						}
 
+						dp <- str_extract(bin,'(?<=[.])[\\w+.-]+') %>% 
+							nchar()
+
 						pl <- ggplot(dat,aes(x = mz)) +
 							geom_density() +
 							theme_bw() +
-							xlim(m - 0.005,m + 0.005) +
+							xlim(m - 5 * 10^-(dp + 1),
+												m + 5 * 10^-(dp + 1)) +
 							theme(plot.title = element_text(face = 'bold'),
 										axis.title.y = element_text(face = 'bold'),
 										axis.title.x = element_text(face = 'bold.italic'),

R/singleSample.R

@@ -9,6 +9,11 @@
 #' Parallel processing is managed by the \code{future} package. This can 
 #' be specified using the \code{plan() function}. See the example below 
 #' and \code{?future::plan} for details on how this can be specified.
+#' 
+#' By default, spectral binning is performed at the recommended 2 decimal 
+#' places. This can be altered by setting either the global option 
+#' \code{binner_dp} or the environment variable \code{BINNER_DP}.
+#' 
 #' @examples 
 #' file_path <- metaboData::filePaths('FIE-HRMS','BdistachyonEcotypes')[1]
 #' 

tests/testthat/test-internals.R

@@ -0,0 +1,58 @@
+
+test_that("setting BINNER_DP works", {
+	Sys.setenv(BINNER_DP = 3)
+
+	expect_equal(binnerDPenv(),3)
+
+	Sys.unsetenv('BINNER_DP')
+})
+
+test_that("warning thrown when BINNER_DP set above 5", {
+	Sys.setenv(BINNER_DP = 6)
+
+	expect_warning(binnerDPenv())
+
+	Sys.unsetenv('BINNER_DP')
+})
+
+test_that("warning thrown when BINNER_DP set as non-numeric", {
+	Sys.setenv(BINNER_DP = 'a')
+
+	expect_warning(binnerDPenv())
+
+	Sys.unsetenv('BINNER_DP')
+})
+
+test_that("setting binner_dp works", {
+	options(binner_dp = 3)
+
+	expect_equal(binnerDPopt(),3)
+
+	options(binner_dp = NULL)
+})
+
+test_that("warning thrown when binner_dp set above 5", {
+	options(binner_dp = 6)
+
+	expect_warning(binnerDPopt())
+
+	options(binner_dp = NULL)
+})
+
+test_that("warning thrown when binner_dp set as non-numeric", {
+	options(binner_dp = 'a')
+
+	expect_warning(binnerDPopt())
+
+	options(binner_dp = NULL)
+})
+
+test_that("warning thrown when BINNER_DP and binner_dp are differentially set", {
+	options(binner_dp = 3)
+	Sys.setenv(BINNER_DP = 4)
+
+	expect_warning(binnerDP())
+
+	options(binner_dp = NULL)
+	Sys.unsetenv('BINNER_DP')
+})