df <- tibble::tribble(
~wind, ~temp,
-99, 45,
68, NA,
72, 25
)
test_that("recode_shadow errors when regular dataframe passed",{
expect_snapshot(
error = TRUE,
recode_shadow(df, temp = .where(wind == -99 ~ "bananas"))
)
})
dfs <- nabular(df)
dfs_special <- dfs %>%
recode_shadow(temp = .where(wind == -99 ~ "bananas"))
test_that("special missings levels are updated", {
expect_equal(levels(dfs_special$wind_NA),
c("!NA", "NA", "NA_bananas"))
expect_equal(levels(dfs_special$temp_NA),
c("!NA", "NA", "NA_bananas"))
})
test_that("special missings are put in the right place", {
expect_equal(as.character(dfs_special$wind_NA),
c("!NA", "!NA", "!NA"))
expect_equal(as.character(dfs_special$temp_NA),
c("NA_bananas", "NA", "!NA"))
})
df_many_recode <- df %>%
nabular() %>%
recode_shadow(temp = .where(temp == 25 ~ "broken_machine")) %>%
recode_shadow(wind = .where(wind == -99 ~ "broken_temp"))
new_shade_levels <- c("!NA", "NA", "NA_broken_machine", "NA_broken_temp")
test_that("special missings levels are updated for many recodes", {
skip_on_cran()
expect_equal(levels(df_many_recode$wind_NA),
new_shade_levels)
expect_equal(levels(df_many_recode$temp_NA),
new_shade_levels)
})
test_that("special missings are put in the right place for many recodes", {
skip_on_cran()
expect_equal(as.character(df_many_recode$wind_NA),
c("NA_broken_temp", "!NA", "!NA"))
expect_equal(as.character(df_many_recode$temp_NA),
c("!NA", "NA", "NA_broken_machine"))
})
where_one <- .where(temp == 25 ~ "broken_machine")
where_two <- .where(temp == 25 ~ "broken_machine",
wind == 26 ~ "broken_wind")
where_three <- .where(temp == 25 ~ "broken_machine",
wind == 26 ~ "broken_wind",
arbitrary == "values" ~ "are_possible")
test_that(".where captures the right number of expressions", {
expect_equal(sum(lengths(where_one)), 2)
expect_equal(sum(lengths(where_two)), 4)
expect_equal(sum(lengths(where_three)), 6)
})
test_that(".where captures the expressions into condition and suffix", {
expect_equal(names(where_one), c("condition", "suffix"))
expect_equal(names(where_two), c("condition", "suffix"))
expect_equal(names(where_three), c("condition", "suffix"))
})
test_that(".where is a list", {
expect_type(where_one, "list")
expect_type(where_two, "list")
expect_type(where_three, "list")
})
test_that(".where is a list", {
expect_type(where_one, "list")
expect_type(where_two, "list")
expect_type(where_three, "list")
})
class_nest <- function(obj, slot) {
purrr::pluck(obj, slot) %>% purrr::map_chr(class)
}
test_that(".where returns call class", {
expect_true(class_nest(where_one, "condition") == "call")
expect_true(all(class_nest(where_two, "condition") == "call"))
expect_true(all(class_nest(where_three, "condition") == "call"))
})
test_that(".where returns chr class", {
expect_true(class_nest(where_one, "suffix") == "character")
expect_true(all(class_nest(where_two, "suffix") == "character"))
expect_true(all(class_nest(where_three, "suffix") == "character"))
})
df_mult_where <- df %>%
nabular() %>%
recode_shadow(temp = .where(temp == 25 ~ "broken_machine",
wind == 68 ~ "wat"))
test_that("recode_shadow returns right values if .where is called many times", {
expect_equal(as.character(df_mult_where$wind_NA),
c("!NA", "!NA", "!NA"))
expect_equal(as.character(df_mult_where$temp_NA),
c("!NA", "NA_wat", "NA_broken_machine"))
})
test_that("recode_shadow returns right levels if .where is called many times", {
expect_equal(levels(df_mult_where$wind_NA),
c("!NA", "NA", "NA_broken_machine", "NA_wat"))
expect_equal(levels(df_mult_where$temp_NA),
c("!NA", "NA", "NA_broken_machine", "NA_wat"))
})
aq_recoded <- airquality %>%
nabular() %>%
recode_shadow(Ozone = .where(Wind <= 5 ~ "broken_machine"))
aq_grouped_recoded <- airquality %>%
nabular() %>%
dplyr::group_by(Month) %>%
recode_shadow(Ozone = .where(Wind <= 5 ~ "broken_machine"))
test_that("special missings are the same for grouped and ungrouped data", {
expect_equal(as.character(aq_grouped_recoded$Ozone_NA),
as.character(aq_recoded$Ozone_NA))
})
test_that("special missings class is maintained for grouped and ungrouped data", {
skip_on_cran()
skip_on_ci()
# FIXME failing test?
expect_equal(class(aq_grouped_recoded$Ozone_NA),
class(aq_recoded$Ozone_NA))
expect_true(is_shade(aq_grouped_recoded$Ozone_NA))
expect_true(is_shade(aq_recoded$Ozone_NA))
})
test_that("shadow_expand_relevel returns shadows inside a data.frame", {
expect_type(dfs_special$wind, "double")
expect_type(dfs_special$temp, "double")
expect_s3_class(dfs_special$wind_NA, "shade")
expect_s3_class(dfs_special$temp_NA, "shade")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.