R/load_data.R

In stefvanbuuren/donorloader: Loads Donor Data from Package or Database

#' Load donor data
#'
#' This function provides access to the built-in longitudinal data sets.
#' @param con A database connection. The default `con = NULL` reads the
#' data from the internal data of the `donorloader` package.
#' @param dnr Name of a dataset, e.g. `"smocc"` or
#' `"lollypop"`
#' @param element In case that `dnr` is a `list`, this is the
#' name of the list element, e.g. `"child"` or `"time"`.
#' If `NULL` the function returns the full object.
#' @param ids Vector with values from the `id` field in the data specified in
#' the argument `dnr`. May be a vector. If omitted, all rows are returned.
#' Setting `ids` to `0L` or `NULL` returns a table with zero rows.
#' @return A list, data frame or tibble with rows selected according to `ids`.
#' @examples
#' # first three ids from smocc
#' d <- load_data(dnr = "smocc", element = "child", ids = 10001:10003)
#' @export
load_data <- function(con = NULL, dnr, element = NULL, ids = NULL) {
  if (dnr %in% c("lollypop.preterm", "lollypop.term")) {
    warning("donorloader 0.20.0 removed lollypop.preterm and lollypop.term. Now using lollypop.")
    dnr <- "lollypop"
  }
  if (dnr %in% c("lollypop.preterm_bs", "lollypop.term_bs")) {
    warning("donorloader 0.20.0 removed lollypop.preterm_bs and lollypop.term_bs. Now using lollypop_bs.")
    dnr <- "lollypop_bs"
  }
  if (is.null(con)) {
    data <- get_internal_data(dnr, element)
    if (missing(ids)) {
      return(data)
    }
    if (is_tibble(data)) {
      if (!length(ids)) {
        return(head(data, n = 0L))
      }
      if (ids[1L] == 0L) {
        return(head(data, n = 0L))
      }
      return(data %>% dplyr::filter(.data$id %in% ids))
    }
    # assume it's a list, and apply selection to each element
    if (is.null(ids) || ids[1L] == 0L) {
      return(lapply(data, head, n = 0L))
    }
    for (i in 1:length(data)) {
      data[[i]] <- data[[i]] %>% dplyr::filter(.data$id %in% ids)
    }
    return(data)
  }

  # read from database connection con
  warning("Database access not implemented.")
  tibble()
}