Switch to side-by-side view

--- a
+++ b/tests/testthat/test_priors.R
@@ -0,0 +1,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)
+
+})