Nothing
r <- c(-.5, .2, .5)
set.seed(8675309)
# distfuncs ----
test_that("distfuncs", {
func <- distfuncs("norm")
expect_equal(func$q, qnorm)
expect_equal(func$r, rnorm)
func <- distfuncs("pois")
expect_equal(func$q, qpois)
expect_equal(func$r, rpois)
func <- distfuncs("truncnorm")
expect_equal(func$q, truncnorm::qtruncnorm)
expect_equal(func$r, truncnorm::rtruncnorm)
## with :: notation
func <- distfuncs("stats::norm")
expect_equal(func$q, qnorm)
expect_equal(func$r, rnorm)
expect_error( distfuncs("normz") )
expect_error( distfuncs("nopkg::norm") )
})
# fh_bounds ----
test_that("fh_bounds", {
set.seed(8675309)
b <- fh_bounds("norm", "unif")
expect_equal(b$max, 0.977, tol = .005)
expect_equal(b$min, -0.977, tol = .005)
b <- fh_bounds("norm", "unif",
list(mean = 100, sd = 10),
list(min = 0, max = 100))
expect_equal(b$max, 0.977, tol = .005)
expect_equal(b$min, -0.977, tol = .005)
b <- fh_bounds("pois", "truncnorm",
list(lambda = 1),
list(a = 0, b = 10, mean = 5, sd = 2))
expect_equal(b$max, 0.913, tol = .005)
expect_equal(b$min, -0.914, tol = .005)
b <- fh_bounds("pois", "binom",
list(lambda = 3),
list(size = 1, prob = 0.5))
expect_equal(b$max, 0.776, tol = .005)
expect_equal(b$min, -0.776, tol = .005)
})
test_that("fh_bounds variation check", {
skip("long checking function")
x <- lapply(1:50, function(x) {
fh_bounds("pois", "binom",
list(lambda = 3),
list(size = 1, prob = 0.5))
})
hist(sapply(x, `[[`, "min"))
})
# convert_r ----
set.seed(8675309)
test_that("convert_r warnings", {
# warnings and errors
expect_warning(convert_r(.95, "binom", params1 = list(size = 1, prob = 0.5)))
expect_error(convert_r(0.3, "nope1"))
expect_error(convert_r(0.3, "unif", "nope2"))
})
## norm:norm ----
test_that("convert_r norm:norm", {
x <- sapply(r, convert_r)
#plot(r, x)
expect_true(all(abs(r - x) < .005))
# norm with changed SD
x <- sapply(r, convert_r,
params1 = list(mean = 10, sd = 5),
params2 = list(mean = -10, sd = 2))
#plot(r, x)
expect_true(all(abs(r - x) < .005))
})
## norm:binom ----
test_that("convert_r norm:binom", {
size <- 2
prob <- .5
x <- sapply(r, convert_r, dist2 = "binom",
params2 = list(size = size, prob = prob))
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
check_dist$X2 <- norm2binom(check_dist$X2,
size = size,
prob = prob,
mu = 0, sd = 1)
cor(check_dist$X1, check_dist$X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## binom:binom
test_that("convert_r binom:binom", {
size1 <- 2
prob1 <- .5
size2 <- 3
prob2 <- 1/3
x <- sapply(r, convert_r,
dist1 = "binom", dist2 = "binom",
params1 = list(size = size1, prob = prob1),
params2 = list(size = size2, prob = prob2))
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- norm2binom(check_dist$X1,
size = size1,
prob = prob1,
mu = 0, sd = 1)
X2 <- norm2binom(check_dist$X2,
size = size2,
prob = prob2,
mu = 0, sd = 1)
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## norm:pois ----
test_that("convert_r norm:pois", {
lambda <- 1.5
x <- sapply(r, convert_r, dist2 = "pois",
params2 = list(lambda = lambda))
#plot(r, x)
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- check_dist$X1
X2 <- norm2pois(check_dist$X2,
lambda = lambda,
mu = 0, sd = 1)
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## pois:pois ----
test_that("convert_r pois:pois", {
lambda1 <- 1
lambda2 <- 2
x <- sapply(r, convert_r,
dist1 = "pois",
dist2 = "pois",
params1 = list(lambda = lambda1),
params2 = list(lambda = lambda2))
#plot(r, x)
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- norm2pois(check_dist$X1,
lambda = lambda1,
mu = 0, sd = 1)
X2 <- norm2pois(check_dist$X2,
lambda = lambda2,
mu = 0, sd = 1)
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## norm:beta ----
test_that("convert_r norm:beta", {
shape1 <- 1.1
shape2 <- 1.2
x <- sapply(r, convert_r, dist2 = "beta",
params2 = list(shape1 = shape1,
shape2 = shape2))
#plot(r, x)
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- check_dist$X1
X2 <- norm2beta(check_dist$X2,
shape1 = shape1,
shape2 = shape2,
mu = 0, sd = 1)
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## norm:gamma ----
test_that("convert_r norm:gamma", {
shape <- 1.5
rate <- 1.2
x <- sapply(r, convert_r, dist2 = "gamma",
params2 = list(shape = shape,
rate = rate))
#plot(r, x)
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- check_dist$X1
X2 <- norm2gamma(check_dist$X2,
shape = shape,
rate = rate,
mu = 0, sd = 1)
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
## norm:likert ----
test_that("convert_r norm:likert", {
prob <- c(10, 20, 40, 20, 10)
labels <- LETTERS[1:length(prob)]
x <- sapply(r, convert_r, dist2 = "likert",
params2 = list(prob = prob,
labels = labels))
#plot(r, x)
recovered_r <- sapply(x, function(adj_r) {
check_dist <- rnorm_multi(1e5, 2, r = adj_r, empirical = TRUE)
X1 <- check_dist$X1
X2 <- norm2likert(check_dist$X2,
prob = prob,
labels = labels,
mu = 0, sd = 1) %>% as.numeric()
cor(X1, X2)
})
diff <- abs(recovered_r - r)
expect_true(all(diff < .01))
})
# rmulti ----
test_that("rmulti errors", {
expect_error( rmulti(n = "A") )
expect_error( rmulti(dist = c(A = "norm")) )
expect_error( rmulti(dist = c("norm", "blue")) )
# error when params don't match dist
badparams <- list(A = c(mu = 10, stdev = 3),
B = c(meh = 0, so = 1))
expect_error( rmulti(params = badparams) )
})
test_that("rmulti default", {
set.seed(8675309)
x <- rmulti()
expect_equal(nrow(x), 100L)
expect_equal(names(x), c("A", "B"))
expect_true(abs(mean(x$A)) < .1)
expect_true(abs(1 - sd(x$A)) < .1)
set.seed(8675309)
x2 <- rmulti()
expect_identical(x$A, x2$A)
expect_identical(x$B, x2$B)
y <- rmulti()
expect_false(all(x$A == y$A))
# no names, but right order
set.seed(8675309)
nonameparams <- list(A = c(100, 10),
B = c(0, 1))
x <- rmulti(params = nonameparams)
expect_true(mean(x$A) > 80)
expect_true(sd(x$A) > 5)
expect_true(sd(x$A) < 15)
expect_true(mean(x$B) < 5)
})
test_that("rmulti", {
r <- seq(.1, .6, .1)
dist <- c(A = "norm", B = "binom", C = "beta", D = "pois")
params <- list(A = list(mean = 10, sd = 5),
B = list(size = 6, prob = 0.5),
C = list(shape1 = 2, shape2 = 2),
D = list(lambda = 10))
x <- rmulti(n = 100,
dist = dist,
params = params,
r = r,
empirical = TRUE)
recov_r <- cor(x)
diff <- abs(recov_r[upper.tri(recov_r)] - r)
expect_true(all(diff < .05))
})
test_that("rmulti impossible r", {
dist <- c(A = "pois", B = "binom")
params <- list(A = list(lambda = 3),
B = list(size = 1, prob = 0.5))
r = 0.8
expect_error({
x <- rmulti(n = 100,
dist = dist,
params = params,
r = r,
empirical = 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.