Skip to content

Commit

Permalink
working towards #272
Browse files Browse the repository at this point in the history
  • Loading branch information
njtierney committed Sep 22, 2020
1 parent d60a437 commit ee6ae23
Show file tree
Hide file tree
Showing 3 changed files with 57 additions and 0 deletions.
6 changes: 6 additions & 0 deletions R/shadow-recode.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

}
Expand Down
2 changes: 2 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -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%`)
49 changes: 49 additions & 0 deletions tests/testthat/test-shadow-expand-relevel.R
Original file line number Diff line number Diff line change
@@ -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))

})



0 comments on commit ee6ae23

Please sign in to comment.