R/RDML.AsTable.R

In RDML: Importing Real-Time Thermo Cycler (qPCR) Data from RDML Format Files

#' Represents fields of \code{RDML} object as \code{data.frame}
#'
#' Formats particular fields of \code{RDML} object as \code{data.frame}s,
#' filters or passes them to \code{\link{RDML.GetFData}} and \code{RDML.SetFData}
#' functions.
#'
#' By default input this function forms \code{data.frame} with following columns:
#' \describe{ \item{exp.id}{experiment$id} \item{run.id}{run$id}
#' \item{react.id}{react$id}
#' \item{position}{react$position}
#' \item{sample}{react$sample}
#' \item{target}{data$tar$id} \item{target.dyeId}{target[[data$id]]$dyeId}
#' \item{sample.type}{sample[[react$sample]]$type} } You can overload default
#' columns list by parameter \code{.default} but note that columns
#' \preformatted{exp.id, run.id, react.id, target} are necessary for usage
#' \code{AsTable} output as
#' input for \code{GetFData} and \code{SetFData}. \cr Additional columns can be
#' introduced by specifying them at input parameter \code{...} (see Examples).
#' All default and additional columns accession expressions must be named.
#'
#' Experiment, run, react and data to which belongs each fluorescence data vector
#' can be accessed by \code{experiment, run, react, data} (see Examples).
#'
#' Result table does not contain data from experiments with ids starting with '.'!
#'
#' @param .default \code{list} of default columns
#' @param name.pattern expression to form \code{fdata.name} (see Examples)
#' @param add.columns \code{list} of additional columns
#' @param treat.null.as.na if value is \code{NULL} then convert it to \code{NA}. Helps to deal with incomplete records.
#' @param ... additional columns
#' @author Konstantin A. Blagodatskikh <k.blag@@yandex.ru>, Stefan Roediger
#'   <stefan.roediger@@b-tu.de>, Michal Burdukiewicz
#'   <michalburdukiewicz@@gmail.com>
#' @keywords manip
#' @docType methods
#' @name RDML.AsTable
#' @rdname astable-method
#' @include RDML.R
#' @examples
#' \dontrun{
#' ## internal dataset stepone_std.rdml (in 'data' directory)
#' ## generated by Applied Biosystems Step-One. Contains qPCR data.
#' library(chipPCR)
#' PATH <- path.package("RDML")
#' filename <- paste(PATH, "/extdata/", "stepone_std.rdml", sep ="")
#' stepone <- RDML$new(filename)
#' ## Mark fluorescense data which Cq > 30 and add quantities to
#' ## AsTable output.
#' ## Names for fluorescense data will contain sample name and react
#' ## positions
#' tab <- stepone$AsTable(
#'          name.pattern = paste(react$sample$id, react$position),
#'          add.columns = list(cq30 = if(data$cq >= 30) ">=30" else "<30",
#'          quantity = sample[[react$sample$id]]$quantity$value)
#'          )
#' ## Show cq30 and quantities
#' tab[, c("cq30", "quantity")]
#' ## Get fluorescence values for 'std' type samples
#' ## in format ready for ggplot function
#' library(dplyr)
#' fdata <- stepone$GetFData(
#'            filter(tab, sample.type == "std"),
#'            long.table = TRUE)
#' ## Plot fdata with colour by cq30 and shape by quantity
#' library(ggplot2)
#' ggplot(fdata, aes(x = cyc, y = fluor,
#'                   group = fdata.name,
#'                   colour = cq30,
#'                   shape = as.factor(quantity))) +
#'                   geom_line() + geom_point()
#' }
RDML$set("public", "AsTable",
         function(
           .default = list(
             exp.id = experiment$id$id,
             run.id = run$id$id,
             react.id = react$id$id,
             position = react$position,
             sample = react$sample$id,
             target = data$tar$id,
             target.dyeId = target[[data$tar$id]]$dyeId$id,
             sample.type = sample[[react$sample$id]]$type$value,
             adp = !is.null(data$adp),
             mdp = !is.null(data$mdp)),
           name.pattern = paste(
             react$position,
             react$sample$id,
             private$.sample[[react$sample$id]]$type$value,
             data$tar$id,
             sep = "_"),
           add.columns = list(),
           treat.null.as.na = FALSE,
           ...) {
           # create short names
           dateMade <- private$.dateMade
           dateUpdated <- private$.dateUpdated
           id <- private$.id
           experimenter <- private$.experimenter
           documentation <- private$.documentation
           dye <- private$.dye
           sample <- private$.sample
           target <- private$.target
           thermalCyclingConditions <- private$.thermalCyclingConditions
           # dilutions <- private$.dilutions
           # conditions <- private$.conditions
           
           nrows <- 0
           for (experiment in private$.experiment) {
             if (!grepl("^\\.", experiment$id$id)) {
               for (run in experiment$run) {
                 for (react in run$react) {
                   for (data in react$data){
                     nrows <- nrows + 1
                   }
                 }
               }
             }
           }
           out <- data.table(fdata.name = as.character(1:nrows))
           i <- 0L
           for (experiment in private$.experiment) {
             if (!grepl("^\\.", experiment$id$id)) {
               for (run in experiment$run) {
                 for (react in run$react) {
                   for (data in react$data) {
                     i <- i + 1L
                     result <- c(
                       fdata.name = eval(substitute(name.pattern)),
                       eval(substitute(.default)),
                       eval(substitute(add.columns)),
                       eval(substitute(list(...))))
                     list.iter(
                       names(result),
                       name ~ {
                         if (is.null(result[[name]]) && treat.null.as.na) {
                           result[[name]] <- NA
                         }
                         if (!is.null(result[[name]])) {
                           tryCatch(
                             set(out, i, name,
                                 result[[name]]),
                             warning = function(w) {
                               if (str_detect(w, "Coerced")) {
                                 stop(sprintf("Name: %s  Result: %s\n%s",
                                              name, as.character(result[[name]]), w))
                               }
                               warning(w)
                             }
                           )
                         }
                       })
                   }
                 }
               }
             }
           }
           setkey(out, "fdata.name")
           if (length(unique(out$fdata.name)) != length(out$fdata.name)) {
             warning("fdata.name column has duplicates! Try another 'name.pattern'.")
           }
           out
         },
         overwrite = TRUE)