Nothing
test_that("check the proportion_ci_*() functions work", {
# setting vectors to test
x_dbl <- c(NA, mtcars$vs)
x_lgl <- as.numeric(x_dbl)
x_rsp <- c(TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)
x_true <- rep_len(TRUE, 32)
x_false <- rep_len(FALSE, 32)
# check Wilson CIs ----------------------------------------------------------
expect_snapshot(
wilson_dbl <- proportion_ci_wilson(x_dbl, conf.level = 0.9, correct = FALSE)
)
expect_equal(
wilson_dbl[c("conf.low", "conf.high")],
prop.test(x = sum(x_dbl, na.rm = TRUE), n = 32, conf.level = 0.9, correct = FALSE)$conf.int |>
as.list() |>
setNames(c("conf.low", "conf.high"))
)
expect_snapshot(
wilsoncc_dbl <- proportion_ci_wilson(x_dbl, conf.level = 0.9, correct = TRUE)
)
expect_equal(
wilsoncc_dbl[c("conf.low", "conf.high")],
prop.test(x = sum(x_dbl, na.rm = TRUE), n = 32, conf.level = 0.9, correct = TRUE)$conf.int |>
as.list() |>
setNames(c("conf.low", "conf.high"))
)
expect_snapshot(
wilson_lgl <- proportion_ci_wilson(x_lgl, conf.level = 0.9, correct = FALSE)
)
expect_equal(
wilson_lgl[c("conf.low", "conf.high")],
prop.test(x = sum(x_lgl, na.rm = TRUE), n = 32, conf.level = 0.9, correct = FALSE)$conf.int |>
as.list() |>
setNames(c("conf.low", "conf.high"))
)
expect_snapshot(proportion_ci_wilson(x_rsp, conf.level = 0.9))
expect_snapshot(proportion_ci_wilson(x_true))
expect_snapshot(proportion_ci_wilson(x_false))
# check Wald CIs ----------------------------------------------------------
expect_snapshot(
wald_dbl <- proportion_ci_wald(x_dbl, conf.level = 0.9, correct = FALSE)
)
expect_snapshot(
waldcc_dbl <- proportion_ci_wald(x_dbl, conf.level = 0.9, correct = TRUE)
)
expect_snapshot(
wald_lgl <- proportion_ci_wald(x_lgl, conf.level = 0.9, correct = FALSE)
)
expect_snapshot(proportion_ci_wald(x_rsp, conf.level = 0.95, correct = TRUE))
expect_snapshot(proportion_ci_wald(x_true))
expect_snapshot(proportion_ci_wald(x_false))
# check Clopper-Pearson CIs ----------------------------------------------------------
expect_snapshot(
clopper_pearson_dbl <- proportion_ci_clopper_pearson(x_dbl, conf.level = 0.9)
)
expect_equal(
clopper_pearson_dbl[c("conf.low", "conf.high")],
binom.test(x = sum(x_dbl, na.rm = TRUE), n = 32, conf.level = 0.9)$conf.int |>
as.list() |>
setNames(c("conf.low", "conf.high"))
)
expect_snapshot(
clopper_pearson_lgl <- proportion_ci_clopper_pearson(x_lgl, conf.level = 0.9)
)
expect_equal(
clopper_pearson_lgl[c("conf.low", "conf.high")],
binom.test(x = sum(x_lgl, na.rm = TRUE), n = 32, conf.level = 0.9)$conf.int |>
as.list() |>
setNames(c("conf.low", "conf.high"))
)
expect_snapshot(proportion_ci_clopper_pearson(x_rsp, conf.level = 0.95))
expect_snapshot(proportion_ci_wilson(x_true))
expect_snapshot(proportion_ci_wilson(x_false))
# check Agresti-Coull CIs ----------------------------------------------------------
expect_snapshot(
agresti_coull_dbl <- proportion_ci_agresti_coull(x_dbl, conf.level = 0.9)
)
expect_snapshot(
agresti_coull_lgl <- proportion_ci_agresti_coull(x_lgl, conf.level = 0.9)
)
expect_snapshot(proportion_ci_agresti_coull(x_rsp, conf.level = 0.95))
expect_snapshot(proportion_ci_agresti_coull(x_true))
expect_snapshot(proportion_ci_agresti_coull(x_false))
# check Jeffreys CIs ----------------------------------------------------------
expect_snapshot(
jeffreys_dbl <- proportion_ci_jeffreys(x_dbl, conf.level = 0.9)
)
expect_snapshot(
jeffreys_lgl <- proportion_ci_jeffreys(x_lgl, conf.level = 0.9)
)
expect_snapshot(proportion_ci_jeffreys(x_rsp, conf.level = 0.95))
expect_snapshot(proportion_ci_jeffreys(x_true))
expect_snapshot(proportion_ci_jeffreys(x_false))
# error messaging ------------------------------------------------------------
expect_snapshot(
proportion_ci_wilson(x_dbl, conf.level = c(0.9, 0.9)),
error = TRUE
)
expect_snapshot(
error = TRUE,
proportion_ci_wilson(mtcars$cyl)
)
})
test_that("check the proportion_ci_strat_wilson() function works", {
# check Stratified Wilson CIs ----------------------------------------------------------
withr::local_seed(1)
rsp <- c(
sample(c(TRUE, FALSE), size = 40, prob = c(3 / 4, 1 / 4), replace = TRUE),
sample(c(TRUE, FALSE), size = 40, prob = c(1 / 2, 1 / 2), replace = TRUE)
)
grp <- factor(rep(c("A", "B"), each = 40), levels = c("B", "A"))
strata_data <- data.frame(
"f1" = sample(c("a", "b"), 80, TRUE),
"f2" = sample(c("x", "y", "z"), 80, TRUE),
stringsAsFactors = TRUE
)
strata <- interaction(strata_data)
weights <- 1:6 / sum(1:6)
expect_snapshot(
proportion_ci_strat_wilson(x = rsp, strata = strata, weights = weights, correct = FALSE)
)
expect_snapshot(
proportion_ci_strat_wilson(x = rsp, strata = strata, weights = weights, correct = TRUE)
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata, weights = weights)
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata)
)
# checking error messaging
expect_snapshot(
proportion_ci_strat_wilson(x = rep_len(TRUE, length(rsp)), strata = strata, weights = weights),
error = TRUE
)
expect_snapshot(
proportion_ci_strat_wilson(x = rep_len(FALSE, length(rsp)), strata = strata, weights = weights),
error = TRUE
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata, max.iterations = -1),
error = TRUE
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata, max.iterations = -1),
error = TRUE
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata, weights = weights + pi / 5),
error = TRUE
)
expect_snapshot(
proportion_ci_strat_wilson(x = as.numeric(rsp), strata = strata, weights = weights + pi),
error = TRUE
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.