[dfe06d]: / tests / testthat / test_priors.R

Download this file

128 lines (87 with data), 3.5 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
context("Test prior functions")
test_that("Priors in cpp and R references give identical results.", {
## skip on CRAN
skip_on_cran()
## generate data
param <- list(mu = 0.000123, pi = 0.789, eps = 0.21342, lambda = 0.0123)
config <- create_config()
mu_r <- .prior_mu(param, config$prior_mu)
mu_cpp <- cpp_prior_mu(param, config)
pi_r <- .prior_pi(param, config$prior_pi[1], config$prior_pi[2])
pi_cpp <- cpp_prior_pi(param, config)
eps_r <- .prior_eps(param, config$prior_eps[1], config$prior_eps[2])
eps_cpp <- cpp_prior_eps(param, config)
lambda_r <- .prior_lambda(param, config$prior_lambda[1], config$prior_lambda[2])
lambda_cpp <- cpp_prior_lambda(param, config)
## checks
expect_equal(mu_r, mu_cpp)
expect_equal(pi_r, pi_cpp)
expect_equal(eps_r, eps_cpp)
expect_equal(lambda_r, lambda_cpp)
})
test_that("Sum of priors is consistent.", {
## skip on CRAN
skip_on_cran()
## generate data
param <- list(mu = 0.000123, pi = 0.789, eps = 0.21342, lambda = 0.0123)
config <- create_config()
p_mu <- cpp_prior_mu(param, config)
p_pi <- cpp_prior_pi(param, config)
p_eps <- cpp_prior_eps(param, config)
p_lambda <- cpp_prior_lambda(param, config)
p_all<- cpp_prior_all(param, config)
## checks
expect_equal(p_mu + p_pi + p_eps + p_lambda, p_all)
})
test_that("Prior customisation.", {
## skip on CRAN
skip_on_cran()
## check default config
config <- create_config()
expect_equal(custom_priors(),
custom_priors())
## check errors
msg <- "The following priors are not functions: mu"
expect_error(custom_priors(mu = "Chtulhu"), msg)
msg <- "The following priors dont' have a single argument: mu"
expect_error(custom_priors(mu = plot), msg)
## custom prior parameters
mu <- 0.00123123
pi <- 0.8765
eps <- 0.8082
lambda <- 0.14537
config <- create_config(prior_mu = 0.01,
prior_pi = c(2, 1),
prior_eps = c(2,1),
prior_lambda = c(2,1))
param <- list(mu = mu, pi = pi, eps = eps, lambda = lambda)
p_mu <- cpp_prior_mu(param, config)
p_pi <- cpp_prior_pi(param, config)
p_eps <- cpp_prior_eps(param, config)
p_lambda <- cpp_prior_lambda(param, config)
expect_equal(p_mu,
dexp(mu, 0.01, log = TRUE))
expect_equal(p_pi,
dbeta(pi, 2, 1, log = TRUE))
expect_equal(p_eps,
dbeta(eps, 2, 1, log = TRUE))
expect_equal(p_lambda,
dbeta(lambda, 2, 1, log = TRUE))
## custom functions
f_mu <- function(x) { dexp(x$mu, rate = 100, log = TRUE) }
p_mu <- cpp_prior_mu(param, config, f_mu)
p_mu_ref <- f_mu(list(mu = mu))
expect_equal(p_mu, p_mu_ref)
f_pi <- function(x) { dexp(x$pi, rate = 12.123, log = TRUE) }
p_pi <- cpp_prior_pi(param, config, f_pi)
p_pi_ref <- f_pi(list(pi = pi))
expect_equal(p_pi, p_pi_ref)
f_eps <- function(x) { dexp(x$eps, rate = 12.123, log = TRUE) }
p_eps <- cpp_prior_eps(param, config, f_eps)
p_eps_ref <- f_eps(list(eps = eps))
expect_equal(p_eps, p_eps_ref)
f_lambda <- function(x) { dexp(x$lambda, rate = 12.123, log = TRUE) }
p_lambda <- cpp_prior_lambda(param, config, f_lambda)
p_lambda_ref <- f_lambda(list(lambda = lambda))
expect_equal(p_lambda, p_lambda_ref)
})