Nothing
context("Assignment and probability functions")
test_that("use of randomizr works", {
design <- declare_model(
classrooms = add_level(10),
individuals = add_level(20, female = rbinom(N, 1, 0.5))
) + NULL
dat <- draw_data(design)
assgn1 <- declare_assignment(Z = complete_ra(N = N, m = 10))
expect_equal(sum(assgn1(dat)$Z), 10)
})
test_that("legacy warnings", {
expect_error(declare_assignment(m = 50), "Z = conduct_ra\\(N = N, m = 50\\)")
expect_error(declare_assignment(m = 50, assignment_variable = "D"), "D = conduct_ra\\(N = N, m = 50\\)")
expect_silent(declare_assignment(Z = complete_ra(N = N, m = 20)))
})
test_that("no assignment arguments", {
des1 <- declare_model(N = 10) + declare_assignment(legacy = FALSE)
des2 <- declare_model(N = 10) + declare_assignment(legacy = TRUE)
expect_equal(dim(draw_data(des1)), c(10, 1))
expect_equal(dim(draw_data(des2)), c(10, 3))
})
context("Assignment and probability functions")
test_that("randomizr works through declare_assignment", {
df <- data.frame(ID = 1:10, blocks = rep(c("A", "B"), 5, 5))
f_1 <- declare_assignment(legacy = TRUE)
expect_equal(sum(f_1(df)$Z), 5)
f_1 <- declare_assignment(m = 5, legacy = TRUE)
expect_equal(sum(f_1(df)$Z), 5)
f_1 <- declare_assignment(num_arms = 2, legacy = TRUE)
expect_equal(sum(f_1(df)$Z == "T1"), 5)
f_1 <- declare_assignment(num_arms = 3, legacy = TRUE)
expect_true(all(table(f_1(df)$Z) >= 3))
f_1 <- declare_assignment(blocks = blocks, legacy = TRUE)
expect_true(all.equal(
unclass(xtabs(~blocks + Z, f_1(df))),
matrix(c(3, 2, 3, 2), 2, 2), # slight bug in the blocks above with rep(AB,5,5) => ABABA x 2
check.attributes = FALSE
))
# what about inside a function?
new_fun <- function(num_arms) {
f_1 <- declare_assignment(num_arms = num_arms, legacy = TRUE)
f_1(df)
}
new_fun(3)
})
test_that("test assignment and probability functions", {
# here we want at least one of each ideo st there aren't random failures in assn 9
draw_ideo <- function(N) {
x <- c("Liberal", "Moderate", "Conservative")
x <- c(x, sample(x, size=N-3, prob=c(.2,.3,.5), replace=TRUE))
sample(x)
}
population <- declare_model(
villages = add_level(
N = 100, elevation = rnorm(N),
high_elevation = as.numeric(elevation > 0)
),
individuals = add_level(N = 10, noise = rnorm(N)),
individuals = modify_level(ideo_3 = draw_ideo(N), by = "villages")
)
sampling <- declare_sampling(n = 10, clusters = villages, legacy = TRUE)
potential_outcomes <- declare_potential_outcomes(
formula = Y ~ 5 + .5 * (Z == 1) + .9 * (Z == 2) + .2 * Z * elevation + noise,
conditions = c(0, 1, 2),
assignment_variable = "Z"
)
smp_draw <- population() |> sampling() |> potential_outcomes()
# population() |> sampling() |> potential_outcomes()
expect_assignment <- function(assn) {
df <- assn(smp_draw)
expect_true("Z_cond_prob" %in% names(df))
}
# Complete Random Assignment assignments
assignment_0 <- declare_assignment(legacy = TRUE) |> expect_assignment() # blug
assignment_1 <- declare_assignment(legacy = TRUE, conditions = c(0, 1)) |> expect_assignment()
assignment_2 <- declare_assignment(legacy = TRUE, m = 60, conditions = c(0, 1)) |> expect_assignment()
assignment_3 <- declare_assignment(legacy = TRUE, m_each = c(20, 30, 50)) |> expect_assignment()
assignment_4 <- declare_assignment(legacy = TRUE, m_each = c(20, 80), conditions = c(0, 1)) |> expect_assignment()
assignment_5 <- declare_assignment(legacy = TRUE, prob_each = c(.2, .3, .5)) |> expect_assignment()
# Blocked assignments
assignment_6 <- declare_assignment(legacy = TRUE, blocks = ideo_3) |> expect_assignment()
assignment_7 <- declare_assignment(legacy = TRUE, blocks = ideo_3, prob_each = c(.3, .6, .1)) |> expect_assignment()
assignment_8 <- declare_assignment(legacy = TRUE, blocks = ideo_3, conditions = c(0, 1)) |> expect_assignment()
assignment_9 <- declare_assignment(
blocks = ideo_3,
conditions = c(0, 1),
block_m = c(10, 10, 10),
legacy = TRUE
) |> expect_assignment()
# Clustered assignments
assignment_10 <- declare_assignment(legacy = TRUE, clusters = villages) |> expect_assignment()
assignment_11 <- declare_assignment(legacy = TRUE, clusters = villages, conditions = c(0, 1)) |> expect_assignment()
assignment_12 <- declare_assignment(legacy = TRUE, clusters = villages, prob_each = c(.1, .3, .6)) |> expect_assignment()
# Blocked and Clustered assignments
assignment_13 <- declare_assignment(
clusters = villages,
blocks = high_elevation,
legacy = TRUE
) |> expect_assignment()
assignment_14 <- declare_assignment(
clusters = villages,
blocks = high_elevation, conditions = c(0, 1),
legacy = TRUE
) |> expect_assignment()
assignment_15 <- declare_assignment(
clusters = villages,
blocks = high_elevation, prob_each = c(.1, .3, .6),
legacy = TRUE
) |> expect_assignment()
})
test_that("more than 1 assignment", {
assn <- declare_assignment(legacy = TRUE, assignment_variable = P:Q)
out <- assn(sleep)
expect_equal(colnames(out), c("extra", "group", "ID", "P", "P_cond_prob", "Q", "Q_cond_prob"))
})
test_that("declare_assignment expected failures via validation fn", {
expect_true(is.function(declare_assignment(legacy = TRUE)))
expect_error(declare_assignment(legacy = TRUE, blocks = "character"), "blocks")
expect_error(declare_assignment(legacy = TRUE, clusters = "character"), "clusters")
expect_error(declare_assignment(legacy = TRUE, assignment_variable = NULL), "assignment_variable")
})
test_that("can append probabilities matrix", {
pop <- declare_model(N = 10)
assignment <- declare_assignment(legacy = TRUE, m = 5, append_probabilities_matrix = TRUE)
dat <- draw_data(pop + assignment)
expect_true("Z_prob_0" %in% colnames(dat))
})
test_that("can append probabiliies matrix with blocks from data", {
design <-
declare_model(block = add_level(N = 3,
tau = c(3, 1, 0)),
indiv = add_level(N = 50,
e = rnorm(N, 0, 5))) +
declare_assignment(blocks = block, block_prob = c(.5, .7, .9),
append_probabilities_matrix = TRUE, legacy = TRUE)
df <- draw_data(design)
expect_named(df, c("block", "tau", "indiv", "e", "Z_prob_0", "Z_prob_1", "Z",
"Z_cond_prob"))
})
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.