Nothing
# genCatFormula ----
roundTrip <- function(args) {
as.numeric(.splitFormula(do.call(genCatFormula, as.list(args))))
}
test_that("probabilities stay the same after genCatFormula", {
skip_on_cran()
forall(gen_cat_probs, function(ps) {
rt <- roundTrip(ps)
expect_equal(sum(ps), 1)
expect_equal(length(ps), length(rt))
expect_equal(ps, rt)
})
})
test_that("cat probs are generated correctly", {
skip_on_cran()
forall(gen.element(2:15), function(n) {
rt <- roundTrip(list(n = n))
expect_equal(length(rt), n)
expect_equal(sum(rt), 1)
})
forall(gen.unif(0, 1), function(p) {
expect_equal(sum(roundTrip(p)), sum(p, 1 - p))
expect_length(roundTrip(p), 2)
})
})
test_that("probabilities (vector) are adjusted as documented.", {
skip_on_cran()
forall(gen.and_then(gen.element(2:15), function(n) {
gen_n_norm_Probs(n)
}), function(p) {
over <- p / .9
under <- p / 1.1
expect_warning(genCatFormula(over), "will be normalized")
expect_warning(genCatFormula(under), "Adding category")
expect_equal(sum(roundTrip(over)), 1)
expect_equal(sum(roundTrip(under)), 1)
expect_length(roundTrip(over), length(over))
expect_length(roundTrip(under), length(under) + 1)
})
})
test_that("genCatFormula throws errors.", {
skip_on_cran()
expect_error(genCatFormula(), "Need to specify")
expect_error(genCatFormula(1, 2, 3, n = 5), "or n, not both")
expect_error(genCatFormula(1.1), "must be less than 1")
expect_error(genCatFormula(n = 1.1), "must be a whole number")
expect_error(genCatFormula(n = -3), "Negative values")
})
# betaGetShapes ----
test_that("betaGetShapes throws errors.", {
skip_on_cran()
expect_error(betaGetShapes(1, 12), class = "simstudy::valueError")
expect_error(betaGetShapes(.5, -5), class = "simstudy::valueError")
})
test_that("betaGetShapes works.", {
skip_on_cran()
expect_equal(betaGetShapes(.4, 5), list(shape1 = .4 * 5, shape2 = (1 - .4) * 5))
})
# genMixFormula ----
test_that("genMixFormula throws errors.", {
skip_on_cran()
expect_error(genMixFormula(), class = "simstudy::missingArgument")
expect_error(genMixFormula("a", varLength = 3), class = "simstudy::valueError")
expect_error(genMixFormula("..a", varLength = "b"), class = "simstudy::wrongType")
expect_error(genMixFormula(3, varLength = "b"), class = "simstudy::wrongType")
expect_error(genMixFormula(c("a", "b"), probs = "b"), class = "simstudy::wrongType")
expect_warning(genMixFormula(c("a", "b"), probs = c(.3)), class = "simstudy::valueWarning")
})
test_that("genMixFormula works.", {
skip_on_cran()
expect_equal(genMixFormula("a"), "a | 1")
expect_equal(genMixFormula(c("a", "..b"), c(.3, .7)), "a | 0.3 + ..b | 0.7")
expect_equal(
genMixFormula("..a", varLength = 3),
"..a[[1]] | 0.333333333333333 + ..a[[2]] | 0.333333333333333 + ..a[[3]] | 0.333333333333333"
)
})
# survGetParams ----
test_that("survGetParams throws errors.", {
skip_on_cran()
expect_error(survGetParams(), class = "simstudy::missingArgument")
expect_error(survGetParams(c(100, .5)), class = "simstudy::wrongClass")
points <- list(c(280, 0.85), c(165, .45))
expect_error(survGetParams(points), class = "simstudy::wrongOrder")
points <- list(c(80, 0.45), c(165, .55))
expect_error(survGetParams(points), class = "simstudy::wrongOrder")
points <- list(c(-280, 0.85), c(165, .45))
expect_error(survGetParams(points), class = "simstudy::wrongSign")
points <- list(c(28, 1.85), c(365, .45))
expect_error(survGetParams(points), class = "simstudy::probError")
})
test_that("survGetParam works.", {
skip_on_cran()
points <- list(c(50, 0.90), c(100, 0.10))
expect_equal(survGetParams(points), c(-19.658, 0.225), tolerance = .001)
points <- list(c(60, 0.90), c(100, .75), c(200, .25), c(250, .10))
expect_equal(survGetParams(points), c(-11.206, 0.459), tolerance = .001)
})
# plotSurv ----
test_that("survParamPlot throws errors.", {
skip_on_cran()
expect_error(survParamPlot(), class = "simstudy::missingArgument")
expect_error(survParamPlot(formula = -10), class = "simstudy::missingArgument")
expect_error(survParamPlot(formula = 4, shape = -1), class = "simstudy::wrongSign")
})
test_that("survParamPlot works.", {
skip_on_cran()
expect_is(survParamPlot(formula = -4, shape = 1), class = "ggplot")
points <- list(c(100, .8), c(200, .5))
r <- survGetParams(points)
expect_is(survParamPlot(formula = r[1], shape = r[2], points = points),
class = "ggplot"
)
expect_is(survParamPlot(formula = r[1], shape = r[2], points = points, limits=c(0, 220)),
class = "ggplot"
)
})
# logisticCoefs
# test_that("logisticCoefs works.", {
#
# skip_on_cran()
#
# d1 <- defData(varname = "x1", formula = 0, variance = 1)
# d1 <- defData(d1, varname = "b1", formula = 0.5, dist = "binary")
#
# coefs <- log(runif(2, min = .8, max = 1.2))
#
# ### Prevalence
#
# d1a <- defData(d1, varname = "y",
# formula = "t(..B) %*% c(1, x1, b1)",
# dist = "binary", link = "logit"
# )
#
# tPop <- round(runif(1, .2, .5), 2)
# B <- logisticCoefs(defCovar = d1, coefs = coefs, popPrev = tPop)
#
# dd <- genData(100000, d1a)
# expect_equal(dd[, mean(y)], tPop, tolerance = .025)
#
# #### Comparisons
#
# d1a <- defData(d1, varname = "rx", formula = "1;1", dist = "trtAssign")
# d1a <- defData(d1a, varname = "y",
# formula = "t(..B) %*% c(1, rx, x1, b1)",
# dist = "binary", link = "logit"
# )
#
# ### Risk ratio
#
# rr <- runif(1, .1, 1/tPop)
# B <- logisticCoefs(d1, coefs, popPrev = tPop, rr = rr, trtName = "rx")
#
# dd <- genData(100000, d1a)
# expect_equal(dd[rx==0, mean(y)], tPop, tolerance = .025)
# expect_equal(dd[rx==1, mean(y)]/dd[rx==0, mean(y)], rr, tolerance = 0.025)
#
# ### risk difference
#
# rd <- runif(1, -tPop, 1 - tPop)
# B <- logisticCoefs(d1, coefs, popPrev = tPop, rd = rd, trtName = "rx")
#
# dd <- genData(100000, d1a)
# expect_equal(dd[rx==0, mean(y)], tPop, tolerance = .025)
# expect_equal(dd[rx==1, mean(y)] - dd[rx==0, mean(y)], rd, tolerance = 0.025)
#
# ### AUC
#
# d1a <- defData(d1, varname = "y",
# formula = "t(..B) %*% c(1, x1, b1)",
# dist = "binary", link = "logit"
# )
#
# auc <- runif(1, 0.6, 0.95)
# B <- logisticCoefs(d1, coefs, popPrev = tPop, auc = auc)
#
# dx <- genData(500000, d1a)
# expect_equal(dx[, mean(y)], tPop, tolerance = .025)
#
# form <- paste("y ~", paste(d1[, varname], collapse = " + "))
#
# fit <- stats::glm(stats::as.formula(form), data = dx)
# dx[, py := stats::predict(fit)]
#
# Y1 <- dx[y == 1, sample(py, 1000000, replace = TRUE)]
# Y0 <- dx[y == 0, sample(py, 1000000, replace = TRUE)]
# aStat <- mean(Y1 > Y0)
#
# expect_equal(aStat, auc, tolerance = 0.025)
#
# })
test_that("logisticCoefs throws errors.", {
skip_on_cran()
d1 <- defData(varname = "x1", formula = 0, variance = 1)
d1 <- defData(d1, varname = "b1", formula = 0.5, dist = "binary")
coefs <- log(runif(2, min = .8, max = 1.2))
coefs2 <- log(runif(1, min = .8, max = 1.2))
coefs3 <- c("a", "b")
expect_error(logisticCoefs(d1, coefs), class = "simstudy::missingArgument")
expect_error(logisticCoefs(coef = coefs, popPrev = .5), class = "simstudy::missingArgument")
expect_error(logisticCoefs(defCovar = d1, popPrev = .5), class = "simstudy::missingArgument")
expect_error(logisticCoefs(d1, coefs, popPrev = .5, rr = 1.1, rd = .4), class = "simpleError")
expect_error(logisticCoefs(d1, coefs=coefs2, popPrev = .5), class = "simstudy::lengthMismatch" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = .5, rr = -1), class = "simstudy::minError" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = .5, rr = 2.1), class = "simpleError" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = .5, rd = .6), class = "simstudy::valueError" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = .5, rd = -.7), class = "simstudy::valueError" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = .5, auc = .4), class = "simstudy::valueError" )
expect_error(logisticCoefs(d1, coefs=coefs, popPrev = 1.2), class = "simstudy::valueError" )
expect_error(logisticCoefs(d1, coefs=coefs3, popPrev = .4), class = "simstudy::wrongType" )
})
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.