Merge pull request #37 from jasenfinch/devel

v0.5.9

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: metaboMisc
 Title: Miscellaneous Functions for Metabolomics Analyses
-Version: 0.5.8
+Version: 0.5.9
 Authors@R: person("Jasen", "Finch", email = "jsf9@aber.ac.uk", role = c("aut", "cre"))
 Description: Miscellaneous helper functions for metabolomics analyses that do not yet have a permanent home.
 URL: https://jasenfinch.github.io/metaboMisc

NAMESPACE

@@ -59,6 +59,7 @@ importFrom(ggplot2,theme)
 importFrom(lubridate,seconds_to_period)
 importFrom(magrittr,"%>%")
 importFrom(magrittr,set_names)
+importFrom(metabolyseR,"changeParameter<-")
 importFrom(metabolyseR,"dat<-")
 importFrom(metabolyseR,"parameters<-")
 importFrom(metabolyseR,"preTreated<-")

NEWS.md

@@ -1,4 +1,16 @@
-# metabMisc 0.5.8
+# metaboMisc 0.5.9
+
+* Corrected the exported file name for mode-less processed data for the `MetaboProfile` class.
+
+* Fixed the character sanitation in `sanitiseTable()`.
+
+* Fixed extraneous console messages in `detectMissInjections()` and `detectBatchDiff()` methods for the `MetaboProfile` class.
+
+* Enabled unit tests for methods for the `MetaboProfile` class.
+
+* `detectPretreatmentParameters()` now detects the presence of QC samples.
+
+# metaboMisc 0.5.8
 
 * Numbers of characters in strings are now limited by `sanitiseTable()`.
 

R/detect.R

@@ -60,20 +60,27 @@ setMethod('detectMissInjections',signature = 'MetaboProfile',
               mi <- x %>% 
                   processedData()
 
-              if (str_detect(technique(x),'GCMS')) {
-                  mi <- mi %>% 
-                      rowSums() %>%
-                      tibble(value = .) %>%
-                      bind_cols(i)
-              } else {
-                  mi <- mi %>% 
-                  map(rowSums) %>%
-                      bind_cols() %>%
-                      rowSums() %>%
-                      as_tibble() %>%
-                      bind_cols(i)    
+              if (!is.list(mi)){
+                  mi <- list(mi)   
+              }
+
+              mi <- mi %>% 
+                  map(rowSums)
+
+              if (mi %>% 
+                  names() %>% 
+                  is.na() %>% 
+                  any()) {
+                  names(mi) <- replace(names(mi),
+                                       is.na(names(mi)),
+                                       'NA')
               }
-              mi %>%
+
+              mi %>% 
+                  bind_cols() %>%
+                  rowSums() %>%
+                  as_tibble() %>%
+                  bind_cols(i) %>%
                   missInject(idx = idx) 
           })
 
@@ -102,7 +109,7 @@ missInject <- function(TICdat,idx){
 #' @details Analysis of Variance (ANOVA) is used to detect differences in total ion count (TIC) averages between batches/blocks. 
 #' @examples 
 #' ## Retrieve file paths and sample information for example data
-#' files <- metaboData::filePaths('FIE-HRMS','BdistachyonEcotypes')[1:2]
+#' files <- metaboData::filePaths('FIE-HRMS','BdistachyonEcotypes',ask = FALSE)[1:2]
 #' 
 #' info <- metaboData::runinfo('FIE-HRMS','BdistachyonEcotypes')[1:2,]
 #' 
@@ -159,21 +166,30 @@ setMethod('detectBatchDiff',signature =  "MetaboProfile",
               TICdat <- x %>%
                   processedData()
 
-              if (str_detect(technique(x),'GCMS')) {
-                  TICdat <- TICdat %>%
-                      rowSums() %>%
-                      {tibble(Sample = 1:length(.),
-                              TIC = .,
-                              batch = ri[,by] %>% deframe() %>% factor())}
-              } else {
-                  TICdat <- TICdat %>% 
-                      map(rowSums) %>%
-                      bind_cols() %>%
-                      rowid_to_column(var = 'Sample') %>%
-                      mutate(batch = ri[,by] %>% unlist() %>% factor()) %>%
-                      gather('Mode','TIC',-batch,-Sample)   
+              if (!is.list(TICdat)){
+                  TICdat <- list(TICdat)
               }
 
+              TICdat <- TICdat %>% 
+                  map(rowSums) 
+
+              if (TICdat %>% 
+                  names() %>% 
+                  is.na() %>% 
+                  any()) {
+                  names(TICdat) <- replace(names(TICdat),
+                                           is.na(names(TICdat)),
+                                           'NA')
+              }
+
+              TICdat <- TICdat %>%
+                  bind_cols() %>%
+                  rowid_to_column(var = 'Sample') %>%
+                  mutate(batch = ri[,by] %>% 
+                             unlist() %>% 
+                             factor()) %>%
+                  gather('Mode','TIC',-batch,-Sample)   
+
               diff <- batchDiff(TICdat,pthresh)
               return(diff) 
           })
@@ -242,6 +258,8 @@ batchDiff <- function(TICdat,pthresh = 0.05){
 #' @rdname detectPretreatmentParameters
 #' @description Detect pre-treatment parameters for `Binalysis` or `MetaboProfile` class objects. 
 #' @param x S4 object of class `Binalysis`, `MetaboProfile` or `AnalysisData`
+#' @param cls the name of the  sample information table column containing the sample class information
+#' @param QCidx QC sample class label
 #' @return S4 object of class `AnalysisParameters`
 #' @examples
 #' ## Retreive example file paths and sample information 
@@ -263,22 +281,49 @@ batchDiff <- function(TICdat,pthresh = 0.05){
 #' pp
 #' @export
 
-setGeneric('detectPretreatmentParameters',function(x){
+setGeneric('detectPretreatmentParameters',function(x,
+                                                   cls = 'class',
+                                                   QCidx = 'QC'){
     standardGeneric('detectPretreatmentParameters')
 })
 
 #' @rdname detectPretreatmentParameters
+#' @importFrom metabolyseR changeParameter<-
 
 setMethod('detectPretreatmentParameters',signature = 'Binalysis',
-          function(x){
-              detectPretreatment(x)
+          function(x,cls = 'class',QCidx = 'QC'){
+              pp <-  detectPretreatment(x)
+
+              sample_info <- binneR::sampleInfo(x)
+
+              if (!detectQC(sample_info,cls,QCidx)){
+                  parameters(pp,'pre-treatment')$QC <- NULL
+              } else {
+                  changeParameter(pp,'QCidx','pre-treatment') <- QCidx
+              }
+
+              changeParameter(pp,'cls','pre-treatment') <- cls
+
+              return(pp)
           })
 
 #' @rdname detectPretreatmentParameters
 
 setMethod('detectPretreatmentParameters',signature = 'MetaboProfile',
-          function(x){
-              detectPretreatment(x)
+          function(x,cls = 'class',QCidx = 'QC'){
+              pp <- detectPretreatment(x)
+
+              sample_info <- profilePro::sampleInfo(x)
+
+              if (!detectQC(sample_info,cls,QCidx)){
+                  parameters(pp,'pre-treatment')$QC <- NULL
+              } else {
+                  changeParameter(pp,'QCidx','pre-treatment') <- QCidx
+              }
+
+              changeParameter(pp,'cls','pre-treatment') <- cls
+
+              return(pp)
           })
 
 #' @importFrom metabolyseR parameters<- parameters
@@ -314,6 +359,10 @@ detectPretreatment <- function(x){
     return(pre_treat_params)
 } 
 
+detectQC <- function(sample_info,cls,QCidx){
+    any(str_detect(sample_info[[cls]],'QC'))
+}
+
 #' Detect modelling parameters
 #' @rdname detectModellingParameters
 #' @description Detect modelling parameters for `Binalysis`, `MetaboProfile` or `Analysis` S4 classes. 
@@ -366,17 +415,17 @@ setMethod('detectModellingParameters',signature = 'Binalysis',
 
 setMethod('detectModellingParameters',signature = 'MetaboProfile',
           function(x){
-             idx <- x %>% 
-                 processingParameters() %>% 
-                 .$info %>% 
-                 .$cls
-
-             sample_information <- x %>% 
-                 profilePro::sampleInfo() %>% 
-                 select(all_of(idx)) %>% 
-                 deframe()
-
-             detectModelling(sample_information,idx)
+              idx <- x %>% 
+                  processingParameters() %>% 
+                  .$info %>% 
+                  .$cls
+              
+              sample_information <- x %>% 
+                  profilePro::sampleInfo() %>% 
+                  select(all_of(idx)) %>% 
+                  deframe()
+              
+              detectModelling(sample_information,idx)
           })
 
 #' @rdname detectModellingParameters

R/export.R

@@ -88,10 +88,20 @@ setMethod('exportData',signature = 'MetaboProfile',
               file_paths <- pd %>%
                   names() %>%
                   map_chr(~{
+                      prefix <- .x
+
+                      if (prefix != 'n' | prefix != 'p'){
+                          prefix <- ''
+                      } else {
+                       prefix <- switch(prefix,
+                                        n = 'negative_mode_',
+                                        p = 'positive_mode_')   
+                      }
+
                       bind_cols(pd[[.x]],i %>% select(name)) %>%
                           gather('Feature','Intensity',-name) %>%
                           spread(name,Intensity) %>%
-                          exportCSV(str_c(outPath,'/',.x,'_mode_processed_data.csv'))
+                          exportCSV(str_c(outPath,'/',prefix,'processed_data.csv'))
                   })
 
               return(file_paths)

R/sanitise.R

@@ -19,7 +19,7 @@ sanitiseTable <- function(x,maxRows = 5000,sigFig = 3,maxCharacters = 100){
         x <- x[seq_len(maxRows),]
     }
 
-    a <- map_df(x,~{
+    x <- map_df(x,~{
         if (typeof(.x) == 'character'){
             limit_characters <- .x %>% 
                 nchar() %>% 

R/summary.R

@@ -21,28 +21,48 @@ setGeneric('featureSummary',function(x)
     standardGeneric('featureSummary'))
 
 #' @rdname featureSummary
-#' @importFrom dplyr n_distinct
 
 setMethod('featureSummary',signature = 'Binalysis',
           function(x){
               x %>%
-                  binnedData() %>%
-                  map(~{{
-                      .x %>%
-                          rowid_to_column(var = 'Sample') %>%
-                          gather('Feature','Intensity',-Sample)
-                  }}) %>%
-                  bind_rows() %>%
-                  mutate(Mode = str_sub(Feature,1,1)) %>%
-                  group_by(Mode) %>%
-                  summarise(
-                      `Number of bins` = n_distinct(Feature),
-                      `Missing Data (%)` = round(length(which(Intensity == 0)) / 
-                                                     length(Intensity) * 100,2),
-                      .groups = 'drop') %>%
-                  {{
-                      .$Mode[.$Mode == 'n'] <- 'Negative'
-                      .$Mode[.$Mode == 'p'] <- 'Positive'
-                      .
-                  }}
+                  binnedData() %>% 
+                  featSummary()
           })
+
+#' @rdname featureSummary
+
+setMethod('featureSummary',signature = 'MetaboProfile',
+          function(x){
+              x %>% 
+                  processedData() %>% 
+                  featSummary()
+          })
+
+#' @importFrom dplyr n_distinct
+
+featSummary <- function(x){
+
+    if (!is.list(x)){
+        x <- list(x)
+    }
+
+    x %>%
+        map(~{{
+            .x %>%
+                rowid_to_column(var = 'Sample') %>%
+                gather('Feature','Intensity',-Sample)
+        }}) %>%
+        bind_rows() %>%
+        mutate(Mode = str_sub(Feature,1,1)) %>%
+        mutate(Mode = replace(Mode, 
+                              Mode != 'n' & Mode != 'p',
+                              NA)) %>% 
+        group_by(Mode) %>%
+        summarise(
+            `Number of bins` = n_distinct(Feature),
+            `Missing Data (%)` = round(length(which(Intensity == 0)) / 
+                                           length(Intensity) * 100,2),
+            .groups = 'drop') %>%
+        mutate(Mode = replace(Mode,Mode == 'n','Negative') %>% 
+                   replace(Mode == 'p','Positive'))
+}