R/dataClass.R

In dlill/dMod2ndsens: Dynamic Modeling and Parameter Estimation in ODE Models

## Class "datalist" and its constructor ------------------------------------------


#' Split a data.frame into a datalist
#' 
#' @param dataframe data.frame 
#' @param split.by character vector. A unique identifier is generated by \link{interaction}
#' of the columns corresponding to \code{split.by}.
#' @return Object of class \link{datalist}
#' @export
#' @examples 
#' mydata <- data.frame(name = "A", time = 0, value = c(0, 1), sigma = .1, condition = 1:2)
#' as.datalist(mydata)
as.datalist <- function(x, ...) {
  UseMethod("as.datalist", x)
}

#' @export
#' @rdname as.datalist
as.datalist.data.frame <- function(dataframe, split.by = "condition") {
  
  #remaining.names <- setdiff(names(dataframe), split.by)
  remaining.names <- c("name", "time", "value", "sigma")
  
  conditions <- lapply(split.by, function(n) dataframe[, n])
  splits <- do.call(interaction, c(conditions, list(sep = "_")))
  
  dataframe <- cbind(splits, dataframe[, remaining.names])
  
  out <- lapply(unique(splits), function(s) subset(dataframe, dataframe[, 1] == s)[, -1])
  names(out) <- as.character(unique(splits))
  
  as.datalist(out)
  
}

#' @export
#' @param mylist list of data.frames
#' @param names optional names vector, otherwise names are taken from \code{mylist}
#' @rdname as.datalist
as.datalist.list <- function(mylist, names = NULL) {

  ## Check properties
  if (is.null(names)) mynames <- names(mylist) else mynames <- names
  is.data.frame <- sapply(mylist, class) == "data.frame"
  if (!all(is.data.frame)) stop("list of data.frame expected")

  correct.names <- c("name", "time", "value", "sigma")
  have.correct.names <- sapply(mylist, function(d) all(correct.names %in% colnames(d)))
  if (all(have.correct.names)) {
    mylist <- lapply(mylist, function(d) d[, correct.names])
  } else {
    stop(paste("data.frames should have names:", correct.names, collapse = " "))    
  }


  if (length(mynames) != length(mylist)) stop("names argument has wrong length")

  ## Prepare output
  names(mylist) <- mynames
  class(mylist) <- c("datalist", "list")

  return(mylist)

}


## Methods for class datalist ---------------------------------------

#' @export
print.datalist <- function(datalist, ...) {
  for(n in names(datalist)) {
    cat(n, ":\n", sep = "")
    print(datalist[[n]])
  }
}

#' @export
"[.datalist" <- function(x, ...) {
  out <- unclass(x)[...]
  class(out) <- c("datalist", "list")
  return(out)
}

#' Plot a list data points
#' 
#' @param data Named list of data.frames as being used in \link{res}, i.e. with columns \code{name}, \code{time}, 
#' \code{value} and \code{sigma}.
#' @param ... Further arguments going to \code{subset}. 
#' @param scales The scales argument of \code{facet_wrap} or \code{facet_grid}, i.e. \code{"free"}, \code{"fixed"}, 
#' \code{"free_x"} or \code{"free_y"}
#' @param facet Either \code{"wrap"} or \code{"grid"}
#' @details The data.frame being plotted has columns \code{time}, \code{value}, \code{sigma},
#' \code{name} and \code{condition}.
#'  
#' 
#' @return A plot object of class \code{ggplot}.
#' @export
plot.datalist <- function (data, ..., scales = "free", facet = "wrap") {
  
  plotCombined(prediction = NULL, data = data, ..., scales = scales, facet = facet)
  
}