Mercurial > repos > prog > lcmsmatching
comparison MsDbOutputDataFrameStream.R @ 0:e66bb061af06 draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
| author | prog |
|---|---|
| date | Tue, 12 Jul 2016 12:02:37 -0400 |
| parents | |
| children | 253d531a0193 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:e66bb061af06 |
|---|---|
| 1 if ( ! exists('MsDbOutputDataFrameStream')) { # Do not load again if already loaded | |
| 2 | |
| 3 library(methods) | |
| 4 library(plyr) | |
| 5 source('MsDbOutputStream.R') | |
| 6 source('dfhlp.R', chdir = TRUE) | |
| 7 | |
| 8 ##################### | |
| 9 # CLASS DECLARATION # | |
| 10 ##################### | |
| 11 | |
| 12 MsDbOutputDataFrameStream <- setRefClass("MsDbOutputDataFrameStream", contains = 'MsDbOutputStream', fields = list( .df = "ANY")) | |
| 13 | |
| 14 ############### | |
| 15 # CONSTRUCTOR # | |
| 16 ############### | |
| 17 | |
| 18 MsDbOutputDataFrameStream$methods( initialize = function(keep.unused = FALSE, one.line = FALSE, match.sep = MSDB.DFT.MATCH.SEP, output.fields = msdb.get.dft.output.fields(), multval.field.sep = MSDB.DFT.OUTPUT.MULTIVAL.FIELD.SEP, first.val = FALSE, ascii = FALSE, noapostrophe = FALSE, noplusminus = FALSE, nogreek = FALSE, ...) { | |
| 19 | |
| 20 .df <<- data.frame() | |
| 21 | |
| 22 callSuper(keep.unused = keep.unused, one.line = one.line, match.sep = match.sep, output.fields = output.fields, multval.field.sep = multval.field.sep, first.val = first.val, ascii = ascii, noapostrophe = noapostrophe, noplusminus = noplusminus, nogreek = nogreek, ...) | |
| 23 }) | |
| 24 | |
| 25 ################## | |
| 26 # GET DATA FRAME # | |
| 27 ################## | |
| 28 | |
| 29 MsDbOutputDataFrameStream$methods( getDataFrame = function(...) { | |
| 30 | |
| 31 # Put at least a column name if empty | |
| 32 if (nrow(.self$.df) == 0) | |
| 33 .self$.df[[.self$.output.fields[[MSDB.TAG.MZ]]]] <- numeric() | |
| 34 | |
| 35 return(.self$.df) | |
| 36 }) | |
| 37 | |
| 38 ################# | |
| 39 # MATCHED PEAKS # | |
| 40 ################# | |
| 41 | |
| 42 MsDbOutputDataFrameStream$methods( matchedPeaks = function(mz, rt = NULL, unused = NULL, peaks = NULL) { | |
| 43 | |
| 44 # Set input values | |
| 45 x <- data.frame(mz = mz) | |
| 46 if ( ! is.null(rt)) | |
| 47 x <- cbind(x, data.frame(rt = rt)) | |
| 48 | |
| 49 # Merge input values with matched peaks | |
| 50 if ( ! is.null(peaks)) { | |
| 51 | |
| 52 # No rows | |
| 53 if (nrow(peaks) == 0) | |
| 54 # Add NA values | |
| 55 peaks[1, ] <- NA | |
| 56 | |
| 57 # Process existing rows | |
| 58 else { | |
| 59 # Process multi-value fields | |
| 60 for (c in colnames(peaks)) | |
| 61 if (c %in% MSDB.MULTIVAL.FIELDS) { | |
| 62 | |
| 63 # Keep only first value in multi-value fields | |
| 64 if (.self$.first.val) | |
| 65 peaks[[c]] <- vapply(peaks[[c]], function(s) split.str(s, sep = MSDB.MULTIVAL.FIELD.SEP, unlist = TRUE)[[1]], FUN.VALUE = '') | |
| 66 | |
| 67 # Change separator | |
| 68 else | |
| 69 peaks[[c]] <- vapply(peaks[[c]], function(s) paste0(split.str(s, sep = MSDB.MULTIVAL.FIELD.SEP, unlist = TRUE), collapse = .self$.multval.field.sep), FUN.VALUE = '') | |
| 70 | |
| 71 } | |
| 72 | |
| 73 # Concatenate results in one line | |
| 74 if (.self$.one.line) { | |
| 75 # For each column, concatenate all values in one string. | |
| 76 for (c in seq(peaks)) | |
| 77 peaks[1, c] <- paste0(peaks[[c]], collapse = .self$.match.sep, FUN.VALUE = '') | |
| 78 peaks <- peaks[1, ] # Keep only first line | |
| 79 } | |
| 80 } | |
| 81 | |
| 82 # Merge | |
| 83 x <- cbind(x, peaks, row.names = NULL) | |
| 84 } | |
| 85 | |
| 86 # Rename columns for output | |
| 87 x <- rename.col(x, names(.self$.output.fields), .self$.output.fields) | |
| 88 | |
| 89 # Add unused columns | |
| 90 if ( .self$.keep.unused && ! is.null(unused)) { | |
| 91 x <- cbind(x, unused, row.names = NULL) | |
| 92 } | |
| 93 | |
| 94 # Convert strings to ASCII | |
| 95 if (.self$.ascii || .self$.noapostrophe || .self$.noplusminus || .self$.nogreek) | |
| 96 for (c in seq(x)) | |
| 97 if (class(x[[c]]) == 'character') { | |
| 98 if (.self$.noapostrophe) | |
| 99 x[[c]] <- gsub("'", 'prime', x[[c]], perl = TRUE) | |
| 100 if (.self$.noplusminus) | |
| 101 x[[c]] <- gsub('±', '+-', x[[c]], perl = TRUE) | |
| 102 if (.self$.nogreek) { | |
| 103 x[[c]] <- gsub('α', 'alpha', x[[c]], perl = TRUE) | |
| 104 x[[c]] <- gsub('β', 'beta', x[[c]], perl = TRUE) | |
| 105 x[[c]] <- gsub('γ', 'gamma', x[[c]], perl = TRUE) | |
| 106 x[[c]] <- gsub('δ', 'delta', x[[c]], perl = TRUE) | |
| 107 } | |
| 108 if (.self$.ascii) { | |
| 109 x[[c]] <- gsub('[^\u0001-\u007F]', '_', x[[c]], perl = TRUE) | |
| 110 } | |
| 111 } | |
| 112 | |
| 113 # Add new rows to data frame | |
| 114 .df <<- rbind.fill(.self$.df, x) | |
| 115 }) | |
| 116 | |
| 117 } # end of load safe guard |
