R/hello.R

Defines functions parse.spectrum.table get_spectrum_table get_unique_filters.data.frame get_unique_filters.character get_filter_groups get_filter_groups.data.frame get_filter_groups.character subset_ms reducemslevels

parse.spectrum.table <- function(filepath) {
    # rawfilename <- scan(filepath, nlines = 1, what = 'character')
    tablenames <- scan(filepath, nlines = 1, skip = 1,what = 'character')
    if (any(grepl("#", tablenames))) { tablenames <- tablenames[-1] }
    df <- data.table::fread(filepath, skip = 2)
    data.table::setnames(df, colnames(df), tablenames)
    return(df)
}


get_spectrum_table <- function(filepath, outdir = '.') {
    results <- system2("msaccess",
            glue::glue("--verbose ",
                       "-x \"spectrum_table delimiter=tab\" ",
                       "-o {outdir} {filepath}"), wait = TRUE, stdout = TRUE)
    print(results)

    resultsfile <- grep(pattern = "SpectrumTable", results, value = TRUE)
    resultsfile <- gsub(".* Writing file (.*.tsv)", "\\1", resultsfile)

    message(glue::glue("results file will be read from {resultsfile}",
                       resultsfile =resultsfile))
    stopifnot(file.exists(resultsfile))
    df <- data.table::fread(resultsfile)
    return(df)
}


get_unique_filters <- function (x, ...) {
    UseMethod("get_unique_filters", x)
}

get_unique_filters.data.frame <- function(x, ...) {
    unique(x[,c("precursorMZ", "msLevel", "filterStringMZ")])
}

get_unique_filters.character <- function(x) {
    stopifnot(file.exists(x))

    df <- parse.spectrum.table(x)
    filters <- get_unique_filters.data.frame(df)

    return(filters)
}



get_filter_groups <- function(x, ...) {
    UseMethod("get_filter_groups", x)
}


get_filter_groups.data.frame <- function(x, simplify = FALSE,...) {
    splitfilters <- split(x,as.factor(x[['filterStringMZ']]))
    is_grouped <- lapply(splitfilters, function(splitfilters) dim(splitfilters)[[1]]) > 1
    grouped_filters <- splitfilters[is_grouped]
    ungrouped_filters <- splitfilters[!is_grouped]

    if (simplify) {
        grouped_filters <- lapply(grouped_filters, function(x){x[["precursorMZ"]]})
    }

    return(grouped_filters)
}


get_filter_groups.character <- function(x, ...) {
    stopifnot(file.exists(x))

    df <- parse.spectrum.table(x)
    filter_groups <- get_filter_groups.data.frame(df, ...)

    return(filter_groups)
}



subset_ms <- function(filepath, precursors, outdir) {
    system2(
        'msconvert',
        glue::glue(
            " --verbose ",
            "--outdir {outdir} {filepath} ",
            " --filter \"mzPrecursors [{paste(precursors, collapse = ',')}]\" ",
            precursors = precursors,
            filepath = filepath,
            outdir = outdir))
}



reducemslevels <- function(filepath, filepath.out,
                           minmslevel = 1, maxmslevel = 9,
                           reduction = 1, dry = FALSE) {
    con = file(filepath, "r")
    con2 = file(filepath.out, "wb")

    regex <- glue::glue("^(.*name=\"ms level\" value=\")([{a}-{b}])(\"\\/>$)",
                        a = minmslevel,
                        b = maxmslevel)
    testregex <- "(name=\"ms level\" value=\")([0-9])(\"\\/>$)"
    while (TRUE) {
        line <- readLines(con, n = 1)
        if (length(line) == 0) {
            break
        }

        matchdata <- grepl(testregex, line, perl = TRUE)
        if (matchdata) {
            num <- gsub(regex, "\\2", line, perl = TRUE)
            line <- gsub(regex,
                         paste0("\\1",
                                newmslevel = as.numeric(num)-1,
                                "\\3"),
                         line, perl = TRUE)
        }
        if (dry) {
            print(line)
        } else {
            writeLines(line, con2)
        }
    }
    close(con)
    close(con2)
}
jspaezp/msunfolderr documentation built on May 24, 2019, 12:36 a.m.