diff --git a/facebook/delphiFacebook/R/variables.R b/facebook/delphiFacebook/R/variables.R index 6baa4ca39..b4461776d 100644 --- a/facebook/delphiFacebook/R/variables.R +++ b/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") diff --git a/facebook/delphiFacebook/src/RcppExports.cpp b/facebook/delphiFacebook/src/RcppExports.cpp index b0056334a..e21e5728d 100644 --- a/facebook/delphiFacebook/src/RcppExports.cpp +++ b/facebook/delphiFacebook/src/RcppExports.cpp @@ -5,6 +5,11 @@ using namespace Rcpp; +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& 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) { diff --git a/facebook/delphiFacebook/unit-tests/testthat/test-variables.R b/facebook/delphiFacebook/unit-tests/testthat/test-variables.R index bd894f49f..741a109a6 100644 --- a/facebook/delphiFacebook/unit-tests/testthat/test-variables.R +++ b/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", {