Nothing
context("dbetabinom")
test_that("dbetabinom works", {
skip_on_os(os = "mac", arch = "aarch64")
if (requireNamespace("SuppDists", quietly = TRUE)) {
dbetabinom_suppdists <- function(x, size, mu, rho, log) {
alpha <- mu * (1 - rho) / rho
beta <- (1 - mu) * (1 - rho) / rho
SuppDists::dghyper(x = x, a = -alpha, k = size, N = -alpha - beta, log = log)
}
expect_equal(dbetabinom_suppdists(c(1, 2), 2, 0.5, 0.2, TRUE),
dbetabinom(c(1, 2), 2, 0.5, 0.2, TRUE))
# microbenchmark::microbenchmark(
# dbetabinom_suppdists(1, 2, 0.5, 0.2, TRUE),
# updog::dbetabinom(1, 2, 0.5, 0.2, TRUE),
# VGAM::dbetabinom(1, 2, 0.5, 0.2, TRUE)
# )
}
trash <- dbetabinom(c(1, 2), c(2, 3), 0.5, 0.2, TRUE)
trash <- dbetabinom(c(1, 2), c(2, 3), c(0.5, 0.2), 0.2, TRUE)
trash <- dbetabinom(c(1, 2), c(2, 3), 0.5, c(0.5, 0.2), TRUE)
trash <- dbetabinom(c(1, 2), c(2, 3), c(0.5, 0.2), c(0.5, 0.2), TRUE)
trash <- capture.output(expect_error(dbetabinom(3, 2, 0.5, 0.2, TRUE)))
trash <- capture.output(expect_error(dbetabinom(-1, 2, 0.5, 0.2, TRUE)))
expect_equal(dbetabinom(0, 2, 0, 0.5, FALSE), 1)
expect_equal(dbetabinom(2, 2, 1, 0.5, FALSE), 1)
expect_equal(dbetabinom(2, 2, 0, 0.5, FALSE), 0)
expect_equal(dbetabinom(0, 2, 1, 0.5, FALSE), 0)
expect_equal(dbetabinom(0, 2, 0.2, 1, FALSE), 0.8)
expect_equal(dbetabinom(1, 2, 0.2, 1, FALSE), 0)
expect_equal(dbetabinom(2, 2, 0.2, 1, FALSE), 0.2)
expect_equal(dbinom(x = 1, size = 2, prob = 0.2, log = FALSE),
dbetabinom(1, 2, 0.2, 0, FALSE))
trash <- capture.output(expect_error(dbetabinom(1, 2, -1, 0.3, TRUE)))
trash <- capture.output(expect_error(dbetabinom(1, 2, 0.5, -1, TRUE)))
}
)
test_that("pbetabinom works ok", {
skip_on_os(os = "mac", arch = "aarch64")
if (requireNamespace("SuppDists", quietly = TRUE)) {
pbetabinom_suppdists <- function(q, size, mu, rho, log) {
alpha <- mu * (1 - rho) / rho
beta <- (1 - mu) * (1 - rho) / rho
SuppDists::pghyper(q = q, a = -alpha, k = size, N = -alpha - beta, log = log)
}
expect_equal(pbetabinom_suppdists(c(3, 4), 6, 0.5, 0.2, TRUE),
pbetabinom(c(3, 4), 6, 0.5, 0.2, TRUE))
# microbenchmark::microbenchmark(
# pbetabinom_suppdists(4, 6, 0.5, 0.2, TRUE),
# pbetabinom(4, 6, 0.5, 0.2, TRUE),
# VGAM::pbetabinom(4, 6, 0.5, 0.2, TRUE)
# )
}
trash <- pbetabinom(c(3, 4), c(6, 6), 0.5, 0.2, TRUE)
trash <- pbetabinom(c(3, 4), c(6, 6), c(0.5, 0.7), 0.2, TRUE)
trash <- pbetabinom(c(3, 4), c(6, 6), c(0.5, 0.7), c(0.5, 0.2), TRUE)
trash <- pbetabinom(c(3, 4), c(6, 6), 0.5, c(0.5, 0.2), TRUE)
expect_equal(pbetabinom(-1, 2, 0.5, 0.5, FALSE), 0)
expect_equal(pbetabinom(3, 2, 0.5, 0.5, FALSE), 1)
expect_equal(pbetabinom(0, 2, 0, 0.5, FALSE), 1)
expect_equal(pbetabinom(1, 2, 1, 0.5, FALSE), 0)
}
)
test_that("qbetabinom works", {
skip_on_os(os = "mac", arch = "aarch64")
probseq <- c(0, 0.2, 0.25, 0.4, 0.5, 0.7, 0.7, 1)
rway <- qbinom(p = probseq, size = 2, prob = 0.5)
myway <- rep(NA, length = length(probseq))
for (index in seq_along(probseq)) {
myway[index] <- qbetabinom_double(p = probseq[index], size = 2, mu = 0.5, rho = 0)
}
myway2 <- qbetabinom(p = probseq, size = 2, mu = 0.5, rho = 0)
expect_equal(rway, myway)
expect_equal(rway, myway2)
if (requireNamespace("SuppDists", quietly = TRUE)) {
qbetabinom_suppdists <- function(p, size, mu, rho, log) {
alpha <- mu * (1 - rho) / rho
beta <- (1 - mu) * (1 - rho) / rho
SuppDists::qghyper(p = p, a = -alpha, k = size, N = -alpha - beta, log = log)
}
p0 <- dbetabinom(x = 0, size = 2, mu = 0.5, rho = 0.1, log = FALSE)
pvec <- c(0, p0, p0 + 10^-6, 1 - 10^-6, 1)
suppway <- qbetabinom_suppdists(pvec, 2, 0.5, 0.1, FALSE)
myway <- rep(NA, length = length(pvec))
for (index in seq_along(pvec)) {
myway[index] <- qbetabinom_double(pvec[index], 2, 0.5, 0.1)
}
myway2 <- qbetabinom(p = pvec, size = 2, mu = 0.5, rho = 0.1)
expect_equal(suppway, myway)
expect_equal(suppway, myway2)
# microbenchmark::microbenchmark(
# qbetabinom_suppdists(0.3, 6, 0.5, 0.2, FALSE),
# qbetabinom(0.3, 6, 0.5, 0.2)
# )
}
}
)
test_that("rbetabinom works", {
skip_on_os(os = "mac", arch = "aarch64")
set.seed(1)
rbbout <- c(table(rbetabinom(n = 10000, size = 2, mu = 0.3, rho = 0.1))) / 10000
dbbout <- dbetabinom(x = 0:2, size = 2, mu = 0.3, rho = 0.1, log = FALSE)
expect_equal(dbbout, rbbout, tol = 0.01, check.attributes = FALSE)
}
)
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.