Merge pull request #1446 from cmu-delphi/splitoptions-robust-na

[CTIS] Make `split_options` return list of character missing if all input values are `NA`

Author: krivard

facebook/delphiFacebook/R/variables.R

@@ -14,7 +14,11 @@
 #' @return list of same length, each entry of which is a vector of selected
 #'   options
 split_options <- function(column) {
-  return(strsplit(column, ",", fixed = TRUE))
+  if ( any(!is.na(column)) ) {
+    return(strsplit(column, ",", fixed = TRUE))
+  } else {
+    return(rep(list(NA_character_), length(column)))
+  }
 }
 
 #' Test if a specific selection is selected
@@ -648,16 +652,8 @@ code_vaccines <- function(input_data, wave) {
   if ( all(c("V15a", "V15b") %in% names(input_data)) ) {
     # introduced in Wave 11
     vaccine_barriers <- coalesce(input_data$V15a, input_data$V15b)
-
-    # If the entire column is NA, ifelse() results in a logical vector, not a
-    # character vector, which confuses split_options; since the result should be
-    # NA anyway
-    vaccine_barriers <- as.character(
-      ifelse(vaccine_barriers == "13", NA_character_, vaccine_barriers)
-    )
-    if (any(!is.na(vaccine_barriers))) {
-      vaccine_barriers <- split_options(vaccine_barriers)
-    }
+    vaccine_barriers <- ifelse(vaccine_barriers == "13", NA_character_, vaccine_barriers)
+    vaccine_barriers <- split_options(vaccine_barriers)
 
     input_data$v_vaccine_barrier_eligible <- is_selected(vaccine_barriers, "1")
     input_data$v_vaccine_barrier_no_appointments <- is_selected(vaccine_barriers, "2")
@@ -677,7 +673,7 @@ code_vaccines <- function(input_data, wave) {
   } else if ( all(c("V15c", "V15b") %in% names(input_data)) ) {
     # V15c introduced in Wave 12, replacing V15a with clarified wording.
     vaccine_barriers <- coalesce(input_data$V15c, input_data$V15b)
-    vaccine_barriers <- ifelse(vaccine_barriers == "13", NA, vaccine_barriers)
+    vaccine_barriers <- ifelse(vaccine_barriers == "13", NA_character_, vaccine_barriers)
     vaccine_barriers <- split_options(vaccine_barriers)
 
     input_data$v_vaccine_barrier_eligible <- is_selected(vaccine_barriers, "1")
@@ -769,15 +765,8 @@ code_vaccines <- function(input_data, wave) {
 
   if ( "V15b" %in% names(input_data) ) {
     # introduced in Wave 11
-    # If the entire column is NA, ifelse() results in a logical vector, not a
-    # character vector, which confuses split_options; since the result should be
-    # NA anyway
-    vaccine_barriers <- as.character(
-      ifelse(input_data$V15b == "13", NA, input_data$V15b)
-    )
-    if (any(!is.na(vaccine_barriers))) {
-      vaccine_barriers <- split_options(vaccine_barriers)
-    }
+    vaccine_barriers <- ifelse(input_data$V15b == "13", NA_character_, input_data$V15b)
+    vaccine_barriers <- split_options(vaccine_barriers)
 
     input_data$v_vaccine_barrier_eligible_tried <- is_selected(vaccine_barriers, "1")
     input_data$v_vaccine_barrier_no_appointments_tried <- is_selected(vaccine_barriers, "2")

facebook/delphiFacebook/src/RcppExports.cpp

@@ -5,6 +5,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // is_selected_cpp
 LogicalVector is_selected_cpp(List responses, String target);
 RcppExport SEXP _delphiFacebook_is_selected_cpp(SEXP responsesSEXP, SEXP targetSEXP) {

facebook/delphiFacebook/unit-tests/testthat/test-variables.R

@@ -2,6 +2,22 @@ library(testthat)
 
 context("Testing response coding")
 
+test_that("split_options splits correctly", {
+  expect_equal(split_options(c("1", "", "1,2")),
+               list(c("1"), character(0), c("1", "2")))
+  
+  # Input logical vector
+  expect_equal(split_options(c(NA, NA, NA)),
+               list(NA_character_, NA_character_, NA_character_))
+  
+  # Input character vector
+  expect_equal(split_options(c(NA_character_, NA_character_, NA_character_)),
+               list(NA_character_, NA_character_, NA_character_))
+  
+  expect_equal(split_options(c("", NA_character_, NA)),
+               list(character(0), NA_character_, NA_character_))
+})
+
 test_that("is_selected handles selections correctly", {
   expect_equal(is_selected(split_options(c("1", "", "1,2")), "1"),
                c(TRUE, NA, TRUE))
@@ -18,6 +34,18 @@ test_that("is_selected handles selections correctly", {
   expect_equal(is_selected(split_options(c("4,54", "3,6,2,54", "5,4,45")),
                            "54"),
                c(TRUE, TRUE, FALSE))
+  
+  expect_equal(is_selected(c(NA, NA, NA), "14"),
+               c(NA, NA, NA))
+  
+  expect_equal(is_selected(c(NA_character_, NA_character_, NA_character_), "14"),
+               c(NA, NA, NA))
+  
+  expect_equal(is_selected(list(NA, NA, NA), "14"),
+               c(NA, NA, NA))
+  
+  expect_equal(is_selected(list(NA_character_, NA_character_, NA_character_), "14"),
+               c(NA, NA, NA))
 })
 
 test_that("activities items correctly coded", {