From ee6ae23b1d3c2952c062508d7c402ab1a1d7a439 Mon Sep 17 00:00:00 2001
From: Nicholas Tierney <nicholas.tierney@gmail.com>
Date: Tue, 22 Sep 2020 13:56:35 +1000
Subject: [PATCH 1/3] working towards #272

---
 R/shadow-recode.R                           |  6 +++
 R/utils.R                                   |  2 +
 tests/testthat/test-shadow-expand-relevel.R | 49 +++++++++++++++++++++
 3 files changed, 57 insertions(+)
 create mode 100644 tests/testthat/test-shadow-expand-relevel.R

diff --git a/R/shadow-recode.R b/R/shadow-recode.R
index 437bc2df..b2742fe9 100644
--- a/R/shadow-recode.R
+++ b/R/shadow-recode.R
@@ -38,10 +38,16 @@ 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
+  if (new_level %nin% levels(.var)) {
+
   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..2be0c152 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -201,3 +201,5 @@ 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)))
 }
+
+`%nin%` <- purrr::negate(`%in%`)
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))
+
+})
+
+
+

From eecd11ba42d619182defc4c0800bd7ad085cc236 Mon Sep 17 00:00:00 2001
From: Nicholas Tierney <nicholas.tierney@gmail.com>
Date: Tue, 22 Sep 2020 14:07:26 +1000
Subject: [PATCH 2/3] bump news

---
 NEWS.md | 1 +
 1 file changed, 1 insertion(+)

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"
 

From 14392bcb1430cb6a7bb2fc209f83d3c45361ce9c Mon Sep 17 00:00:00 2001
From: Nicholas Tierney <nicholas.tierney@gmail.com>
Date: Wed, 23 Sep 2020 08:58:51 +1000
Subject: [PATCH 3/3] avoid vector issue in if() statement by ensuring the
 statement is either TRUE or FALSE.

---
 R/shadow-recode.R | 3 ++-
 R/utils.R         | 4 +++-
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/R/shadow-recode.R b/R/shadow-recode.R
index b2742fe9..13fbb073 100644
--- a/R/shadow-recode.R
+++ b/R/shadow-recode.R
@@ -40,7 +40,8 @@ shadow_expand_relevel <- function(.var, suffix){
 
   # add check to see if relevelling needs to happen, in case the levels
   # are the same
-  if (new_level %nin% levels(.var)) {
+  any_new_levels <- new_level %in% levels(.var) %>% are_any_false()
+  if (any_new_levels) {
 
   new_var <- forcats::fct_relevel(new_var,
                                       levels(.var),
diff --git a/R/utils.R b/R/utils.R
index 2be0c152..fa3abf35 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -202,4 +202,6 @@ any_row_shade <- function(x){
   apply(data.frame(x), MARGIN = 1, FUN = function(x) any(grepl("^NA|^NA_", x)))
 }
 
-`%nin%` <- purrr::negate(`%in%`)
+vecIsFALSE <- Vectorize(isFALSE)
+
+are_any_false <- function(x, ...) any(vecIsFALSE(x), ...)