From 626e55e41c78320dafb177c4124e561fb3af06ec Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Mon, 3 Jan 2022 18:57:44 -0500 Subject: [PATCH 1/3] split_options returns NA if all input is NA --- facebook/delphiFacebook/R/variables.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/facebook/delphiFacebook/R/variables.R b/facebook/delphiFacebook/R/variables.R index 6baa4ca39..12e26441d 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(NA_character_, length(column))) + } } #' Test if a specific selection is selected From e82b934cecd667f2ffc1416ff468a4166002fcdb Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Mon, 3 Jan 2022 19:19:15 -0600 Subject: [PATCH 2/3] remove na-checking logic --- facebook/delphiFacebook/R/variables.R | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/facebook/delphiFacebook/R/variables.R b/facebook/delphiFacebook/R/variables.R index 12e26441d..b82217254 100644 --- a/facebook/delphiFacebook/R/variables.R +++ b/facebook/delphiFacebook/R/variables.R @@ -653,15 +653,10 @@ code_vaccines <- function(input_data, wave) { # 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 <- 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") @@ -773,15 +768,10 @@ 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 <- 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") From 2214a30691fd4056c70e6cb0ae0c0345f41b45ab Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Wed, 5 Jan 2022 16:26:14 -0500 Subject: [PATCH 3/3] make split_options input and output more regular --- facebook/delphiFacebook/R/variables.R | 13 +++------ facebook/delphiFacebook/src/RcppExports.cpp | 5 ++++ .../unit-tests/testthat/test-variables.R | 28 +++++++++++++++++++ 3 files changed, 37 insertions(+), 9 deletions(-) diff --git a/facebook/delphiFacebook/R/variables.R b/facebook/delphiFacebook/R/variables.R index b82217254..b4461776d 100644 --- a/facebook/delphiFacebook/R/variables.R +++ b/facebook/delphiFacebook/R/variables.R @@ -17,7 +17,7 @@ split_options <- function(column) { if ( any(!is.na(column)) ) { return(strsplit(column, ",", fixed = TRUE)) } else { - return(rep(NA_character_, length(column))) + return(rep(list(NA_character_), length(column))) } } @@ -652,10 +652,7 @@ 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) - - vaccine_barriers <- as.character( - ifelse(vaccine_barriers == "13", NA_character_, 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") @@ -676,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") @@ -768,9 +765,7 @@ code_vaccines <- function(input_data, wave) { if ( "V15b" %in% names(input_data) ) { # introduced in Wave 11 - vaccine_barriers <- as.character( - ifelse(input_data$V15b == "13", NA, input_data$V15b) - ) + 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") 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", {