if (!identical(Sys.getenv("NOT_CRAN"), "true")) {
return()
}
library("segregation")
context("test_mutual_local")
test_data <- data.frame(
u = c(rep("a", 4), rep("b", 4)),
g = rep(c(1, 2, 3, 4), 2),
n = c(40, 20, 5, 1, 20, 40, 60, 80)
)
local <- mutual_local(test_data, "u", "g", weight = "n")
local2 <- mutual_local(test_data, "g", "u", weight = "n")
localse <- mutual_local(test_data, "u", "g", weight = "n", se = TRUE, n_bootstrap = 10)
localbase2 <- mutual_local(test_data, "g", "u", weight = "n", base = 2)
test_that("local calculation works", {
expect_equal(sum(local[stat == "p", est]), 1)
expect_equal(sum(local2[local2$stat == "p", est]), 1)
expect_equal(sum(localse[localse$stat == "p", est]), 1)
expect_equal(
sum(local[stat == "p", est] * local[stat == "ls", est]),
sum(local2[local2$stat == "p", est] * local2[local2$stat == "ls", est])
)
expect_equal(
sum(local[stat == "p", est] * local[stat == "ls", est]),
mutual_total(test_data, "u", "g", weight = "n")[stat == "M", est]
)
expect_equal(
sum(localbase2[stat == "p", est] * localbase2[stat == "ls", est]),
mutual_total(test_data, "u", "g", weight = "n", base = 2)[stat == "M", est]
)
})
test_that("return works", {
expect_equal(nrow(local), 8)
expect_equal(ncol(local), 3)
})
test_that("bootstrapping works", {
expect_equal(nrow(localse), 8)
expect_equal(ncol(localse), 6)
})
test_that("bootstrap attributes exists", {
expect_equal(dim(attr(localse, "bootstrap")), c(10 * length(unique(test_data$g)) * 2, 3))
})
test_that("bootstrapping fails when sample size is non-integer", {
test_data <- data.frame(
u = c(rep("a", 4), rep("b", 4)),
g = rep(c(1, 2, 3, 4), 2),
n = c(40, 20, 5, 1, 20, 40, 60, 80.3)
)
expect_error(mutual_local(test_data, "u", "g", weight = "n", se = TRUE))
# rescale
test_data$n2 <- test_data$n / sum(test_data$n) * round(sum(test_data$n))
ret <- mutual_local(test_data, "u", "g", weight = "n2", se = TRUE)
expect_equal(all(ret$se > 0), TRUE)
})
test_that("option wide works", {
nowide <- mutual_local(test_data, "u", "g", weight = "n")
nowide_se <- mutual_local(test_data, "u", "g",
weight = "n",
se = TRUE, n_bootstrap = 10
)
wide <- mutual_local(test_data, "u", "g", weight = "n", wide = TRUE)
wide_se <- mutual_local(test_data, "u", "g",
weight = "n", wide = TRUE,
se = TRUE, n_bootstrap = 10
)
expect_equal(ncol(nowide) + 3, ncol(nowide_se))
expect_equal(nrow(nowide), 8)
expect_equal(nrow(nowide), nrow(nowide_se))
expect_equal(nrow(nowide), nrow(wide) * 2)
expect_equal(ncol(wide) + 6, ncol(wide_se))
expect_equal(nrow(wide), nrow(wide_se))
expect_equal(nowide[stat == "ls", est], wide$ls)
expect_equal(nowide[stat == "p", est], wide$p)
total <- mutual_total(test_data, "u", "g", weight = "n")
expect_equal(
total[stat == "M", est],
sum(nowide[stat == "ls", est] * nowide[stat == "p", "est"])
)
expect_equal(total[stat == "M", est], sum(wide$ls * wide$p))
expect_equal(total[stat == "H", est], sum(wide$ls * wide$p) / entropy(test_data, "u", "n"))
expect_equal(all(nowide_se[["se"]] > 0), TRUE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.