Revert "convert logical fields"

This reverts commit 2ce4fbf.

.github/workflows/R-CMD-check.yaml

@@ -30,7 +30,6 @@ jobs:
       REDCAPTIDIER_DAG_API: ${{ secrets.REDCAPTIDIER_DAG_API }}
       REDCAPTIDIER_LONGITUDINAL_DAG_API: ${{ secrets.REDCAPTIDIER_LONGITUDINAL_DAG_API }}
       REDCAPTIDIER_MIXED_STRUCTURE_API: ${{ secrets.REDCAPTIDIER_MIXED_STRUCTURE_API }}
-      REDCAPTIDIER_MDC_API: ${{ secrets.REDCAPTIDIER_MDC_API }}
     steps:
       - name: Update Ubuntu, Install cURL Headers, add Libraries
         run: |

.github/workflows/test-coverage.yaml

@@ -29,7 +29,6 @@ jobs:
       REDCAPTIDIER_LARGE_SPARSE_API: ${{ secrets.REDCAPTIDIER_LARGE_SPARSE_API }}
       REDCAPTIDIER_DAG_API: ${{ secrets.REDCAPTIDIER_DAG_API }}
       REDCAPTIDIER_LONGITUDINAL_DAG_API: ${{ secrets.REDCAPTIDIER_LONGITUDINAL_DAG_API }}
-      REDCAPTIDIER_MDC_API: ${{ secrets.REDCAPTIDIER_MDC_API }}
     steps:
       - name: Update Ubuntu, Install cURL Headers, add Libraries
         run: |

NAMESPACE

@@ -67,7 +67,6 @@ importFrom(purrr,map2)
 importFrom(purrr,map_int)
 importFrom(purrr,map_lgl)
 importFrom(purrr,pluck)
-importFrom(purrr,pmap)
 importFrom(purrr,pmap_chr)
 importFrom(purrr,some)
 importFrom(readr,parse_character)

R/REDCapTidieR-package.R

@@ -9,7 +9,7 @@
 #' @importFrom formattable percent
 #' @importFrom lobstr obj_size
 #' @importFrom lubridate is.difftime is.period is.POSIXt is.Date
-#' @importFrom purrr compose map map2 map_int map_lgl pluck pmap_chr some pmap
+#' @importFrom purrr compose map map2 map_int map_lgl pluck pmap_chr some
 #' @importFrom REDCapR redcap_arm_export redcap_event_instruments redcap_instruments
 #' redcap_metadata_read redcap_read_oneshot sanitize_token
 #' @importFrom rlang .data !!! abort as_closure caller_arg caller_env catch_cnd

R/checks.R

@@ -577,53 +577,3 @@ check_file_exists <- function(file, overwrite, call = caller_env()) {
     )
   }
 }
-
-#' @title
-#' Parse logical field and warn if parsing errors occurred
-#'
-#' @param x vector to parse
-#' @param field_name field name for warning message
-#' @param field_type field type for warning message
-#' @param call call for warning message
-#'
-#' @keywords internal
-check_field_is_logical <- function(x, field_name, field_type, call = caller_env()) {
-  # If already logical just return it
-  if (is.logical(x)) {
-    return(x)
-  }
-  # Parse
-  cnd <- NULL
-  out <- withCallingHandlers(
-    {
-      parse_logical(as.character(x))
-    },
-    warning = function(w) {
-      cnd <<- w
-      cnd_muffle(w)
-    }
-  )
-  # Check for parsing failures and warn if found
-  probs <- attr(out, "problems")
-  if (!is.null(probs)) {
-    values <- unique(probs$actual)
-    msg <- c(
-      `!` = "{.code {field_name}} is type '{field_type}' but contains non-logical values: {values}",
-      i = "These were converted to {.code NA} resulting in possible data loss",
-      i = "Does your REDCap project utilize missing data codes?"
-    )
-    cli_warn(
-      msg,
-      class = c("field_is_logical", "REDCapTidieR_cond"),
-      call = call,
-      field = field_name,
-      field_type = field_type,
-      problems = probs
-    )
-    attr(out, "problems") <- NULL
-  } else if (!is.null(cnd)) {
-    # If there was some other warning we didn't mean to catch it, so re-raise
-    cli_warn(cnd)
-  }
-  out
-}

R/utils.R

@@ -397,12 +397,11 @@ update_data_col_names <- function(db_data, db_metadata) {
 #'
 #' @param db_data A REDCap database object
 #' @param db_metadata A REDCap metadata object
-#' @param call call for conditions
 #' @inheritParams read_redcap
 #'
 #' @keywords internal
 
-multi_choice_to_labels <- function(db_data, db_metadata, raw_or_label = "label", call = caller_env()) {
+multi_choice_to_labels <- function(db_data, db_metadata, raw_or_label = "label") {
   if (raw_or_label == "label") {
     label_handler <- apply_labs_factor
   } else if (raw_or_label == "haven") {
@@ -427,7 +426,12 @@ multi_choice_to_labels <- function(db_data, db_metadata, raw_or_label = "label",
 
   # Logical Column Handling ----
   # Handle columns where we change 0/1 to FALSE/TRUE (logical)
-  db_data <- parse_logical_cols(db_data, db_metadata, call = call)
+  logical_cols <- db_metadata %>%
+    filter(.data$field_type %in% c("yesno", "truefalse", "checkbox")) %>%
+    pull(.data$field_name_updated)
+
+  db_data <- db_data %>%
+    mutate(across(.cols = all_of(logical_cols), as.logical))
 
   for (i in seq_len(nrow(db_metadata))) {
     # Extract metadata field name and database corresponding column name
@@ -479,35 +483,6 @@ multi_choice_to_labels <- function(db_data, db_metadata, raw_or_label = "label",
   db_data
 }
 
-#' @title
-#' Convert yesno, truefalse, and checkbox fields to logical
-#'
-#' @inheritParams multi_choice_to_labels
-#'
-#' @keywords internal
-parse_logical_cols <- function(db_data, db_metadata, call = caller_env()) {
-  logical_cols <- db_metadata %>%
-    filter(.data$field_type %in% c("yesno", "truefalse", "checkbox"))
-
-  if (nrow(logical_cols) == 0) {
-    return(db_data)
-  }
-
-  out <- db_data
-
-  out[logical_cols$field_name_updated] <- pmap(
-    list(
-      select(db_data, all_of(logical_cols$field_name_updated)),
-      logical_cols$field_name_updated,
-      logical_cols$field_type
-    ),
-    check_field_is_logical,
-    call = call
-  )
-
-  out
-}
-
 #' @title
 #' Apply factor labels to a vector
 #'

tests/testthat/test-checks.R

@@ -223,12 +223,3 @@ test_that("check_file_exists works", {
     )
   })
 })
-
-test_that("check_field_is_logical works", {
-  expect_equal(check_field_is_logical(c(TRUE, FALSE, NA), "", ""), c(TRUE, FALSE, NA))
-  expect_equal(check_field_is_logical(c(1, 0, NA), "", ""), c(TRUE, FALSE, NA))
-  expect_warning(check_field_is_logical(c(1, 0, "x"), "", ""), class = "field_is_logical")
-  check_field_is_logical(c(1, 0, "x"), "", "") |>
-    suppressWarnings() |>
-    expect_equal(c(TRUE, FALSE, NA))
-})

tests/testthat/test-read_redcap.R

@@ -621,16 +621,3 @@ test_that("read_redcap fails if DAG or survey columns are explicitly requested b
     class = "nonexistent_arg_requested"
   )
 })
-
-test_that("read_redcap handles missing data codes", {
-  out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_MDC_API")) |>
-    suppressWarnings(classes = c("field_is_logical")) |>
-    extract_tibble("form_1")
-
-  # logicals are not converted to NA
-  expect_type(out$yesno, "logical")
-  expect_true(!all(is.na(out$yesno)))
-  # categoricals remove missing data codes
-  expect_factor(out$dropdown)
-  expect_true(all(is.na(out$dropdown) | out$dropdown != "UNK"))
-})

tests/testthat/test-utils.R

@@ -178,36 +178,6 @@ test_that("parse_labels works", {
     expect_equal(FALSE)
 })
 
-test_that("parse_logical_cols", {
-  db_data <- tibble::tibble(
-    record_id = 1:3,
-    yes_no = c("1", "0", "UNK"),
-    other_field = letters[1:3]
-  )
-  db_metadata <- tibble::tibble(
-    field_name_updated = c("yes_no", "other_field"),
-    field_type = c("yesno", "text")
-  )
-
-  out <- parse_logical_cols(db_data, db_metadata) |>
-    suppressWarnings(classes = "field_is_logical")
-
-  expect_equal(dim(out), dim(db_data))
-  expect_equal(out$record_id, db_data$record_id)
-  expect_equal(out$yes_no, c(TRUE, FALSE, NA))
-  expect_equal(out$other_field, db_data$other_field)
-
-  db_data <- tibble::tibble(
-    record_id = 1:3,
-    other_field = letters[1:3]
-  )
-  db_metadata <- tibble::tibble(
-    field_name_updated = "other_field",
-    field_type = "text"
-  )
-  expect_equal(parse_logical_cols(db_data, db_metadata), db_data)
-})
-
 test_that("link_arms works", {
   skip_on_cran()