R/LoBrA.R

In ac-hauschild/LoBrA: Modeling longitudinal Breath Data (LOngitudinal BReath Analysis)

#' An S4 class to represent a LoBra Data Object (LDO).
#'
#' @slot name	character
#' @slot dataMatrices	list
#' @slot backgroundMatrices	list
#' @slot peaknames	character
#' @slot times	numeric
#' @slot ids	character
#' @slot labels	factor
#' 
LDO <- setClass("LDO", slots=list(name="character", dataMatrices="list", backgroundMatrices="list", peaknames="character", times="numeric", ids="character", labels="factor"))

#' An S4 class to represent the screening of metabolites in an LDO.
#' @slot ldo	LDO
#' @slot experimentIntercept	list
#' @slot experimentResiduals	list
#' @slot interceptPvalues	matrix
#' @slot residualPvalues	matrix
#' @slot selectedPeaks	matrix"))
#'
LDOscreening<- setClass("LDOscreening", slots=list(ldo="LDO", experimentIntercept="list", experimentResiduals="list",  interceptPvalues="matrix", residualPvalues="matrix", selectedPeaks="matrix"))

#' An S4 class to represent a model selection result based on an LDO.
#' @slot ldo	LDO
#' @slot potentialSlines	numeric
#' @slot splinetype	character
#' @slot qualityMeasure	character
#' @slot modelList	list
#' @slot quality	list
#' @slot breaks	list"))
#'
LDOmodelselection<- setClass("LDOmodelselection", slots=list(ldo="LDO", potentialSlines="numeric", splinetype="character", qualityMeasure="character", modelList="list", quality="list", breaks="list"))

#' An S4 class to represent a gouderman LDO object, that was generated by the generalized gauderman algorithm.
#' @slot name	character
#' @slot dataFrames	list
#' @slot peaknames	character
#' @slot k	numeric
#' @slot times	matrix",newTimeVars	character
#' @slot ids	character
#' @slot labels	factor"
#'
GaudermanLDO <- setClass("GaudermanLDO", slots=list(name="character", dataFrames="list", peaknames="character", k="numeric", times="matrix",newTimeVars="character", ids="character", labels="factor"))

#' An S4 class to represent the result of the linear mixed effect modeling on a gauderman LDO.
#' @slot name	character
#' @slot gaudermanLDO	GaudermanLDO
#' @slot models	list
#' @slot pvalues	matrix
#' @slot correctedpvalues	matrix
#' @slot modelparameter	matrix"))#'
GaudermanModelEvaluation <- setClass("GaudermanModelEvaluation", slots=list(name="character", gaudermanLDO="GaudermanLDO", models="list", pvalues="matrix", correctedpvalues="matrix", modelparameter="matrix"))



#' @title Transformation of a single longitudinal data matrix into LoBrA Data Object.
#' 
#' @description Real signals and background noise originating from experimental settings or random events 
#' @param longData Matrix of longitudinal data containing all components
#' @param name name of the dataset
#' @param id name to identify the experiment id column
#' @param time name to identify the time column
#' @param type name to identify the type column
#' @param class name to identify the class column
#' @param bg indicates whether the data table contains background data
#' @export Use this function 
#' @return LoBra data object
#' @examples \dontrun{
#' } 
#'   data(longDataExample)
#'   id="id"
#'   name="Longitudinal Test Dataset"
#'   time="time"
#'   type="type"
#'   class="class"
#'   bg=FALSE
#'   longData<-longDataExample
#'   ldo<-as.LOBdataset(longDataExample, name, bg=TRUE)
#'   save(ldo,file="data/ldoExample.RData")
#'   

as.LOBdataset<-function(longData, name="", id="id", time="time", type="type", class="class", bg=FALSE){

  peaknames<-colnames(longData)
  peaknames<- peaknames[(peaknames!=id)&(peaknames!=time)&(peaknames!=type)&(peaknames!=class)]
  times=sort(unique(longData[,time]))
  ids=sort(unique(longData[,id]))
  labels=as.factor(sort(unique(longData[,class])))
  bgmatrix<-NA;
  datamatrix<-NA;
  if(bg){
    bgmatrix<-list();
    datamatrix<-list();
    bdata<-longData[longData[,type]=="b",];
    sdata<-longData[longData[,type]=="s",];
    # dim(bdata)
    # dim(sdata)
    # dim(longData)
    peak<-peaknames[1];
    for(peak in peaknames){
      newSampleMatrix <- data.frame(class=factor(sdata[,class], levels=labels), 
                                   id = factor(sdata[,id], levels=ids), 
                                   time=as.numeric(sdata[,time]), 
                                   value=as.numeric(sdata[,peak]))
      newbackgroundMatrix <- data.frame(class=factor(bdata[,class], levels=labels), 
                                   id = factor(bdata[,id], levels=ids), 
                                   time=as.numeric(bdata[,time]), 
                                   value=as.numeric(bdata[,peak]))
      bgmatrix[[peak]]<-newbackgroundMatrix
      datamatrix[[peak]]<-newSampleMatrix
    }
    lobject<-new("LDO", name=name, dataMatrices=datamatrix, backgroundMatrices=bgmatrix, peaknames=peaknames, times=times, ids=ids, labels=as.factor(labels));
  }else{
    datamatrix<-list();
    peak<-peaknames[1]
    for(peak in peaknames){
      newSampleMatrix <- data.frame(class=factor(longData[,class], levels=labels), 
                                    id = factor(longData[,id], levels=ids), 
                                    time=as.numeric(longData[,time]), 
                                    value=as.numeric(longData[,peak]))
      datamatrix[[peak]]<-newSampleMatrix
    }
    lobject<-new("LDO", name=name, dataMatrices=datamatrix, peaknames=peaknames, times=times, ids=ids, labels=as.factor(labels));
  }
  return(lobject);
}


#' lobra functionality
#' 
#' Does this and that
#' @param ldo Longitudinal Data Object
#' @param components component names to select for the new ldo object. Only elements from this list that overlab with the peaknames in the given ldo, are utilized.
#' @return new ldo object only containing the defined components.
#' 
selectComponents=function(ldo, components){
  
  if(length(components)<1){
    stop("The components list has to contain at least one name");
  }
  
  peaknames= ldo@peaknames[ldo@peaknames %in% (components)]
  
  if(length(components)>length(peaknames)){
    warning("Some of the components are not available in this ldo!");
  }
  
  datamatrix = ldo@dataMatrices[peaknames]
  length(ldo@dataMatrices[peaknames])
  length(datamatrix)
  
  lobject<-new("LDO", name=ldo@name, dataMatrices=datamatrix, peaknames=peaknames, times=ldo@times, ids=ldo@ids, labels=ldo@labels);

  return(lobject);
}