# tests/testthat/test-wrapper-truncation.R In distr6: The Complete R6 Probability Distributions Interface

```library(testthat)

test_that("check truncation constructor", {
expect_silent(truncate(Binomial\$new(), lower = 1, upper = 5))
expect_silent(truncate(Binomial\$new(), upper = 5))
expect_silent(truncate(Binomial\$new(), lower = 1))
expect_equal(truncate(Binomial\$new())\$inf, 1)
expect_equal(truncate(Binomial\$new())\$sup, 10)
expect_equal(truncate(Binomial\$new(), lower = -Inf, upper = Inf)\$inf, 1)
expect_equal(truncate(Binomial\$new(), lower = -Inf, upper = Inf)\$sup, 10)
expect_error(TruncatedDistribution\$new(MultivariateNormal\$new()), "multivariate")
expect_error(truncate(MixtureDistribution\$new(list(Binomial\$new(), Normal\$new())), 1, 2),
"mixed")
})

t <- truncate(Binomial\$new(), lower = 1, upper = 5)
test_that("pdf", {
expect_equal(t\$pdf(6), 0)
expect_equal(t\$pdf(0), 0)
expect_equal(
t\$pdf(4),
dbinom(4, prob = 0.5, size = 10) / ((pbinom(5, prob = 0.5, size = 10) -
pbinom(1, prob = 0.5, size = 10)))
)
expect_equal(
t\$pdf(4, log = TRUE),
log(dbinom(4, prob = 0.5, size = 10) / ((pbinom(5, prob = 0.5, size = 10) -
pbinom(1, prob = 0.5, size = 10))))
)
})

test_that("cdf", {
expect_equal(t\$cdf(5), 1)
expect_equal(t\$cdf(6), 1)
expect_equal(t\$cdf(0), 0)
expec <- (pbinom(4, prob = 0.5, size = 10) - pbinom(1, prob = 0.5, size = 10)) /
(pbinom(5, prob = 0.5, size = 10) - pbinom(1, prob = 0.5, size = 10))
expect_equal(t\$cdf(4, log.p = FALSE, lower.tail = TRUE), expec)
expect_equal(t\$cdf(4, log.p = TRUE, lower.tail = TRUE), log(expec))
expect_equal(t\$cdf(4, log.p = FALSE, lower.tail = FALSE), 1 - expec)
expect_equal(t\$cdf(4, log.p = TRUE, lower.tail = FALSE), log(1 - expec))
})

test_that("quantile", {
expect_equal(t\$.__enclos_env__\$private\$.quantile(-20), 1)
expect_equal(t\$.__enclos_env__\$private\$.quantile(20), 5)
expect_equal(t\$quantile(0.1), 3)
r <- expect_silent({t\$rand(5)})
expect_length(r, 5)
expect_true(all(r >= 1) & all(r <= 5))
})

test_that("strprint", {
expect_equal(t\$properties\$support\$strprint(), Interval\$new(2, 5, class = "integer")\$strprint())
expect_equal(
truncate(Exponential\$new(), lower = 2, upper = 3)\$properties\$support\$strprint(),
Interval\$new(2, 3, type = "(]")\$strprint()
)
})

test_that("check missing", {
expect_error(truncate(Distribution\$new("Test", pdf = dnorm), 1, 2))
expect_error(truncate(Distribution\$new("Test", cdf = pnorm), 1, 2))
})

test_that("check truncation parameters", {
x <- truncate(Binomial\$new(), lower = 1, upper = 5)
expect_equal(x\$inf, 2)
expect_equal(x\$sup, 5)
expect_equal(x\$getParameterValue("trunc__lower"), 1)
expect_equal(x\$getParameterValue("trunc__upper"), 5)
expect_silent(x\$setParameterValue(trunc__lower = 2))
expect_silent(x\$setParameterValue(trunc__upper = 10))
expect_equal(x\$inf, 3)
expect_equal(x\$sup, 10)
expect_equal(x\$getParameterValue("trunc__lower"), 2)
expect_equal(x\$getParameterValue("trunc__upper"), 10)
expect_error(x\$setParameterValue(trunc__upper = 1))
expect_error(x\$setParameterValue(trunc__lower = 12))
expect_error(x\$setParameterValue(trunc__lower = 4, trunc__upper = 3))
x <- truncate(Exponential\$new(), lower = 1, upper = 5)
expect_silent(x\$setParameterValue(trunc__lower = 2, trunc__upper = 10))
expect_equal(x\$inf, 2)
expect_equal(x\$sup, 10)
expect_true(testInterval(x\$properties\$support))
})

test_that("missing pdf/cdf", {
expect_error(truncate(Distribution\$new("a", pdf = function(x) x, type = Reals\$new())),
"pdf and cdf")
})
```

## Try the distr6 package in your browser

Any scripts or data that you put into this service are public.

distr6 documentation built on March 28, 2022, 1:05 a.m.