R/extract_tibble.R

In REDCapTidieR: Extract 'REDCap' Databases into Tidy 'Tibble's

#' @title
#' Extract a single data tibble from a REDCapTidieR supertibble
#'
#' @description
#' Take a supertibble generated with `read_redcap()`
#' and return one of its data tibbles.
#'
#' @details
#' This function makes it easy to extract a single instrument's data from a
#' REDCapTidieR supertibble.
#'
#' @returns A `tibble`.
#'
#' @param supertbl A supertibble generated by `read_redcap()`. Required.
#' @param tbl The `redcap_form_name` of the data tibble to extract. Required.
#'
#' @examples
#' superheroes_supertbl
#'
#' extract_tibble(superheroes_supertbl, "heroes_information")
#'
#' @export

extract_tibble <- function(supertbl,
                           tbl) {
  # Check args ----
  check_arg_is_supertbl(supertbl, req_cols = "redcap_data")
  check_arg_is_character(tbl, len = 1, any.missing = FALSE)

  # Extract specified table ----
  out <- extract_tibbles(supertbl, tbls = all_of(tbl))[[1]]

  out
}


#' Extract data tibbles from a REDCapTidieR supertibble into a list
#'
#' @description
#' Take a supertibble generated with `read_redcap()`
#' and return a named list of data tibbles.
#'
#' @details
#' This function makes it easy to extract a multiple instrument's data from a
#' REDCapTidieR supertibble into a named list. Specifying instruments using
#' tidyselect helper functions such as `dplyr::starts_with()`
#' or `dplyr::ends_with()` is supported.
#'
#' @returns A named list of `tibble`s
#'
#' @param supertbl A supertibble generated by `read_redcap()`. Required.
#' @param tbls A vector of `form_name`s or a tidyselect helper. Default is
#' `dplyr::everything()`.
#'
#' @examples
#' superheroes_supertbl
#'
#' # Extract all data tibbles
#' extract_tibbles(superheroes_supertbl)
#'
#' # Only extract data tibbles starting with "heroes"
#' extract_tibbles(superheroes_supertbl, starts_with("heroes"))
#'
#' @export

extract_tibbles <- function(supertbl,
                            tbls = everything()) {
  check_arg_is_supertbl(supertbl, req_cols = "redcap_data")

  # Extract specified table ----
  # Pass tbls as an expression for enquosure
  tbls <- enquo(tbls)

  out <- supertbl %>%
    select("redcap_form_name", "redcap_data") %>%
    pivot_wider(
      names_from = "redcap_form_name",
      values_from = "redcap_data"
    )

  out <- out[eval_select(tbls, data = out)]

  out %>%
    map(.f = ~ pluck(.)[[1]])
}