Draft list_select, check_arg_is_list

- tests
- pkgdown
- documentation

NAMESPACE

@@ -12,6 +12,7 @@ export(fmt_strip_html)
 export(fmt_strip_trailing_colon)
 export(fmt_strip_trailing_punct)
 export(fmt_strip_whitespace)
+export(list_select)
 export(make_labelled)
 export(read_redcap)
 export(write_redcap_xlsx)
@@ -26,6 +27,7 @@ importFrom(checkmate,assert_data_frame)
 importFrom(checkmate,check_character)
 importFrom(checkmate,check_choice)
 importFrom(checkmate,check_environment)
+importFrom(checkmate,check_list)
 importFrom(checkmate,check_logical)
 importFrom(checkmate,expect_character)
 importFrom(checkmate,expect_double)

R/REDCapTidieR-package.R

@@ -2,7 +2,7 @@
 #' @aliases REDCapTidieR-package
 #' @importFrom checkmate assert_character assert_data_frame check_character
 #' check_choice check_environment check_logical expect_character expect_double
-#' expect_factor expect_logical
+#' expect_factor expect_logical check_list
 #' @importFrom cli cli_abort cli_fmt cli_text cli_vec cli_warn qty
 #' @importFrom dplyr %>% across bind_rows case_when filter group_by if_any if_else
 #' left_join mutate pull recode relocate rename right_join row_number rowwise

R/checks.R

@@ -427,6 +427,9 @@ check_arg_is_logical <- wrap_checkmate(check_logical)
 #' @rdname checkmate
 check_arg_choices <- wrap_checkmate(check_choice)
 
+#' @rdname checkmate
+check_arg_is_list <- wrap_checkmate(check_list)
+
 #' @rdname checkmate
 check_arg_is_valid_token <- function(x,
                                      arg = caller_arg(x),

R/combine_checkboxes.R

@@ -45,7 +45,6 @@ combine_checkboxes <- function(supertbl,
                                values_fill = NA,
                                raw_or_label = "label",
                                keep = TRUE) {
-
   # Check args ---
   check_arg_is_supertbl(supertbl, req_cols = c("redcap_data", "redcap_metadata"))
   check_arg_is_character(tbl, len = 1, any.missing = FALSE)

R/list_select.R

@@ -0,0 +1,30 @@
+#' @title Select Data Tibbles from Named Lists
+#'
+#' @description
+#' `list_select()` helps users easily select data tibbles from named lists. This
+#' function uses <[`tidy-select`][tidyr_tidy_select]> syntax to specify which elements to extract.
+#'
+#' @details
+#' `list_select()` can be used with any named list, and is typically used in
+#' conjunction with [extract_tibbles()] to pull out named data tibbles of interest
+#' for analytic operations.
+#'
+#' @param list A named list from which data tibbles are to be selected. Required.
+#' @param tbls <[`tidy-select`][tidyr_tidy_select]> The names of the data tibbles to select from the list. Required.
+#'
+#' @return A named list of selected data tibbles.
+#'
+#' @examples
+#' my_list <- extract_tibbles(superheroes_supertbl)
+#'
+#' list_select(my_list, starts_with("hero"))
+#'
+#' @export
+
+list_select <- function(list, tbls = everything()) {
+  # Check args ----
+  check_arg_is_list(list)
+
+  tbls <- eval_select(data = list, expr = enquo(tbls))
+  list[tbls]
+}

pkgdown/_pkgdown.yml

@@ -69,6 +69,7 @@ reference:
     Helpful functions for supertibble data analytics.
   contents:
   - combine_checkboxes
+  - list_select
 - title: "Data"
   contents:
   - superheroes_supertbl

tests/testthat/test-list_select.R

@@ -0,0 +1,25 @@
+test_that("list_select works", {
+  db <- extract_tibbles(supertbl = superheroes_supertbl)
+
+  # list_select returns everything by default
+  everything_out <- list_select(db)
+
+  expect_equal(db, everything_out)
+
+  # list_select works with tidyselect valid specification
+  selected_out <- list_select(db, starts_with("hero"))
+
+  expect_equal(db[1], selected_out)
+
+  # list_select returns empty tidyselect
+  empty_out <- list_select(db, starts_with("empty"))
+
+  # Create an empty named list
+  empty_named_list <- list()
+  names(empty_named_list) <- character(0)
+
+  expect_equal(empty_out, empty_named_list)
+
+  # list_select errors for hard-coded strings that don't exist
+  expect_error(list_select(db, c("heroes_information", "fake_tbl")))
+})