diff --git a/NEWS.md b/NEWS.md index 0eed57a8..4e48e56f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ complete values added up to more than the number of rows in the data. This was due to the remainder not being used when calculating the number of complete values. +- Fix bug in `recode_shadow()` (#272) where adding the same special missing value in two subsequent operations fails. # naniar 0.6.0 (2020/08/17) "Spur of the lamp post" diff --git a/R/shadow-recode.R b/R/shadow-recode.R index 437bc2df..13fbb073 100644 --- a/R/shadow-recode.R +++ b/R/shadow-recode.R @@ -38,10 +38,17 @@ shadow_expand_relevel <- function(.var, suffix){ levels(.var), new_level) + # add check to see if relevelling needs to happen, in case the levels + # are the same + any_new_levels <- new_level %in% levels(.var) %>% are_any_false() + if (any_new_levels) { + new_var <- forcats::fct_relevel(new_var, levels(.var), new_level) + } + return(new_var) } diff --git a/R/utils.R b/R/utils.R index 8c4b47fe..fa3abf35 100644 --- a/R/utils.R +++ b/R/utils.R @@ -201,3 +201,7 @@ coerce_fct_na_explicit <- function(x){ any_row_shade <- function(x){ apply(data.frame(x), MARGIN = 1, FUN = function(x) any(grepl("^NA|^NA_", x))) } + +vecIsFALSE <- Vectorize(isFALSE) + +are_any_false <- function(x, ...) any(vecIsFALSE(x), ...) diff --git a/tests/testthat/test-shadow-expand-relevel.R b/tests/testthat/test-shadow-expand-relevel.R new file mode 100644 index 00000000..a7d212a9 --- /dev/null +++ b/tests/testthat/test-shadow-expand-relevel.R @@ -0,0 +1,49 @@ +context("shadow_expand_relevel") + +library(dplyr) + +df_sh <- data.frame(Q1 = c("yes", "no", "no", NA), + Q2 = c("a", NA, NA, NA), + Q3 = c(1, NA, NA, 4)) %>% + mutate(Q1 = factor(Q1)) %>% + mutate(Q2 = factor(Q2)) %>% + nabular() + +test_that(desc = "when levels are repeated, they don't fail", { + + df_sh_recode_q2 <- df_sh %>% + recode_shadow(Q2 = .where(Q1 %in% "no" ~ "skip")) + + expect_equal(levels(df_sh_recode_q2$Q2_NA), + c("!NA", + "NA", + "NA_skip")) + + df_sh_recode_q3 <- df_sh_recode_q2 %>% + recode_shadow(Q3 = .where(Q1 %in% "no" ~ "skip")) + + expect_equal(levels(df_sh_recode_q3$Q3_NA), + c("!NA", + "NA", + "NA_skip")) + + q1_na_fct_vals <- df_sh_recode_q3$Q1_NA %>% + table(., useNA = "always") %>% + as.numeric() + + q2_na_fct_vals <- df_sh_recode_q3$Q2_NA %>% + table(., useNA = "always") %>% + as.numeric() + + q3_na_fct_vals <- df_sh_recode_q3$Q3_NA %>% + table(., useNA = "always") %>% + as.numeric() + + expect_equal(q1_na_fct_vals, c(3, 1, 0, 0)) + expect_equal(q2_na_fct_vals, c(1, 1, 2, 0)) + expect_equal(q3_na_fct_vals, c(2, 0, 2, 0)) + +}) + + +