context("Extract draws functions")
check_spread_draws_MCMC_mat_concordance <- function(mod, dat){
components <- unique(names(dat)[!(names(dat) %in% c('chain', 'iter', 'h'))])
for(x in components){
MCMC_output <- mod[[paste0(x, '_posterior')]]
if(is.null(dim(MCMC_output))){
if('h' %in% names(dat)){
expect_equal(dat[[x]][dat$h == dat$h[1]], MCMC_output)
}else{
expect_equal(dat[[x]], MCMC_output)
}
}else{
expect_equal(dat[[x]], c(t(MCMC_output)))
}
}
}
check_gather_draws_MCMC_mat_concordance <- function(mod, dat){
components <- unique(dat$name)
for(x in components){
MCMC_output <- mod[[paste0(x, '_posterior')]]
curr_dat <- dat[dat$name==x, ]
if(is.null(dim(MCMC_output))){
if('h' %in% names(curr_dat)){
expect_equal(curr_dat$value[curr_dat$h == curr_dat$h[1]], MCMC_output)
}else{
expect_equal(curr_dat$value, MCMC_output)
}
}else{
expect_equal(curr_dat$value, c(t(MCMC_output)))
}
}
}
test_that("check different inputs to spread draws and gather draws", {
# skip_on_cran()
expect_equal(spread_draws(plm0.fit, 'c', 'sigma_eps'),
spread_draws(plm0.fit, c('c', 'sigma_eps')))
expect_equal(spread_draws(plm.fit, 'c', paste0('eta_', 1:3)),
spread_draws(plm.fit, c('c', 'c', paste0('eta_', 1:3))))
expect_equal(spread_draws(gplm0.fit, 'c', 'c'),
spread_draws(gplm0.fit, 'c'))
expect_equal(spread_draws(gplm.fit, c('c', 'sigma_beta'), c('eta_1', 'sigma_eta')),
spread_draws(gplm.fit,'c','sigma_beta', 'eta_1', 'sigma_eta'))
expect_error(spread_draws(gplm.fit_known_c, 'c'))
expect_equal(gather_draws(plm0.fit, 'c', 'sigma_eps'),
gather_draws(plm0.fit, c('c', 'sigma_eps')))
expect_equal(gather_draws(plm.fit, 'c', paste0('eta_', 1:3)),
gather_draws(plm.fit, c('c', 'c', paste0('eta_', 1:3))))
expect_equal(gather_draws(gplm0.fit, 'c', 'c'),
gather_draws(gplm0.fit, 'c'))
expect_equal(gather_draws(gplm.fit, c('c', 'sigma_beta'), c('eta_1', 'sigma_eta')),
gather_draws(gplm.fit, 'c', 'sigma_beta', 'eta_1', 'sigma_eta'))
expect_error(gather_draws(gplm.fit_known_c, 'c'))
})
test_that("spread draws and gather draws are concordant with MCMC matrices", {
# skip_on_cran()
#spread_draws
check_spread_draws_MCMC_mat_concordance(plm0.fit,spread_draws(plm0.fit, 'c', 'sigma_eps'))
check_spread_draws_MCMC_mat_concordance(plm0.fit,spread_draws(plm0.fit, 'rating_curve', 'rating_curve_mean', 'c'))
check_spread_draws_MCMC_mat_concordance(plm.fit,spread_draws(plm.fit, 'c', paste0('eta_', 1:6)))
check_spread_draws_MCMC_mat_concordance(plm.fit,spread_draws(plm.fit, 'rating_curve', 'rating_curve_mean', 'sigma_eps', 'sigma_eta'))
check_spread_draws_MCMC_mat_concordance(gplm0.fit,spread_draws(gplm0.fit, 'c', 'phi_beta', 'sigma_beta'))
check_spread_draws_MCMC_mat_concordance(gplm0.fit,spread_draws(gplm0.fit, 'rating_curve', 'rating_curve_mean', 'beta', 'f', 'sigma_eps'))
check_spread_draws_MCMC_mat_concordance(gplm.fit,spread_draws(gplm.fit, 'c', paste0('eta_', 1:6)))
check_spread_draws_MCMC_mat_concordance(gplm.fit,spread_draws(gplm.fit, 'rating_curve', 'rating_curve_mean', 'sigma_eps', 'beta', 'f', 'sigma_eta'))
#gather_draws
check_gather_draws_MCMC_mat_concordance(plm0.fit,spread_draws(plm0.fit, 'c', 'sigma_eps'))
check_gather_draws_MCMC_mat_concordance(plm0.fit,spread_draws(plm0.fit, 'rating_curve', 'rating_curve_mean', 'c'))
check_gather_draws_MCMC_mat_concordance(plm.fit,spread_draws(plm.fit, 'c', paste0('eta_', 1:6)))
check_gather_draws_MCMC_mat_concordance(plm.fit,spread_draws(plm.fit, 'rating_curve', 'rating_curve_mean', 'sigma_eps', 'sigma_eta'))
check_gather_draws_MCMC_mat_concordance(gplm0.fit,spread_draws(gplm0.fit, 'c', 'phi_beta', 'sigma_beta'))
check_gather_draws_MCMC_mat_concordance(gplm0.fit,spread_draws(gplm0.fit, 'rating_curve', 'rating_curve_mean', 'beta', 'f', 'sigma_eps'))
check_gather_draws_MCMC_mat_concordance(gplm.fit,spread_draws(gplm.fit, 'c', paste0('eta_', 1:6)))
check_gather_draws_MCMC_mat_concordance(gplm.fit,spread_draws(gplm.fit, 'rating_curve', 'rating_curve_mean', 'sigma_eps', 'beta', 'f', 'sigma_eta'))
})
test_that("spread_draws handles various input combinations", {
# Test with single parameter
single_param <- spread_draws(plm0.fit, "c")
expect_true("c" %in% names(single_param))
expect_equal(ncol(single_param), 3)
# Test with multiple parameters
multi_param <- spread_draws(plm0.fit, "c", "sigma_eps")
expect_true(all(c("c", "sigma_eps") %in% names(multi_param)))
expect_equal(ncol(multi_param), 4)
# Test with transformed parameter
transformed_param <- spread_draws(plm0.fit, "c", transformed = TRUE)
expect_true("log(h_min-c)" %in% names(transformed_param))
# Test with rating curve
rc_param <- spread_draws(plm0.fit, "rating_curve")
expect_true("rating_curve" %in% names(rc_param))
expect_true("h" %in% names(rc_param))
})
test_that("gather_draws handles various input combinations", {
# Test with single parameter
single_param <- gather_draws(plm0.fit, "c")
expect_equal(unique(single_param$name), "c")
expect_equal(ncol(single_param), 4)
# Test with multiple parameters
multi_param <- gather_draws(plm0.fit, "c", "sigma_eps")
expect_equal(sort(unique(multi_param$name)), c("c", "sigma_eps"))
# Test with transformed parameter
transformed_param <- gather_draws(plm0.fit, "c", transformed = TRUE)
expect_true(any(grepl("log\\(h_min-c\\)", transformed_param$name)))
# Test with rating curve
rc_param <- gather_draws(plm0.fit, "rating_curve")
expect_true("rating_curve" %in% unique(rc_param$name))
expect_true("h" %in% names(rc_param))
})
test_that("spread_draws and gather_draws handle errors correctly", {
# Test with invalid parameter name
expect_error(spread_draws(plm0.fit, "invalid_param"), "Does not recognize the following input arguments")
expect_error(gather_draws(plm0.fit, "invalid_param"), "Does not recognize the following input arguments")
# Test with invalid model object
invalid_model <- list(class = "invalid")
expect_error(spread_draws(invalid_model, "c"), "mod must be of class")
expect_error(gather_draws(invalid_model, "c"), "mod must be of class")
})
test_that("spread_draws and gather_draws produce consistent results", {
params <- c("c", "sigma_eps", "rating_curve")
spread_result <- spread_draws(plm0.fit, params)
gather_result <- gather_draws(plm0.fit, params)
# Check that the number of rows is consistent
expect_equal(nrow(spread_result), nrow(gather_result) / length(params))
# Check that the values are consistent
for (param in params) {
spread_values <- spread_result[[param]]
gather_values <- gather_result$value[gather_result$name == param]
expect_equal(spread_values, gather_values)
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.