Merge pull request #12 from ucsf-bhhi/v0.6.0

v0.6.0

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bhhitools
 Type: Package
 Title: Tools For BHHI R Users
-Version: 0.5.0
+Version: 0.6.0
 Authors@R: person("Eve", "Perry", email = "eve.perry@ucsf.edu", role = c("aut", "cre"))
 Description: A collection of functions to make R work at BHHI easier.
 Encoding: UTF-8
@@ -12,6 +12,7 @@ Imports:
     fs,
     glue,
     gt,
+    haven,
     httr2,
     keyring,
     purrr,
@@ -23,12 +24,14 @@ Imports:
     srvyr,
     stringr,
     tidyr,
+    usethis,
     withr,
     xml2
 Remotes: 
     eveyp/RStata,
     OuhscBbmc/REDCapR
 Suggests: 
+    labelled,
     testthat (>= 3.0.0),
     survey,
     webshot2

NEWS.md

@@ -1,3 +1,9 @@
+# bhhitools 0.6.0
+
+* Auto-convert variables with Stata value labels from  [haven::labelled] to factors in `bhhi_crosstab()` and `bhhi_gt_crosstab()`.
+
+* Fix bug in auto-opening .qmd file with `bhhi_new_quarto()`.
+
 # bhhitools 0.5.0
 
 * Adds tools for making survey crosstabs easier: `bhhi_crosstab()`, `bhhi_gt_crosstab()`, `bhhi_cascade()`, `bhhi_reshape_crosstab()`, & `bhhi_format_crosstab()`.

R/bhhi_crosstab.R

@@ -25,6 +25,14 @@
 #'
 #' survey_object |>
 #'   bhhi_crosstab(race, gender, pct_direction = "row", vartype = "ci")
+#'
+#' survey_object_labelled <- survey_object |>
+#'   srvyr::mutate(
+#'     srvyr::across(c(gender, race), labelled::to_labelled)
+#'   )
+#'
+#' survey_object_labelled |>
+#'   bhhi_gt_crosstab(race, gender)
 bhhi_crosstab <- function(.data,
                           row_var,
                           col_var,
@@ -33,6 +41,7 @@ bhhi_crosstab <- function(.data,
                           vartype = c("se", "ci", "var", "cv"),
                           level = 0.95,
                           proportion = TRUE,
+                          convert_labelled = TRUE,
                           na.rm = FALSE) {
   groups <- switch(pct_direction,
     "row" = rlang::ensyms(row_var, col_var),
@@ -51,6 +60,16 @@ bhhi_crosstab <- function(.data,
 
   if (missing(vartype)) vartype <- NULL
 
+  if (convert_labelled) {
+    .data <- .data |>
+      srvyr::mutate(
+        srvyr::across(
+          dplyr::where(haven::is.labelled) & c({{ row_var }}, {{ col_var }}),
+          haven::as_factor
+        )
+      )
+  }
+
   .data |>
     srvyr::group_by(!!!groups) |>
     bhhi_cascade(

R/bhhi_gt_crosstab.R

@@ -17,6 +17,8 @@
 #' @param add_n Add cell N to output. Defaults to FALSE.
 #' @param decimals An integer specifing the number of decimal places in the
 #'   results. Defaults to 1.
+#' @param convert_labelled If either `row_var` or `col_var` is
+#'   [`haven::labelled`], automatically convert to factor. Defaults to TRUE.
 #' @param na.rm Drop missing values. Defaults to FALSE.
 #'
 #' @export
@@ -35,6 +37,18 @@
 #'
 #' survey_object |>
 #'   bhhi_gt_crosstab(race, gender)
+#'
+#'  survey_object_labelled <- nhanes |>
+#'   dplyr::rename(gender = RIAGENDR) |>
+#'   dplyr::mutate(
+#'     gender = factor(gender, 1:2, c("Male", "Female")),
+#'     race = factor(race, 1:4, c("Hispanic", "White", "Black", "Other")),
+#'     dplyr::across(c(gender, race), labelled::to_labelled)
+#'   ) |>
+#'   srvyr::as_survey(weights = WTMEC2YR)
+#'
+#'   survey_object_labelled |>
+#'   bhhi_gt_crosstab(race, gender)
 #' ```
 #' \if{html}{\out{
 #' <img src='man_bhhi_gt_crosstab_1.png' class='gt-example-img'>
@@ -57,6 +71,7 @@ bhhi_gt_crosstab <- function(.data,
                              level = 0.95,
                              proportion = TRUE,
                              decimals = 1,
+                             convert_labelled = TRUE,
                              na.rm = FALSE) {
   if (missing(vartype)) vartype <- NULL
 
@@ -69,6 +84,7 @@ bhhi_gt_crosstab <- function(.data,
     vartype = vartype,
     level = level,
     proportion = proportion,
+    convert_labelled = convert_labelled,
     na.rm = na.rm
   ) |>
     bhhi_reshape_crosstab({{ row_var }}, {{ col_var }}) |>

R/bhhi_new_quarto.R

@@ -49,19 +49,13 @@ copy_template <- function(filename, open) {
 
   notify_file_created(filename)
 
-  open_file(open, filename)
+  usethis::edit_file(filename, open = open)
 }
 
 notify_file_created <- function(filename) {
   cli::cli_inform("{.path {filename}} created.")
 }
 
-open_file <- function(open, filename) {
-  if (open & interactive()) {
-    utils::file.edit(filename)
-  }
-}
-
 fetch_quarto_template <- function() {
   cwd <- getwd()
   withr::local_dir(withr::local_tempdir())

tests/testthat/helper.R

@@ -13,12 +13,12 @@ mock_add_quarto_format <- function() {
   )
 }
 
-create_test_svy_tbl <- function() {
+create_test_svy_tbl <- function(with_labelled = FALSE) {
   # specify the current (ie. inside the function environment) so the dataset
   # isn't loaded into the global environment and doesn't persits after the
   # function exits
   data("nhanes", package = "survey", envir = rlang::current_env())
-  nhanes |>
+  test_data <- nhanes |>
     dplyr::rename(gender = RIAGENDR, hi_chol = HI_CHOL) |>
     dplyr::mutate(
       gender = factor(gender, 1:2, c("Male", "Female")),
@@ -27,6 +27,15 @@ create_test_svy_tbl <- function() {
       hi_chol = factor(hi_chol, 0:1, c("No", "Yes"))
     ) |>
     srvyr::as_survey(weights = WTMEC2YR)
+
+  if (with_labelled) {
+    test_data <- test_data |>
+      srvyr::mutate(
+        srvyr::across(dplyr::where(is.factor), labelled::to_labelled)
+      )
+  }
+
+  test_data
 }
 
 expect_gt_output <- function(x, filename) {

tests/testthat/test-bhhi_crosstab.R

@@ -181,3 +181,21 @@ test_that("bhhi_crosstab proportion false works", {
 
   expect_equal_bhhi_srvyr(bhhi_result, srvyr_result)
 })
+
+test_that("convert labelled works", {
+  auto_converted_result <- create_test_svy_tbl(with_labelled = TRUE) |>
+    bhhi_crosstab(race, gender)
+
+  manual_converted_result <- create_test_svy_tbl(with_labelled = TRUE) |>
+    srvyr::mutate(srvyr::across(c(race, gender), haven::as_factor)) |>
+    bhhi_crosstab(race, gender)
+
+  expect_equal(auto_converted_result, manual_converted_result)
+})
+
+test_that("convert labelled errors appropriately", {
+  expect_error(
+    create_test_svy_tbl(with_labelled = TRUE) |>
+      bhhi_crosstab(race, gender, convert_labelled = FALSE)
+  )
+})

tests/testthat/test-bhhi_gt_crosstab.R

@@ -21,3 +21,17 @@ test_that("bhhi_gt_crosstab with 0 decimal works", {
     bhhi_gt_crosstab(race, gender, decimals = 0, vartype = "ci") |>
     expect_gt_output("bhhi_gt_crosstab_0_decimal")
 })
+
+test_that("convert labelled works", {
+  create_test_svy_tbl(with_labelled = TRUE) |>
+    bhhi_gt_crosstab(race, gender) |>
+    expect_gt_output("bhhi_gt_crosstab_convert_labelled")
+})
+
+test_that("convert labelled errors appropriately", {
+  expect_error(
+    create_test_svy_tbl(with_labelled = TRUE) |>
+      bhhi_crosstab(race, gender, convert_labelled = FALSE)
+  )
+})
+