R/RDML.R

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

#' R6 class \code{RDML} -- contains methods to read and overview fluorescence 
#' data from RDML v1.1 and v1.2 format files
#' 
#' This class is a container for RDML format data (Lefever et al. 
#' 2009). The data may be further transformed to the appropriate format of the 
#' \code{qpcR} (Ritz et al. 2008, Spiess et al. 2008) and \code{chipPCR} 
#' (Roediger et al. 2015) packages (see \link{RDML.new} for import details). 
#' Real-time PCR Data Markup Language (RDML) is the recommended file format 
#' element in the Minimum Information for Publication of Quantitative Real-Time 
#' PCR Experiments (MIQE) guidelines (Bustin et al. 2009). The inner structure of 
#' imported data faithfully reflects the structure of RDML file v1.2. All data with 
#' the exception for fluorescence values can be represented as \code{data.frame} by 
#' method \code{AsTable}. Such possibility of data representation streamlines 
#' sample filtering (by targets, types, etc.) and serves as request for \code{GetFData}
#' method, which extracts fluorescence data for specified samples.
#' 
#' 
#' @section Fields: Type, structure of data and description of fields can be 
#'   viewed at RDML v1.2 file description. Names of fields are first level of 
#'   XML tree.
#' @section Methods: \describe{
#' \item{new}{creates a new instance of \code{RDML} class object (see \link{RDML.new})} 
#' \item{AsTable}{represent RDML data as \code{data.frame} (see \link{RDML.AsTable})}
#' \item{GetFData}{gets fluorescence data (see \link{RDML.GetFData})}
#' \item{SetFData}{sets fluorescence data (see \link{RDML.SetFData})}
#' \item{Merge}{merges two \code{RDML} to one (see \link{MergeRDMLs})}
#' \item{AsDendrogram}{represents structure of \code{RDML} object as dendrogram(see 
#'   \link{RDML.AsDendrogram})}
#'  }
#'   
#' @author Konstantin A. Blagodatskikh <k.blag@@yandex.ru>, Stefan Roediger 
#'   <stefan.roediger@@b-tu.de>, Michal Burdukiewicz 
#'   <michalburdukiewicz@@gmail.com>
#' @references RDML format http://www.rdml.org/ \code{R6} package 
#'   http://cran.r-project.org/web/packages/R6/index.html
#'   
#'   \code{qpcR} package http://cran.r-project.org/web/packages/qpcR/index.html
#'   
#'   \code{chipPCR} package: 
#'   http://cran.r-project.org/web/packages/chipPCR/index.html
#'   
#'   Roediger S, Burdukiewicz M and Schierack P (2015). chipPCR: an R Package 
#'   to Pre-Process Raw Data of Amplification Curves. \emph{Bioinformatics} first 
#'   published online April 24, 2015 doi:10.1093/bioinformatics/btv205
#'   
#'   Ritz, C., Spiess, A.-N., 2008. qpcR: an R package for sigmoidal model 
#'   selection in quantitative real-time polymerase chain reaction analysis. 
#'   \emph{Bioinformatics} 24, 1549--1551. 
#'   doi:10.1093/bioinformatics/btn227
#'   
#'   Spiess, A.-N., Feig, C., Ritz, C., 2008. Highly accurate sigmoidal fitting 
#'   of real-time PCR data by introducing a parameter for asymmetry. \emph{BMC 
#'   Bioinformatics} 9, 221. doi:10.1186/1471-2105-9-221
#'   
#'   Bustin, S.A., Benes, V., Garson, J.A., Hellemans, J., Huggett, J., Kubista,
#'   M., Mueller, R., Nolan, T., Pfaffl, M.W., Shipley, G.L., Vandesompele, J., 
#'   Wittwer, C.T., 2009. The MIQE guidelines: minimum information for 
#'   publication of quantitative real-time PCR experiments. \emph{Clin. Chem.} 
#'   55, 611--622.  doi:10.1373/clinchem.2008.112797
#'   
#'   Lefever, S., Hellemans, J., Pattyn, F., Przybylski, D.R., Taylor, C., 
#'   Geurts, R., Untergasser, A., Vandesompele, J., RDML consortium, 2009. RDML:
#'   structured language and reporting guidelines for real-time quantitative PCR
#'   data.  \emph{Nucleic Acids Res.} 37, 2065--2069. doi:10.1093/nar/gkp056
#' @keywords Bio--Rad CFX96 file IO LightCycler qPCR RDML StepOne
#' @docType class
#' @format An \code{\link{R6Class}} generator object.
#' @export
#' @importFrom R6 R6Class
#' @import checkmate data.table rlist pipeR stringr xml2
#' @include RDML.types.R
#' @examples 
#' ## EXAMPLE 1:
#' ## internal dataset lc96_bACTXY.rdml (in 'data' directory)
#' ## generated by Roche LightCycler 96. Contains qPCR data
#' ## with four targets and two types.
#' ## Import with default settings.
#' PATH <- path.package("RDML")
#' filename <- paste(PATH, "/extdata/", "lc96_bACTXY.rdml", sep ="")
#' lc96 <- RDML$new(filename)
#' 
#' tab <- lc96$AsTable(name.pattern = paste(sample[[react$sample$id]]$description,
#'                                          react$id$id), 
#'                     quantity = sample[[react$sample$id]]$quantity$value)
#' ## Show dyes names
#' unique(tab$target.dyeId)
#' ## Show types of the samples for dye 'FAM'
#' library(dplyr)
#' unique(filter(tab, target.dyeId == "FAM")$sample.type)
#' 
#' ## Show template quantities for dye 'FAM' type 'std'#' 
#' \dontrun{
#' COPIES <- filter(tab, target.dyeId == "FAM", sample.type == "std")$quantity
#' ## Define calibration curves (type of the samples - 'std').
#' ## No replicates.
#' library(qpcR)
#' CAL <- modlist(lc96$GetFData(filter(tab,
#'                                     target.dyeId == "FAM", 
#'                                     sample.type == "std")),
#'                baseline="lin", basecyc=8:15)
#' ## Define samples to predict (first two samples with the type - 'unkn').
#' PRED <- modlist(lc96$GetFData(filter(tab, 
#'                                     target.dyeId == "FAM", 
#'                                     sample.type == "unkn")),
#'                baseline="lin", basecyc=8:15)
#' ## Conduct quantification.
#' calib(refcurve = CAL, predcurve = PRED, thresh = "cpD2",
#'       dil = COPIES)
#' }
#' \dontrun{
#' ## EXAMPLE 2:
#' ## internal dataset lc96_bACTXY.rdml (in 'data' directory)
#' ## generated by Roche LightCycler 96. Contains qPCR data
#' ## with four targets and two types.
#' ## Import with default settings.
#' library(chipPCR)                        
#' PATH <- path.package("RDML")
#' filename <- paste(PATH, "/extdata/", "lc96_bACTXY.rdml", sep ="")
#' lc96 <- RDML$new(filename)
#' 
#' tab <- lc96$AsTable(name.pattern = paste(sample[[react$sample$id]]$description,
#'                                          react$id$id), 
#'                     quantity = sample[[react$sample$id]]$quantity$value)
#' ## Show targets names
#' unique(tab$target)
#' ## Fetch cycle dependent fluorescence for HEX chanel
#' tmp <- lc96$GetFData(filter(tab, target == "bACT", sample.type == "std"))
#' ## Fetch vector of dillutions 
#' dilution <- filter(tab, target.dyeId == "FAM", sample.type == "std")$quantity
#' 
#' ## Use plotCurves function from the chipPCR package to 
#' ## get an overview of the amplification curves
#' tmp <- as.data.frame(tmp)
#' plotCurves(tmp[,1], tmp[,-1])
#' par(mfrow = c(1,1))
#' ## Use inder function from the chipPCR package to 
#' ## calculate the Cq (second derivative maximum, SDM)
#' SDMout <- sapply(2L:ncol(tmp), function(i) {
#'   SDM <- summary(inder(tmp[, 1], tmp[, i]), print = FALSE)[2]
#' })
#' 
#' ## Use the effcalc function from the chipPCR package and 
#' ## plot the results for the calculation of the amplification
#' ## efficiency analysis.
#' plot(effcalc(dilution, SDMout), CI = TRUE)
#' }
#' \dontrun{
#' ## EXAMPLE 3:
#' ## internal dataset BioRad_qPCR_melt.rdml (in 'data' directory)
#' ## generated by Bio-Rad CFX96. Contains qPCR and melting data.
#' ## Import with custom name pattern.
#' PATH <- path.package("RDML")
#' filename <- paste(PATH, "/extdata/", "BioRad_qPCR_melt.rdml", sep ="")
#' cfx96 <- RDML$new(filename)
#' ## Use plotCurves function from the chipPCR package to 
#' ## get an overview of the amplification curves
#' library(chipPCR)
#' ## Extract all qPCR data 
#' tab <- cfx96$AsTable()
#' cfx96.qPCR <- as.data.frame(cfx96$GetFData(tab))
#' plotCurves(cfx96.qPCR[,1], cfx96.qPCR[,-1], type = "l")
#' 
#' ## Extract all melting data 
#' cfx96.melt <- cfx96$GetFData(tab, dp.type = "mdp")
#' ## Show some generated names for samples.
#' colnames(cfx96.melt)[2L:5]
#' ## Select columns that contain
#' ## samples with dye 'EvaGreen' and have type 'pos'
#' ## using filtering by names.
#' cols <- cfx96$GetFData(filter(tab, grepl("pos_EvaGreen$", fdata.name)),
#'                        dp.type = "mdp")
#' ## Conduct melting curve analysis.
#' library(qpcR)
#' invisible(meltcurve(cols, fluos = 2:ncol(cols),
#'           temps = rep(1, ncol(cols) - 1)))
#' }
RDML <- R6Class("RDML",
                inherit = rdmlBaseType,
                public = list(
                  ###               WARNING
                  ### Some RDML functions are stored as separate files!!!
                  ### Empty functions are added to let roxygen work.                  
                  initialize = function() { },
                  AsTable = function() { },
                  GetFData = function() { },
                  SetFData = function() { },
                  AsDendrogram = function() { },
                  AsXML = function(file.name) {
                    tree <- self$.asXMLnodes("rdml") %>>% 
                      (text ~ 
                         sub('>', ' xmlns="http://www.rdml.org" version="1.2">', text))
                    if (missing(file.name))
                      return(tree)
                    
                    xmlFile <- paste0(tempdir(), "/rdml_data.xml")
                    con <- file(xmlFile, "w")
                    tryCatch({
                      cat(iconv(tree,
                                to = "UTF-8"),
                          file = con, sep = "\n")
                    },
                    finally = {
                      close(con)
                    })
                    
                    zip(file.name, xmlFile)
                    unlink(xmlFile)
                  }
                ),
                private = list(
                  .dateMade = NULL,
                  .dateUpdated = NULL,                  
                  .id = NULL,
                  .experimenter = NULL,
                  .documentation = NULL,
                  .dye = NULL,
                  .sample = NULL,
                  .target = NULL,
                  .thermalCyclingConditions = NULL,
                  .experiment = NULL
                ),
                active = list(
                  dateMade = function(date.made) {
                    if (missing(date.made))
                      return(private$.dateMade)
                    assert(checkDateTime(date.made))
                    private$.dateMade <- date.made
                  },
                  
                  dateUpdated = function(date.updated) {
                    if (missing(date.updated))
                      return(private$.dateUpdated)
                    assert(checkDateTime(date.updated))
                    private$.dateUpdated <- date.updated
                  },
                  
                  id = function(id) {
                    if (missing(id))
                      return(private$.id)                    
                    assertList(id, "rdmlIdType", unique = TRUE)
                    private$.id <- 
                      list.names(id,
                                 .$publisher)
                  },
                  
                  experimenter = function(experimenter) {
                    if (missing(experimenter))
                      return(private$.experimenter)
                    assertList(experimenter, "experimenterType", unique = TRUE)
                    private$.experimenter <- 
                      list.names(experimenter,
                                 .$id$id)
                  },
                  
                  documentation = function(documentation) {
                    if (missing(documentation))
                      return(private$.documentation)
                    assertList(documentation, "documentationType", unique = TRUE)                    
                    private$.documentation <- 
                      list.names(documentation,
                                 .$id$id)
                  },
                  
                  dye = function(dye) {
                    if (missing(dye))
                      return(private$.dye)
                    assertList(dye, "dyeType", unique = TRUE)
                    private$.dye <- 
                      list.names(dye,
                                 .$id$id)
                  },
                  
                  sample = function(sample) {
                    if (missing(sample))
                      return(private$.sample)
                    assertList(sample, "sampleType", unique = TRUE)
                    private$.sample <- 
                      list.names(sample,
                                 .$id$id)
                  },
                  
                  target = function(target) {
                    if (missing(target))
                      return(private$.target)
                    assertList(target, "targetType", unique = TRUE)
                    private$.target <- 
                      list.names(target,
                                 .$id$id)
                  },
                  
                  thermalCyclingConditions = function(thermalCyclingConditions) {
                    if (missing(thermalCyclingConditions))
                      return(private$.thermalCyclingConditions)
                    assertList(thermalCyclingConditions,
                               "thermalCyclingConditionsType",
                               unique = TRUE)
                    private$.thermalCyclingConditions <- 
                      list.names(thermalCyclingConditions,
                                 .$id$id)
                  },
                  
                  experiment = function(experiment) {
                    if (missing(experiment))
                      return(private$.experiment)
                    assertList(experiment, "experimentType", unique = TRUE)
                    private$.experiment <- list.names(experiment,
                                                      .$id$id)
                  }
                  
                )
)

#' Extract data points from \code{RDML} object
#' 
#' Extract data points from \code{RDML} object as.data.frame.
#' 
#' @param x \code{RDML} object.
#' @param i,j indices.
#' @param dp.type Type of fluorescence data (i.e. 'adp' for qPCR or 'mdp' for
#'   melting).
#' 
#' @docType methods
#' @keywords manip
#' @name [.GetFData
#' @rdname extractdatapoints-method
#' @export
"[.RDML" <- function(x, i, j, dp.type = "adp") {
  as.data.frame(x$GetFData(x$AsTable(), dp.type = dp.type))[i, j]
}

utils::globalVariables(c("."))