Merge pull request #45 from jasenfinch/devel

v0.7.10

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: MFassign
 Title: Molecular Formula Assignment for High Resolution metabolomics
-Version: 0.7.9
+Version: 0.7.10
 Authors@R: person("Jasen", "Finch", email = "[email protected]", role = c("aut", "cre"))
 Description: Molecular formula assignment for high resolution metabolomics.
 Depends: R (>= 3.5.0),

NAMESPACE

@@ -26,6 +26,7 @@ importFrom(crayon,yellow)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
+importFrom(dplyr,contains)
 importFrom(dplyr,desc)
 importFrom(dplyr,distinct)
 importFrom(dplyr,filter)

R/allClasses.R

@@ -38,7 +38,7 @@ setClass('AssignmentParameters',
          prototype = list(
            technique = 'FIE',
            correlations = list(method = 'pearson',pAdjustMethod = 'bonferroni',corPvalue = 0.05),
-           filter = list(rthresh = 0.7,n = 100000,rIncrement = 0.01,nIncrement = 20000),
+           filter = list(rthresh = 0.7,n = 200000,rIncrement = 0.01,nIncrement = 20000),
            maxM = 1000,
            maxMFscore = 5,
            ppm = 5,

R/relationships-method.R

@@ -1,5 +1,5 @@
 #' @importFrom furrr future_map
-#' @importFrom dplyr mutate bind_rows filter vars
+#' @importFrom dplyr mutate bind_rows filter vars contains
 #' @importFrom dplyr inner_join semi_join select mutate_at
 #' @importFrom stringr str_sub str_replace_all
 #' @importFrom mzAnnotation relationshipCalculator
@@ -20,37 +20,75 @@ setMethod('relationships',signature = 'Assignment',
             cors <- assignment@preparedCorrelations
 
             if (isTRUE(transformations)) {
-              trans <- parameters@transformations
+              trans <- c(NA,parameters@transformations)
             } else {
-              trans <- c()
+              trans <- NA
             }
 
             rel <- cors %>%
               select(`m/z1`,`m/z2`,Mode1,Mode2) %>%
               split(1:nrow(.)) %>%
               future_map(~{
-                relationshipCalculator(.x %>% 
-                                         select(`m/z1`,`m/z2`) %>% 
-                                         unlist(),
-                                       limit = parameters@limit,
-                                       modes = .x %>% 
-                                         select(Mode1,Mode2) %>% 
-                                         unlist(),
-                                       adducts = parameters@adducts, 
-                                       isotopes = parameters@isotopes,
-                                       transformations = trans,
-                                       adductTable = parameters@adductRules,
-                                       isotopeTable = parameters@isotopeRules,
-                                       transformationTable = parameters@transformationRules)
+
+                mzs <- bind_rows(
+                  .x %>% 
+                    select(contains('1')) %>% 
+                    setNames(stringr::str_remove(names(.),'1')),
+                  .x %>% 
+                    select(contains('2')) %>% 
+                    setNames(stringr::str_remove(names(.),'2'))
+                )
+
+                modes <- mzs$Mode %>% 
+                  unique()
+
+                if (length(modes) > 1){
+                  adducts <- parameters@adducts %>% 
+                    unlist()
+                } else {
+                  adducts <- parameters@adducts[[modes]]
+                }
+
+                relationships <- relationshipCalculator(mzs$`m/z`,
+                                                        limit = parameters@limit,
+                                                        adducts = adducts, 
+                                                        isotopes = c(NA,parameters@isotopes),
+                                                        transformations = trans,
+                                                        adductTable = parameters@adductRules,
+                                                        isotopeTable = parameters@isotopeRules,
+                                                        transformationTable = parameters@transformationRules) %>% 
+                  left_join(mzs,by = c('m/z1' = 'm/z')) %>% 
+                  rename(Mode1 = Mode) %>% 
+                  left_join(mzs,by = c('m/z2' = 'm/z')) %>% 
+                  rename(Mode2 = Mode) %>% 
+                  dplyr::relocate(contains('Mode'),.after = `m/z2`)
+
+                if (length(modes) > 1){
+                  adduct_modes <- parameters@adducts %>% 
+                    map(tibble::enframe,value = 'Adduct') %>% 
+                    bind_rows(.id = 'Mode') %>% 
+                    select(-name)
+
+                  relationships <- relationships %>% 
+                    inner_join(adduct_modes,
+                               by = c('Mode1' = 'Mode',
+                                      'Adduct1' = 'Adduct')) %>% 
+                    inner_join(adduct_modes,
+                               by = c('Mode2' = 'Mode',
+                                      'Adduct2' = 'Adduct'))
+                }
+
+                return(relationships)
               }) %>%
               bind_rows() %>%
-              inner_join(cors,by = c('m/z1' = 'm/z1','m/z2' = 'm/z2')) %>%
-              select(Feature1:Mode2,
-                     `m/z1`,
-                     `m/z2`,
-                     RetentionTime1,
-                     RetentionTime2,
-                     Adduct1:Transformation2,
+              inner_join(cors,by = c('m/z1','m/z2','Mode1','Mode2')) %>%
+              select(contains('Feature'),
+                     contains('Mode'),
+                     contains('m/z'),
+                     contains('RetentionTime'),
+                     contains('Adduct'),
+                     contains('Isotope'),
+                     contains('Transformation'),
                      log2IntensityRatio,
                      r,
                      Error,