R/getPeaks.R

In jasenfinch/binneRlyse: Spectral binning and accurate m/z extraction for FIE-HRMS metabolomics analyses

combScans <- function(x,scans,sranges,modes){
    # separate scans based on modes
    pat <- unlist(lapply(modes,function(x,sranges){
        rep(x,length(sranges))
    },sranges = sranges))
    pat <- rep(pat,length(x)/length(pat))
    pos.neg <- lapply(modes,function(y,x,pat){
        x <- x[which(pat == y)]
        return(x)
    },pat = pat,x = x)
    # separate scan ranges and keep only relevant scans
    pat.1 <- unlist(lapply(seq(1,length(pos.neg[[1]])/length(sranges)),rep,times = length(sranges)))
    pos.neg <- lapply(pos.neg,function(x,pattern){
        y <- list()
        for (i in unique(pattern)) {
            y[[i]] <- x[which(pattern == i)]
        }
        return(y)
    },pattern = pat.1)
    pos.neg <- lapply(pos.neg,function(x,scans){
        return(x[scans])
    },scans = scans)
    # combine scan ranges into single lists, boundary always equal to upper limit
    pos.neg <- lapply(pos.neg,function(x,sranges){
        return(lapply(x,function(y,sranges){
            for (i in 1:length(y)) {
                z <- y[[i]]
                y[[i]] <- z[which(z[,1] > sranges[[i]][1] & z[,1] <= sranges[[i]][2]),]
            }
            y <- y %>%
                map(as_tibble) %>%
                bind_rows()
            colnames(y) <- c("mz","intensity")
            return(y)
        },sranges = sranges))},sranges = sranges)
    pos.neg <- lapply(pos.neg,function(x,scans){
        names(x) <- scans
        return(x)
    },scans = scans)
    names(pos.neg) <- modes
    return(pos.neg)
}

#' @importFrom mzR openMSfile peaks
#' @importFrom purrr map
#' @importFrom dplyr bind_rows
#' @importFrom tibble as_tibble

getFile <- function(file,scans,sranges,modes){
    ms <- openMSfile(file,backend = 'pwiz')
    pks <- peaks(ms) %>%
        combScans(scans,sranges,modes) %>%
        map(bind_rows,.id = 'Scan') %>%
        bind_rows(.id = 'Mode') %>%
        as_tibble()
}

#' @importFrom parallel makeCluster stopCluster parLapply
#' @importFrom dplyr mutate

getPeaks <- function(files,scans,sranges,modes,nCores,clusterType){
   if (nCores < 1) {
       pks <- map(files,getFile,scans,sranges,modes)
   } else {
       clus <- makeCluster(nCores,type = clusterType)
       pks <- parLapply(clus,files,getFile,scans = scans,sranges = sranges,modes = modes)
       stopCluster(clus)
   }
    names(pks) <- files
    pks <- pks %>%
        bind_rows(.id = 'File') %>%
        mutate(mz = round(mz,5),Bin = round(mz,2))
    return(pks)
}