From 1763f6d0f89fd495ba6ca244cc5724ed62e30445 Mon Sep 17 00:00:00 2001 From: Copilot <198982749+Copilot@users.noreply.github.com> Date: Mon, 8 Dec 2025 21:13:14 +0100 Subject: [PATCH 01/38] Refactor duplicated posterior extraction logic into reusable helpers (#48) --- DESCRIPTION | 2 +- R/JAGS-diagnostics.R | 100 ++------ R/JAGS-fit.R | 66 +++--- R/posterior-extraction.R | 259 +++++++++++++++++++++ R/summary-tables.R | 200 ++-------------- man/posterior_extraction_helpers.Rd | 88 +++++++ tests/testthat/test-posterior-extraction.R | 193 +++++++++++++++ 7 files changed, 613 insertions(+), 295 deletions(-) create mode 100644 R/posterior-extraction.R create mode 100644 man/posterior_extraction_helpers.Rd create mode 100644 tests/testthat/test-posterior-extraction.R diff --git a/DESCRIPTION b/DESCRIPTION index d499a1b..6e39c9b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,7 @@ License: GPL-3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 SystemRequirements: JAGS >= 4.3.0 (https://mcmc-jags.sourceforge.io/) Depends: stats diff --git a/R/JAGS-diagnostics.R b/R/JAGS-diagnostics.R index 60b4baa..283d60f 100644 --- a/R/JAGS-diagnostics.R +++ b/R/JAGS-diagnostics.R @@ -213,14 +213,14 @@ JAGS_diagnostics_autocorrelation <- function(fit, parameter, plot_type = "base", if(!is.null(transformations) && any(!sapply(transformations, function(trans)is.function(trans[["fun"]])))) stop("'transformations' must be list of functions in the 'fun' element.") - model_samples <- coda::as.mcmc.list(fit) - samples_chain <- lapply(seq_along(model_samples), function(i) { - return(rep(i, nrow(model_samples[[i]]))) + model_samples_list <- .extract_posterior_samples(fit, as_list = TRUE) + samples_chain <- lapply(seq_along(model_samples_list), function(i) { + return(rep(i, nrow(model_samples_list[[i]]))) }) - samples_iter <- lapply(seq_along(model_samples), function(i) { - return(1:nrow(model_samples[[i]])) + samples_iter <- lapply(seq_along(model_samples_list), function(i) { + return(1:nrow(model_samples_list[[i]])) }) - model_samples <- do.call(rbind, model_samples) + model_samples <- do.call(rbind, model_samples_list) # extract the relevant parameters @@ -280,82 +280,18 @@ JAGS_diagnostics_autocorrelation <- function(fit, parameter, plot_type = "base", # mostly adapted from runjags_estimates_table # apply transformations - if(!is.null(transformations)){ - for(par in names(transformations)){ - model_samples[,par] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[,par]), transformations[[par]][["arg"]])) - } - } - - # transform meandif and orthonormal factors to differences from runjags_estimates_table - if(transform_factors & any(sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x)))){ - for(par in names(prior_list)[sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x))]){ - - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - par_names <- par - }else{ - par_names <- paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]") - } - - original_samples <- model_samples[,par_names,drop = FALSE] - - if(is.prior.orthonormal(prior_list[[par]])){ - model_samples <- original_samples %*% t(contr.orthonormal(1:(.get_prior_factor_levels(prior_list[[par]])+1))) - }else if(is.prior.meandif(prior_list[[par]])){ - model_samples <- original_samples %*% t(contr.meandif(1:(.get_prior_factor_levels(prior_list[[par]])+1))) - } - - - if(attr(prior_list[[par]], "interaction")){ - if(length(.get_prior_factor_level_names(prior_list[[par]])) == 1){ - parameter_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]])[[1]],"]") - }else{ - stop("orthonormal/meandif de-transformation for interaction of multiple factors is not implemented.") - } - }else{ - parameter_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]]),"]") - } - } - }else if(any(sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x)))){ - for(par in names(prior_list)[sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x))]){ - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - parameter_names <- par - }else{ - parameter_names <- paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]") - } - } - } - - # rename treatment factor levels - if(any(sapply(prior_list, is.prior.treatment))){ - for(par in names(prior_list)[sapply(prior_list, is.prior.treatment)]){ - if(!.is_prior_interaction(prior_list[[par]])){ - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - parameter_names <- par - }else{ - parameter_names <- paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[-1], "]") - } - }else if(length(attr(prior_list[[par]], "levels")) == 1){ - parameter_names <- paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[[1]][-1], "]") - } - } - } - - # rename independent factor levels - if(any(sapply(prior_list, is.prior.independent))){ - for(par in names(prior_list)[sapply(prior_list, is.prior.independent)]){ - if(!.is_prior_interaction(prior_list[[par]])){ - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - parameter_names <- par - }else{ - parameter_names <- paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]]), "]") - } - }else if(length(attr(prior_list[[par]], "levels")) == 1){ - parameter_names <- paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]]), "]") - } - } - } - - # rename weightfunctions factor levels + model_samples <- .apply_parameter_transformations(model_samples, transformations, prior_list, transform_factors) + + # transform meandif and orthonormal factors to differences + model_samples <- .transform_factor_contrasts(model_samples, prior_list, transform_factors, transformations) + + # rename factor levels (treatment, independent) + model_samples <- .rename_factor_levels(model_samples, prior_list) + + # extract parameter names from column names after transformations and renaming + parameter_names <- colnames(model_samples) + + # rename weightfunctions factor levels (special case that overrides) if(any(sapply(prior_list, is.prior.weightfunction)) && !is.prior.mixture(prior_list)){ for(par in names(prior_list)[sapply(prior_list, is.prior.weightfunction)]){ omega_cuts <- weightfunctions_mapping(prior_list[par], cuts_only = TRUE) diff --git a/R/JAGS-fit.R b/R/JAGS-fit.R index 88c70a6..8b1734b 100644 --- a/R/JAGS-fit.R +++ b/R/JAGS-fit.R @@ -447,40 +447,42 @@ JAGS_check_convergence <- function(fit, prior_list, max_Rhat = 1.05, min_ESS = 5 check_char(add_parameters, "add_parameters", check_length = 0, allow_NULL = TRUE) # extract samples and parameter information - mcmc_samples <- coda::as.mcmc.list(fit) - parameter_names <- colnames(mcmc_samples[[1]]) - parameters_keep <- rep(TRUE, length(parameter_names)) - - # remove auxiliary and support parameters from the summary - for(i in seq_along(prior_list)){ - if(is.prior.weightfunction(prior_list[[i]])){ - if(prior_list[[i]][["distribution"]] %in% c("one.sided", "two.sided")){ - parameters_keep[grepl("eta", parameter_names)] <- FALSE - } - parameter_names[max(grep("omega", parameter_names))] <- FALSE - }else if(is.prior.mixture(prior_list[[i]]) && any(sapply(prior_list[[i]], is.prior.weightfunction))){ - parameters_keep[max(grep("omega", parameter_names))] <- FALSE - }else if(is.prior.point(prior_list[[i]])){ - parameters_keep[parameter_names == names(prior_list)[i]] <- FALSE - }else if(is.prior.simple(prior_list[[i]]) && prior_list[[i]][["distribution"]] == "invgamma"){ - parameters_keep[parameter_names == paste0("inv_",names(prior_list)[i])] <- FALSE - }else if(is.prior.mixture(prior_list[[i]]) && length(prior_list[[i]]) == 1 && is.prior.point(prior_list[[i]][[1]])){ - parameters_keep[parameter_names == names(prior_list)[i]] <- FALSE - } - } - - # remove indicators/inclusions - parameters_keep[grepl("_indicator", parameter_names)] <- FALSE - parameters_keep[grepl("_inclusion", parameter_names)] <- FALSE - - if(all(!parameters_keep)){ + mcmc_samples_list <- coda::as.mcmc.list(fit) + mcmc_samples <- do.call(rbind, mcmc_samples_list) + + # build remove_parameters list: point priors, spike priors, indicators, inclusions + remove_params <- c( + # point priors + names(prior_list)[sapply(prior_list, is.prior.point)], + # mixture with single point prior + names(prior_list)[sapply(prior_list, function(p) { + is.prior.mixture(p) && length(p) == 1 && is.prior.point(p[[1]]) + })], + # add_parameters that should be excluded + add_parameters + ) + + # use helper to remove auxiliary parameters + cleaned <- .remove_auxiliary_parameters(mcmc_samples, prior_list, remove_params) + mcmc_samples <- cleaned$model_samples + + # remove indicators/inclusions (not handled by helper since they're not in prior_list) + indicator_cols <- grepl("_indicator|_inclusion", colnames(mcmc_samples)) + mcmc_samples <- mcmc_samples[, !indicator_cols, drop = FALSE] + + if(ncol(mcmc_samples) == 0){ return(TRUE) } - - # remove parameters that are not monitored - for(i in seq_along(mcmc_samples)){ - mcmc_samples[[i]] <- mcmc_samples[[i]][,parameters_keep,drop=FALSE] - } + + # convert back to mcmc.list for convergence checks + n_chains <- length(mcmc_samples_list) + samples_per_chain <- nrow(mcmc_samples) / n_chains + mcmc_samples_list_cleaned <- lapply(1:n_chains, function(i) { + start_idx <- (i - 1) * samples_per_chain + 1 + end_idx <- i * samples_per_chain + coda::as.mcmc(mcmc_samples[start_idx:end_idx, , drop = FALSE]) + }) + mcmc_samples <- coda::as.mcmc.list(mcmc_samples_list_cleaned) ### check the convergence fails <- NULL diff --git a/R/posterior-extraction.R b/R/posterior-extraction.R new file mode 100644 index 0000000..9a50580 --- /dev/null +++ b/R/posterior-extraction.R @@ -0,0 +1,259 @@ +#' @title Helper functions for extracting and formatting posterior distributions +#' +#' @description Internal helper functions to extract posterior samples from JAGS +#' fits and reformat them for further processing (summary tables, diagnostics, plots). +#' These functions consolidate common logic that was duplicated across +#' \code{runjags_estimates_table}, \code{.diagnostics_plot_data}, and plotting functions. +#' +#' @name posterior_extraction_helpers +#' @keywords internal +NULL + + +#' @rdname posterior_extraction_helpers +#' @param fit a JAGS model fit object +#' @param as_list whether to return samples as mcmc.list (TRUE) or merged matrix (FALSE) +#' @return matrix or mcmc.list of posterior samples +.extract_posterior_samples <- function(fit, as_list = FALSE) { + + if (as_list) { + # Use generic function to allow S3 method dispatch (runjags has its own as.mcmc.list method) + model_samples <- coda::as.mcmc.list(fit) + } else { + # Use generic function to allow S3 method dispatch (runjags has its own as.mcmc method) + model_samples <- suppressWarnings(coda::as.mcmc(fit)) + } + + return(model_samples) +} + + +#' @rdname posterior_extraction_helpers +#' @param model_samples matrix of posterior samples +#' @param prior_list list of prior objects +#' @param remove_parameters character vector of parameter names to remove +#' @return list with cleaned model_samples and updated prior_list +.remove_auxiliary_parameters <- function(model_samples, prior_list, remove_parameters = NULL) { + + for (i in rev(seq_along(prior_list))) { + + # invgamma support parameter + if (is.prior.simple(prior_list[[i]]) && prior_list[[i]][["distribution"]] == "invgamma") { + model_samples <- model_samples[, colnames(model_samples) != paste0("inv_", names(prior_list)[i]), drop = FALSE] + } + + # weightfunction parameters + if (is.prior.weightfunction(prior_list[[i]])) { + # remove etas + if (prior_list[[i]][["distribution"]] %in% c("one.sided", "two.sided")) { + model_samples <- model_samples[, !grepl("eta", colnames(model_samples)), drop = FALSE] + } + + # rename the omegas + omega_cuts <- weightfunctions_mapping(prior_list[i], cuts_only = TRUE) + omega_names_old <- paste0("omega[", 1:(length(omega_cuts) - 1), "]") + omega_names <- sapply(1:(length(omega_cuts) - 1), function(j) paste0("omega[", omega_cuts[j], ",", omega_cuts[j + 1], "]")) + + # change the order of omegas + model_samples[, which(colnames(model_samples) %in% omega_names_old)] <- model_samples[, rev(which(colnames(model_samples) %in% omega_names_old)), drop = FALSE] + colnames(model_samples)[which(colnames(model_samples) %in% omega_names_old)] <- omega_names + + # remove omegas if requested + if ("omega" %in% remove_parameters) { + model_samples <- model_samples[, !colnames(model_samples) %in% omega_names, drop = FALSE] + prior_list[i] <- NULL + } + + } else if (names(prior_list)[[i]] %in% remove_parameters) { + # remove parameters to be excluded (note: spike_0 removal is handled by caller) + if (is.prior.factor(prior_list[[i]])) { + model_samples <- model_samples[, !colnames(model_samples) %in% .JAGS_prior_factor_names(names(prior_list)[i], prior_list[[i]]), drop = FALSE] + } else { + model_samples <- model_samples[, colnames(model_samples) != names(prior_list)[i], drop = FALSE] + } + prior_list[i] <- NULL + } + } + + return(list(model_samples = model_samples, prior_list = prior_list)) +} + + +#' @rdname posterior_extraction_helpers +#' @param par parameter name +#' @param conditional whether to compute conditional summary +#' @param remove_inclusion whether to remove inclusion indicators +#' @param warnings character vector for collecting warnings +#' @return list with updated model_samples, prior_list, and warnings +.process_spike_and_slab <- function(model_samples, prior_list, par, conditional = FALSE, remove_inclusion = FALSE, warnings = NULL) { + + # prepare parameter names + if (is.prior.factor(.get_spike_and_slab_variable(prior_list[[par]]))) { + if (.get_prior_factor_levels(.get_spike_and_slab_variable(prior_list[[par]])) == 1) { + par_names <- par + } else { + par_names <- paste0(par, "[", 1:.get_prior_factor_levels(.get_spike_and_slab_variable(prior_list[[par]])), "]") + } + } else { + par_names <- par + } + + # change the samples between conditional/averaged based on the preferences + if (conditional) { + # compute the number of conditional samples + n_conditional_samples <- sum(model_samples[, colnames(model_samples) == paste0(par, "_indicator")] == 1) + + # replace null samples with NAs (important for later transformations) + model_samples[model_samples[, colnames(model_samples) == paste0(par, "_indicator")] != 1, par_names] <- NA + + # add warnings about conditional summary + warnings <- c(warnings, .runjags_conditional_warning(par_names, n_conditional_samples)) + } + + # remove the inclusion + model_samples <- model_samples[, colnames(model_samples) != paste0(par, "_inclusion"), drop = FALSE] + + # remove the latent variable + model_samples <- model_samples[, !colnames(model_samples) %in% gsub(par, paste0(par, "_variable"), par_names), drop = FALSE] + + # remove/rename the inclusions probabilities + if (remove_inclusion) { + model_samples <- model_samples[, colnames(model_samples) != paste0(par, "_indicator"), drop = FALSE] + } else { + colnames(model_samples)[colnames(model_samples) == paste0(par, "_indicator")] <- paste0(par, " (inclusion)") + } + + # modify the parameter list (forward the parameter attribute) + variable_component <- .get_spike_and_slab_variable(prior_list[[par]]) + attr(variable_component, "parameter") <- attr(prior_list[[par]], "parameter") + prior_list[[par]] <- variable_component + + return(list(model_samples = model_samples, prior_list = prior_list, warnings = warnings)) +} + + +#' @rdname posterior_extraction_helpers +#' @param transformations list of transformations to apply +#' @param transform_factors whether orthonormal/meandif will be transformed later +#' @return updated model_samples matrix +.apply_parameter_transformations <- function(model_samples, transformations, prior_list, transform_factors = FALSE) { + + if (is.null(transformations)) { + return(model_samples) + } + + for (par in names(transformations)) { + if (!is.prior.factor(prior_list[[par]])) { + # non-factor priors + model_samples[, par] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[, par]), transformations[[par]][["arg"]])) + } else if ((!transform_factors && (is.prior.orthonormal(prior_list[[par]]) | is.prior.meandif(prior_list[[par]]))) || is.prior.treatment(prior_list[[par]])) { + # treatment priors, or orthonormal/meandif that won't be transformed to differences + par_names <- .JAGS_prior_factor_names(par, prior_list[[par]]) + + for (i in seq_along(par_names)) { + model_samples[, par_names[i]] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[, par_names[i]]), transformations[[par]][["arg"]])) + } + } + } + + return(model_samples) +} + + +#' @rdname posterior_extraction_helpers +#' @param transform_factors whether to transform orthonormal/meandif to differences +#' @return updated model_samples matrix +.transform_factor_contrasts <- function(model_samples, prior_list, transform_factors = FALSE, transformations = NULL) { + + if (!transform_factors || !any(sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x)))) { + return(model_samples) + } + + message("The transformation was applied to the differences from the mean. Note that non-linear transformations do not map from the orthonormal/meandif contrasts to the differences from the mean.") + + for (par in names(prior_list)[sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x))]) { + + par_names <- .JAGS_prior_factor_names(par, prior_list[[par]]) + + temp_position <- min(which(colnames(model_samples) %in% par_names)) + temp_samples <- model_samples[, colnames(model_samples) %in% par_names, drop = FALSE] + model_samples <- model_samples[, !colnames(model_samples) %in% par_names, drop = FALSE] + + if (is.prior.orthonormal(prior_list[[par]])) { + transformed_samples <- temp_samples %*% t(contr.orthonormal(1:(.get_prior_factor_levels(prior_list[[par]]) + 1))) + } else if (is.prior.meandif(prior_list[[par]])) { + transformed_samples <- temp_samples %*% t(contr.meandif(1:(.get_prior_factor_levels(prior_list[[par]]) + 1))) + } + + # apply transformation if specified + if (!is.null(transformations[par])) { + for (i in 1:ncol(transformed_samples)) { + transformed_samples[, i] <- do.call(transformations[[par]][["fun"]], c(list(transformed_samples[, i]), transformations[[par]][["arg"]])) + } + } + + if (.is_prior_interaction(prior_list[[par]])) { + if (length(.get_prior_factor_level_names(prior_list[[par]])) == 1) { + transformed_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]])[[1]], "]") + } else { + stop("orthonormal/meandif de-transformation for interaction of multiple factors is not implemented.") + } + } else { + transformed_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]]), "]") + } + colnames(transformed_samples) <- transformed_names + + # place the transformed samples back + model_samples <- cbind( + if (temp_position > 1) model_samples[, 1:(temp_position - 1), drop = FALSE], + transformed_samples, + if (temp_position <= ncol(model_samples)) model_samples[, temp_position:ncol(model_samples), drop = FALSE] + ) + } + + return(model_samples) +} + + +#' @rdname posterior_extraction_helpers +#' @return updated model_samples matrix with renamed columns +.rename_factor_levels <- function(model_samples, prior_list) { + + # rename treatment factor levels + if (any(sapply(prior_list, is.prior.treatment))) { + for (par in names(prior_list)[sapply(prior_list, is.prior.treatment)]) { + if (!.is_prior_interaction(prior_list[[par]])) { + if (.get_prior_factor_levels(prior_list[[par]]) == 1) { + colnames(model_samples)[colnames(model_samples) == par] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]])[-1], "]") + } else { + colnames(model_samples)[colnames(model_samples) %in% paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]")] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]])[-1], "]") + } + } else if (length(attr(prior_list[[par]], "levels")) == 1) { + colnames(model_samples)[colnames(model_samples) %in% paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]")] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]])[[1]][-1], "]") + } + } + } + + # rename independent factor levels + if (any(sapply(prior_list, is.prior.independent))) { + for (par in names(prior_list)[sapply(prior_list, is.prior.independent)]) { + if (!.is_prior_interaction(prior_list[[par]])) { + if (.get_prior_factor_levels(prior_list[[par]]) == 1) { + colnames(model_samples)[colnames(model_samples) == par] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]]), "]") + } else { + colnames(model_samples)[colnames(model_samples) %in% paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]")] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]]), "]") + } + } else if (length(attr(prior_list[[par]], "levels")) == 1) { + colnames(model_samples)[colnames(model_samples) %in% paste0(par, "[", 1:.get_prior_factor_levels(prior_list[[par]]), "]")] <- + paste0(par, "[", .get_prior_factor_level_names(prior_list[[par]])[[1]], "]") + } + } + } + + return(model_samples) +} diff --git a/R/summary-tables.R b/R/summary-tables.R index 4d1967d..59284e7 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -744,97 +744,30 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, transform_factors <- .depreciate.transform_orthonormal(transform_orthonormal, transform_factors) # get model samples - model_samples <- suppressWarnings(coda::as.mcmc(fit)) + model_samples <- .extract_posterior_samples(fit, as_list = FALSE) ### remove un-wanted estimates (or support values) - spike and slab priors already dealt with later (also remove the item from prior list) - for(i in rev(seq_along(prior_list))){ - - if(is.prior.simple(prior_list[[i]]) && prior_list[[i]][["distribution"]] == "invgamma"){ - ## invgamma support parameter - model_samples <- model_samples[,colnames(model_samples) != paste0("inv_",names(prior_list)[i]),drop=FALSE] - } - - if(is.prior.weightfunction(prior_list[[i]])){ - ## simple weight functions - # remove etas - if(prior_list[[i]][["distribution"]] %in% c("one.sided", "two.sided")){ - model_samples <- model_samples[,!grepl("eta", colnames(model_samples)),drop=FALSE] - } - - # rename the omegas - omega_cuts <- weightfunctions_mapping(prior_list[i], cuts_only = TRUE) - omega_names_old <- paste0("omega[", 1:(length(omega_cuts)-1),"]") - omega_names <- sapply(1:(length(omega_cuts)-1), function(i)paste0("omega[",omega_cuts[i],",",omega_cuts[i+1],"]")) - - # change the order of omegas - model_samples[,which(colnames(model_samples) %in% omega_names_old)] <- model_samples[,rev(which(colnames(model_samples) %in% omega_names_old)),drop=FALSE] - colnames(model_samples)[which(colnames(model_samples) %in% omega_names_old)] <- omega_names - - # remove omegas if requested - if("omega" %in% remove_parameters){ - model_samples <- model_samples[,!colnames(model_samples) %in% omega_names,drop=FALSE] - prior_list[i] <- NULL - } - - }else if((remove_spike_0 && is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0) || (names(prior_list)[[i]] %in% remove_parameters)){ - ## zero spike priors or other parameters to be removed - if(is.prior.factor(prior_list[[i]])){ - model_samples <- model_samples[,!colnames(model_samples) %in% .JAGS_prior_factor_names(names(prior_list)[i], prior_list[[i]]),drop=FALSE] - }else{ - model_samples <- model_samples[,colnames(model_samples) != names(prior_list)[i],drop=FALSE] - } - prior_list[i] <- NULL - } - - } + # also remove zero spike priors if requested + remove_params_vec <- c(remove_parameters, if(remove_spike_0) { + names(prior_list)[sapply(seq_along(prior_list), function(i) { + is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0 + })] + }) + + cleaned <- .remove_auxiliary_parameters(model_samples, prior_list, remove_params_vec) + model_samples <- cleaned$model_samples + prior_list <- cleaned$prior_list # simplify mixture and spike and slab priors to simple priors # the samples and summary can be dealt with as any other prior (i.e., transformations later) for(par in names(prior_list)){ if(is.prior.spike_and_slab(prior_list[[par]])){ - # prepare parameter names - if(is.prior.factor(.get_spike_and_slab_variable(prior_list[[par]]))){ - if(.get_prior_factor_levels(.get_spike_and_slab_variable(prior_list[[par]])) == 1){ - par_names <- par - }else{ - par_names <- paste0(par, "[", 1:.get_prior_factor_levels(.get_spike_and_slab_variable(prior_list[[par]])), "]") - } - }else{ - par_names <- par - } - - # change the samples between conditional/averaged based on the preferences - if(conditional){ - - # compute the number of conditional samples - n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] == 1) - - # replace null samples with NAs (important for later transformations) - model_samples[model_samples[,colnames(model_samples) == paste0(par, "_indicator")] != 1, par_names] <- NA - - # add warnings about conditional summary - warnings <- c(warnings, .runjags_conditional_warning(par_names, n_conditional_samples)) - } - - # remove the inclusion - model_samples <- model_samples[,colnames(model_samples) != paste0(par, "_inclusion"),drop=FALSE] - - # remove the latent variable - model_samples <- model_samples[,!colnames(model_samples) %in% gsub(par, paste0(par, "_variable"), par_names),drop=FALSE] - - # remove/rename the inclusions probabilities - if(remove_inclusion){ - model_samples <- model_samples[,colnames(model_samples) != paste0(par, "_indicator"),drop=FALSE] - }else{ - colnames(model_samples)[colnames(model_samples) == paste0(par, "_indicator")] <- paste0(par, " (inclusion)") - } - - # modify the parameter list (forward the parameter attribute) - variable_component <- .get_spike_and_slab_variable(prior_list[[par]]) - attr(variable_component, "parameter") <- attr(prior_list[[par]], "parameter") - prior_list[[par]] <- variable_component - + # process spike and slab using helper function + processed <- .process_spike_and_slab(model_samples, prior_list, par, conditional, remove_inclusion, warnings) + model_samples <- processed$model_samples + prior_list <- processed$prior_list + warnings <- processed$warnings }else if(is.prior.mixture(prior_list[[par]])){ @@ -1027,106 +960,13 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, } # apply transformations (not orthornormal if they are to be returned transformed to diffs) - if(!is.null(transformations)){ - for(par in names(transformations)){ - if(!is.prior.factor(prior_list[[par]])){ - - # non-factor priors - model_samples[,par] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[,par]), transformations[[par]][["arg"]])) - - }else if((!transform_factors && (is.prior.orthonormal(prior_list[[par]]) | is.prior.meandif(prior_list[[par]]))) || is.prior.treatment(prior_list[[par]])){ - - # treatment priors - par_names <- .JAGS_prior_factor_names(par, prior_list[[par]]) - - for(i in seq_along(par_names)){ - model_samples[,par_names[i]] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[,par_names[i]]), transformations[[par]][["arg"]])) - } - } - } - } + model_samples <- .apply_parameter_transformations(model_samples, transformations, prior_list, transform_factors) # transform orthonormal factors to differences from mean - if(transform_factors & any(sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x)))){ - message("The transformation was applied to the differences from the mean. Note that non-linear transformations do not map from the orthonormal/meandif contrasts to the differences from the mean.") - for(par in names(prior_list)[sapply(prior_list, function(x) is.prior.orthonormal(x) | is.prior.meandif(x))]){ - - par_names <- .JAGS_prior_factor_names(par, prior_list[[par]]) - - temp_position <- min(which(colnames(model_samples) %in% par_names)) - temp_samples <- model_samples[, colnames(model_samples) %in% par_names,drop=FALSE] - model_samples <- model_samples[,!colnames(model_samples) %in% par_names,drop=FALSE] - - if(is.prior.orthonormal(prior_list[[par]])){ - transformed_samples <- temp_samples %*% t(contr.orthonormal(1:(.get_prior_factor_levels(prior_list[[par]])+1))) - }else if(is.prior.meandif(prior_list[[par]])){ - transformed_samples <- temp_samples %*% t(contr.meandif(1:(.get_prior_factor_levels(prior_list[[par]])+1))) - } - - # apply transformation if specified - if(!is.null(transformations[par])){ - for(i in 1:ncol(transformed_samples)){ - transformed_samples[,i] <- do.call(transformations[[par]][["fun"]], c(list(transformed_samples[,i]), transformations[[par]][["arg"]])) - } - } - - - if(.is_prior_interaction(prior_list[[par]])){ - if(length(.get_prior_factor_level_names(prior_list[[par]])) == 1){ - transformed_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]])[[1]],"]") - }else{ - stop("orthonormal/meandif de-transformation for interaction of multiple factors is not implemented.") - } - }else{ - transformed_names <- paste0(par, " [dif: ", .get_prior_factor_level_names(prior_list[[par]]),"]") - } - colnames(transformed_samples) <- transformed_names - - # place the transformed samples back - model_samples <- cbind( - if(temp_position > 1) model_samples[,1:(temp_position-1),drop=FALSE], - transformed_samples, - if(temp_position <= ncol(model_samples)) model_samples[,temp_position:ncol(model_samples),drop=FALSE] - ) - - } - } - - # rename treatment factor levels - if(any(sapply(prior_list, is.prior.treatment))){ - for(par in names(prior_list)[sapply(prior_list, is.prior.treatment)]){ - if(!.is_prior_interaction(prior_list[[par]])){ - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - colnames(model_samples)[colnames(model_samples) == par] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[-1], "]") - }else{ - colnames(model_samples)[colnames(model_samples) %in% paste0(par,"[",1:.get_prior_factor_levels(prior_list[[par]]),"]")] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[-1], "]") - } - }else if(length(attr(prior_list[[par]], "levels")) == 1){ - colnames(model_samples)[colnames(model_samples) %in% paste0(par,"[",1:.get_prior_factor_levels(prior_list[[par]]),"]")] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[[1]][-1], "]") - } - } - } + model_samples <- .transform_factor_contrasts(model_samples, prior_list, transform_factors, transformations) - # rename independent factor levels - if(any(sapply(prior_list, is.prior.independent))){ - for(par in names(prior_list)[sapply(prior_list, is.prior.independent)]){ - if(!.is_prior_interaction(prior_list[[par]])){ - if(.get_prior_factor_levels(prior_list[[par]]) == 1){ - colnames(model_samples)[colnames(model_samples) == par] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]]), "]") - }else{ - colnames(model_samples)[colnames(model_samples) %in% paste0(par,"[",1:.get_prior_factor_levels(prior_list[[par]]),"]")] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]]), "]") - } - }else if(length(attr(prior_list[[par]], "levels")) == 1){ - colnames(model_samples)[colnames(model_samples) %in% paste0(par,"[",1:.get_prior_factor_levels(prior_list[[par]]),"]")] <- - paste0(par,"[",.get_prior_factor_level_names(prior_list[[par]])[[1]], "]") - } - } - } + # rename factor levels + model_samples <- .rename_factor_levels(model_samples, prior_list) # store parameter names before removing formula attachments parameter_names <- colnames(model_samples) diff --git a/man/posterior_extraction_helpers.Rd b/man/posterior_extraction_helpers.Rd new file mode 100644 index 0000000..11f3b0e --- /dev/null +++ b/man/posterior_extraction_helpers.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/posterior-extraction.R +\name{posterior_extraction_helpers} +\alias{posterior_extraction_helpers} +\alias{.extract_posterior_samples} +\alias{.remove_auxiliary_parameters} +\alias{.process_spike_and_slab} +\alias{.apply_parameter_transformations} +\alias{.transform_factor_contrasts} +\alias{.rename_factor_levels} +\title{Helper functions for extracting and formatting posterior distributions} +\usage{ +.extract_posterior_samples(fit, as_list = FALSE) + +.remove_auxiliary_parameters( + model_samples, + prior_list, + remove_parameters = NULL +) + +.process_spike_and_slab( + model_samples, + prior_list, + par, + conditional = FALSE, + remove_inclusion = FALSE, + warnings = NULL +) + +.apply_parameter_transformations( + model_samples, + transformations, + prior_list, + transform_factors = FALSE +) + +.transform_factor_contrasts( + model_samples, + prior_list, + transform_factors = FALSE, + transformations = NULL +) + +.rename_factor_levels(model_samples, prior_list) +} +\arguments{ +\item{fit}{a JAGS model fit object} + +\item{as_list}{whether to return samples as mcmc.list (TRUE) or merged matrix (FALSE)} + +\item{model_samples}{matrix of posterior samples} + +\item{prior_list}{list of prior objects} + +\item{remove_parameters}{character vector of parameter names to remove} + +\item{par}{parameter name} + +\item{conditional}{whether to compute conditional summary} + +\item{remove_inclusion}{whether to remove inclusion indicators} + +\item{warnings}{character vector for collecting warnings} + +\item{transformations}{list of transformations to apply} + +\item{transform_factors}{whether to transform orthonormal/meandif to differences} +} +\value{ +matrix or mcmc.list of posterior samples + +list with cleaned model_samples and updated prior_list + +list with updated model_samples, prior_list, and warnings + +updated model_samples matrix + +updated model_samples matrix + +updated model_samples matrix with renamed columns +} +\description{ +Internal helper functions to extract posterior samples from JAGS +fits and reformat them for further processing (summary tables, diagnostics, plots). +These functions consolidate common logic that was duplicated across +\code{runjags_estimates_table}, \code{.diagnostics_plot_data}, and plotting functions. +} +\keyword{internal} diff --git a/tests/testthat/test-posterior-extraction.R b/tests/testthat/test-posterior-extraction.R new file mode 100644 index 0000000..22482aa --- /dev/null +++ b/tests/testthat/test-posterior-extraction.R @@ -0,0 +1,193 @@ +context("Posterior density extraction functions") + +# Tests for posterior extraction helper functions +test_that(".extract_posterior_samples extracts samples correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_not_installed("runjags") + + # Load runjags to ensure S3 methods are registered + library(runjags) + + # Create a proper runjags object structure for testing + # The runjags package has an as.mcmc method that handles mcmc.list objects + set.seed(123) + mcmc1 <- coda::mcmc(matrix(rnorm(100), ncol = 1, dimnames = list(NULL, "mu")), + start = 1, end = 100, thin = 1) + mcmc2 <- coda::mcmc(matrix(rnorm(100), ncol = 1, dimnames = list(NULL, "mu")), + start = 1, end = 100, thin = 1) + mcmc_list <- coda::mcmc.list(mcmc1, mcmc2) + + # Create a minimal runjags object + fit <- structure( + list(mcmc = mcmc_list), + class = c("runjags", "list") + ) + + # Test matrix extraction (as_list = FALSE) + # This calls coda::as.mcmc on the runjags object which returns an mcmc object + samples_matrix <- BayesTools:::.extract_posterior_samples(fit, as_list = FALSE) + # mcmc objects inherit from matrix + expect_true(inherits(samples_matrix, "mcmc")) + expect_equal(ncol(samples_matrix), 1) + expect_true("mu" %in% colnames(samples_matrix)) + expect_equal(nrow(samples_matrix), 200) # 100 samples x 2 chains merged + + # Test list extraction (as_list = TRUE) + samples_list <- BayesTools:::.extract_posterior_samples(fit, as_list = TRUE) + expect_true(inherits(samples_list, "mcmc.list")) + expect_equal(length(samples_list), 2) # 2 chains +}) + + +test_that(".remove_auxiliary_parameters removes invgamma support", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create mock samples with invgamma support parameter + model_samples <- matrix(rnorm(100), ncol = 2) + colnames(model_samples) <- c("sigma", "inv_sigma") + + prior_list <- list( + sigma = prior("invgamma", list(1, 1)) + ) + + result <- BayesTools:::.remove_auxiliary_parameters(model_samples, prior_list, NULL) + + expect_false("inv_sigma" %in% colnames(result$model_samples)) + expect_true("sigma" %in% colnames(result$model_samples)) +}) + + +test_that(".process_spike_and_slab handles conditional samples", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create mock samples with spike and slab + model_samples <- matrix(c( + rnorm(50, 0, 1), # mu values + rep(1, 50) # indicator (all in slab) + ), ncol = 2) + colnames(model_samples) <- c("mu", "mu_indicator") + + prior_list <- list( + mu = prior_spike_and_slab( + prior("normal", list(0, 1)), + prior_inclusion = prior("spike", list(0.5)) + ) + ) + + result <- BayesTools:::.process_spike_and_slab( + model_samples, prior_list, "mu", + conditional = TRUE, remove_inclusion = FALSE, warnings = NULL + ) + + expect_true("mu (inclusion)" %in% colnames(result$model_samples)) + expect_false("mu_indicator" %in% colnames(result$model_samples)) + expect_true(is.prior.simple(result$prior_list$mu)) +}) + + +test_that(".apply_parameter_transformations applies transformations", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create mock samples + model_samples <- matrix(rnorm(100, 0, 1), ncol = 1) + colnames(model_samples) <- "mu" + + prior_list <- list( + mu = prior("normal", list(0, 1)) + ) + + # Apply exp transformation + transformations <- list( + mu = list(fun = exp, arg = list()) + ) + + result <- BayesTools:::.apply_parameter_transformations( + model_samples, transformations, prior_list + ) + + expect_true(all(result[, "mu"] > 0)) # exp makes all values positive + expect_equal(ncol(result), 1) +}) + + +test_that(".rename_factor_levels renames treatment factors", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create mock samples with factor + model_samples <- matrix(rnorm(300), ncol = 3) + colnames(model_samples) <- c("group[1]", "group[2]", "group[3]") + + # Create a factor prior with levels attribute (as would be set by JAGS_formula) + prior_obj <- prior_factor("normal", list(0, 1), contrast = "treatment") + attr(prior_obj, "levels") <- 4 # 4 levels total (treatment has K-1 parameters for K levels) + attr(prior_obj, "level_names") <- c("A", "B", "C", "D") # Should be a vector, not a list + + prior_list <- list(group = prior_obj) + + result <- BayesTools:::.rename_factor_levels(model_samples, prior_list) + + expect_true("group[B]" %in% colnames(result)) + expect_true("group[C]" %in% colnames(result)) + expect_true("group[D]" %in% colnames(result)) + expect_false("group[1]" %in% colnames(result)) +}) + + +test_that(".transform_factor_contrasts transforms orthonormal to differences", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create mock samples with orthonormal contrasts + model_samples <- matrix(rnorm(300), ncol = 3) + colnames(model_samples) <- c("group[1]", "group[2]", "group[3]") + + # Create a factor prior with levels attribute (as would be set by JAGS_formula) + prior_obj <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + attr(prior_obj, "levels") <- 4 # 4 levels total (orthonormal has K-1 parameters for K levels) + attr(prior_obj, "level_names") <- c("A", "B", "C", "D") # Should be a vector, not a list + + prior_list <- list(group = prior_obj) + + expect_message( + result <- BayesTools:::.transform_factor_contrasts( + model_samples, prior_list, transform_factors = TRUE + ), + "transformation was applied" + ) + + # Should have 4 columns after transformation (one per level) + expect_equal(ncol(result), 4) + expect_true(any(grepl("dif:", colnames(result)))) +}) + + +test_that("helper functions work with runjags estimates extraction", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Test the helper functions with mock data (not full integration) + # This tests that our refactored code correctly uses the helpers + + # Create mock posterior samples + set.seed(123) + model_samples <- matrix(rnorm(200), ncol = 2, dimnames = list(NULL, c("mu", "inv_sigma"))) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("invgamma", list(1, 1)) + ) + + # Test that remove_auxiliary_parameters helper works + cleaned <- BayesTools:::.remove_auxiliary_parameters(model_samples, prior_list, NULL) + + # Should remove inv_sigma + expect_false("inv_sigma" %in% colnames(cleaned$model_samples)) + expect_true("mu" %in% colnames(cleaned$model_samples)) + expect_equal(ncol(cleaned$model_samples), 1) +}) From bb5a3b6609c694b96150a8af2c039456b840e255 Mon Sep 17 00:00:00 2001 From: Copilot <198982749+Copilot@users.noreply.github.com> Date: Tue, 9 Dec 2025 09:46:34 +0100 Subject: [PATCH 02/38] Add consolidated model fitting test file to unify all JAGS fitting tests (#49) --- tests/testthat/test-00-model-fits.R | 1263 +++++++++++++++++++++++++++ 1 file changed, 1263 insertions(+) create mode 100644 tests/testthat/test-00-model-fits.R diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R new file mode 100644 index 0000000..3e836eb --- /dev/null +++ b/tests/testthat/test-00-model-fits.R @@ -0,0 +1,1263 @@ +context("Model fits for reuse across tests") + +# This file contains all model fitting procedures used across the test suite. +# Fitted models are saved to a temporary directory for reuse in other tests. +# This reduces redundant MCMC sampling and speeds up the overall test suite. + +skip_on_cran() + +# Setup directory for saving fitted models +temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") +dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) +# Set environment variable so other test files can locate pre-fitted models +Sys.setenv(BAYESTOOLS_TEST_FITS_DIR = temp_fits_dir) + +# Initialize model registry to track metadata about each fitted model +model_registry <- list() + +# Helper function to save fitted models and register metadata +save_fit <- function(fit, name, simple_priors = FALSE, vector_priors = FALSE, + factor_priors = FALSE, pub_bias_priors = FALSE, + weightfunction_priors = FALSE, spike_and_slab_priors = FALSE, + mixture_priors = FALSE, formulas = FALSE, + random_effects = FALSE, interactions = FALSE, + expression_priors = FALSE, multi_formula = FALSE, + autofit = FALSE, parallel = FALSE, thinning = FALSE, + add_parameters = FALSE, note = "") { + saveRDS(fit, file = file.path(temp_fits_dir, paste0(name, ".RDS"))) + + # Return model metadata entry for registry + list( + fit = fit, + registry_entry = data.frame( + model_name = name, + simple_priors = simple_priors, + vector_priors = vector_priors, + factor_priors = factor_priors, + pub_bias_priors = pub_bias_priors, + weightfunction_priors = weightfunction_priors, + spike_and_slab_priors = spike_and_slab_priors, + mixture_priors = mixture_priors, + formulas = formulas, + random_effects = random_effects, + interactions = interactions, + expression_priors = expression_priors, + multi_formula = multi_formula, + autofit = autofit, + parallel = parallel, + thinning = thinning, + add_parameters = add_parameters, + note = note, + stringsAsFactors = FALSE + ) + ) +} + +# ============================================================================== +# SECTION 1: SIMPLE PRIOR DISTRIBUTIONS +# ============================================================================== +test_that("Simple prior models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data <- list( + x = rnorm(50, 0, .5), + N = 50 + ) + + # Model 1: Normal and truncated normal priors + priors_simple_normal <- list( + m = prior("normal", list(0, 1)), + s = prior("normal", list(0, 1), list(0, Inf)) + ) + model_syntax <- + "model + { + for(i in 1:N){ + x[i] ~ dnorm(m, pow(s, -2)) + } + }" + + fit_simple_normal <- JAGS_fit(model_syntax, data, priors_simple_normal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_simple_normal, "fit_simple_normal", + simple_priors = TRUE, + note = "Normal and truncated normal priors with data") + model_registry[["fit_simple_normal"]] <<- result$registry_entry + fit_simple_normal <- result$fit + + # Model 2: Various prior distributions + priors_various <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("lognormal", list(0, .5)), + p3 = prior("t", list(0, .5, 5)), + p4 = prior("Cauchy", list(1, 0.1), list(-10, 0)), + p5 = prior("gamma", list(2, 1)), + p6 = prior("invgamma", list(3, 2), list(1, 3)), + p7 = prior("exp", list(1.5)), + p8 = prior("beta", list(3, 2)), + p9 = prior("uniform", list(1, 5)), + p10 = prior("point", list(1)) + ) + + model_syntax_simple <- "model{}" + + fit_simple_various <- JAGS_fit(model_syntax_simple, data = list(), prior_list = priors_various, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_simple_various, "fit_simple_various", + simple_priors = TRUE, + note = "Various univariate distributions: normal, lognormal, t, Cauchy, gamma, invgamma, exp, beta, uniform, point") + model_registry[["fit_simple_various"]] <<- result$registry_entry + fit_simple_various <- result$fit + + # Model 3: PET and PEESE priors + priors_pub_bias <- list( + PET = prior_PET("normal", list(0, 1)), + PEESE = prior_PEESE("gamma", list(1, 1)) + ) + + model_syntax_pb <- "model{}" + + fit_simple_pub_bias <- JAGS_fit(model_syntax_pb, data = list(), prior_list = priors_pub_bias, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_simple_pub_bias, "fit_simple_pub_bias", + pub_bias_priors = TRUE, + note = "PET and PEESE priors for publication bias") + model_registry[["fit_simple_pub_bias"]] <<- result$registry_entry + fit_simple_pub_bias <- result$fit + + # Model 4: Test with thinning parameter + priors_thin <- list( + mu = prior("normal", list(0, 1)) + ) + model_syntax_thin <- "model{}" + + fit_simple_thin <- JAGS_fit(model_syntax_thin, data = list(), prior_list = priors_thin, + chains = 2, adapt = 100, burnin = 150, sample = 300, thin = 3, seed = 2) + result <- save_fit(fit_simple_thin, "fit_simple_thin", + simple_priors = TRUE, thinning = TRUE, + note = "Simple normal prior with thinning parameter (thin=3)") + model_registry[["fit_simple_thin"]] <<- result$registry_entry + fit_simple_thin <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_normal.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_various.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_pub_bias.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_thin.RDS"))) +}) + + +# ============================================================================== +# SECTION 2: VECTOR PRIOR DISTRIBUTIONS +# ============================================================================== +test_that("Vector prior models fit correctly", { + + skip_if_not_installed("rjags") + + # Multivariate normal + priors_mnormal <- list( + p1 = prior("mnormal", list(mean = 0, sd = 1, K = 3)) + ) + + model_syntax_vec <- "model{}" + + fit_vector_mnormal <- JAGS_fit(model_syntax_vec, data = list(), prior_list = priors_mnormal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_vector_mnormal, "fit_vector_mnormal", + vector_priors = TRUE, + note = "Multivariate normal prior (K=3)") + model_registry[["fit_vector_mnormal"]] <<- result$registry_entry + fit_vector_mnormal <- result$fit + + # Multivariate cauchy + priors_mcauchy <- list( + p1 = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)) + ) + + model_syntax_mc <- "model{}" + + fit_vector_mcauchy <- JAGS_fit(model_syntax_mc, data = list(), prior_list = priors_mcauchy, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_vector_mcauchy, "fit_vector_mcauchy", + vector_priors = TRUE, + note = "Multivariate Cauchy prior (K=2)") + model_registry[["fit_vector_mcauchy"]] <<- result$registry_entry + fit_vector_mcauchy <- result$fit + + # Multivariate t + priors_mt <- list( + p1 = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) + ) + + model_syntax_mt <- "model{}" + + fit_vector_mt <- JAGS_fit(model_syntax_mt, data = list(), prior_list = priors_mt, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_vector_mt, "fit_vector_mt", + vector_priors = TRUE, + note = "Multivariate t prior with df=5 (K=2)") + model_registry[["fit_vector_mt"]] <<- result$registry_entry + fit_vector_mt <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mnormal.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mcauchy.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mt.RDS"))) +}) + + +# ============================================================================== +# SECTION 3: FACTOR PRIOR DISTRIBUTIONS +# ============================================================================== +test_that("Factor prior models fit correctly", { + + skip_if_not_installed("rjags") + + # Orthonormal contrast + priors_orthonormal <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_orthonormal[[1]], "levels") <- 3 + + model_syntax_orth <- "model{}" + + fit_factor_orthonormal <- JAGS_fit(model_syntax_orth, data = list(), prior_list = priors_orthonormal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_factor_orthonormal, "fit_factor_orthonormal", + factor_priors = TRUE, + note = "Orthonormal contrast with 3 levels") + model_registry[["fit_factor_orthonormal"]] <<- result$registry_entry + fit_factor_orthonormal <- result$fit + + # Treatment contrast + priors_treatment <- list( + p1 = prior_factor("beta", list(alpha = 1, beta = 1), contrast = "treatment") + ) + attr(priors_treatment[[1]], "levels") <- 2 + + model_syntax_treat <- "model{}" + + fit_factor_treatment <- JAGS_fit(model_syntax_treat, data = list(), prior_list = priors_treatment, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_factor_treatment, "fit_factor_treatment", + factor_priors = TRUE, + note = "Treatment contrast with 2 levels and beta prior") + model_registry[["fit_factor_treatment"]] <<- result$registry_entry + fit_factor_treatment <- result$fit + + # Independent contrast + priors_independent <- list( + p1 = prior_factor("gamma", list(shape = 2, rate = 3), contrast = "independent") + ) + attr(priors_independent[[1]], "levels") <- 3 + + model_syntax_ind <- "model{}" + + fit_factor_independent <- JAGS_fit(model_syntax_ind, data = list(), prior_list = priors_independent, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_factor_independent, "fit_factor_independent", + factor_priors = TRUE, + note = "Independent contrast with 3 levels and gamma prior") + model_registry[["fit_factor_independent"]] <<- result$registry_entry + fit_factor_independent <- result$fit + + # Meandif contrast + priors_meandif <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 0.5), contrast = "meandif") + ) + attr(priors_meandif[[1]], "levels") <- 3 + + model_syntax_md <- "model{}" + + fit_factor_meandif <- JAGS_fit(model_syntax_md, data = list(), prior_list = priors_meandif, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) + result <- save_fit(fit_factor_meandif, "fit_factor_meandif", + factor_priors = TRUE, + note = "Meandif contrast with 3 levels") + model_registry[["fit_factor_meandif"]] <<- result$registry_entry + fit_factor_meandif <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_orthonormal.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_treatment.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_independent.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_meandif.RDS"))) +}) + + +# ============================================================================== +# SECTION 4: WEIGHTFUNCTION PRIORS +# ============================================================================== +test_that("Weightfunction prior models fit correctly", { + + skip_if_not_installed("rjags") + + # One-sided weightfunction (2 intervals) + priors_wf_onesided2 <- list( + prior_weightfunction("one.sided", list(c(.05), c(1, 1))) + ) + + model_syntax_wf1 <- "model{}" + + fit_weightfunction_onesided2 <- JAGS_fit(model_syntax_wf1, data = list(), prior_list = priors_wf_onesided2, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_weightfunction_onesided2, "fit_weightfunction_onesided2", + weightfunction_priors = TRUE, + note = "One-sided weightfunction with 2 intervals (cutpoint at .05)") + model_registry[["fit_weightfunction_onesided2"]] <<- result$registry_entry + fit_weightfunction_onesided2 <- result$fit + + # One-sided weightfunction (3 intervals) + priors_wf_onesided3 <- list( + prior_weightfunction("one.sided", list(c(.05, 0.10), c(1, 2, 3))) + ) + + model_syntax_wf2 <- "model{}" + + fit_weightfunction_onesided3 <- JAGS_fit(model_syntax_wf2, data = list(), prior_list = priors_wf_onesided3, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_weightfunction_onesided3, "fit_weightfunction_onesided3", + weightfunction_priors = TRUE, + note = "One-sided weightfunction with 3 intervals (cutpoints at .05, .10)") + model_registry[["fit_weightfunction_onesided3"]] <<- result$registry_entry + fit_weightfunction_onesided3 <- result$fit + + # Two-sided weightfunction + priors_wf_twosided <- list( + prior_weightfunction("two.sided", list(c(.05), c(1, 1))) + ) + + model_syntax_wf3 <- "model{}" + + fit_weightfunction_twosided <- JAGS_fit(model_syntax_wf3, data = list(), prior_list = priors_wf_twosided, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_weightfunction_twosided, "fit_weightfunction_twosided", + weightfunction_priors = TRUE, + note = "Two-sided weightfunction with cutpoint at .05") + model_registry[["fit_weightfunction_twosided"]] <<- result$registry_entry + fit_weightfunction_twosided <- result$fit + + # One-sided fixed weightfunction + priors_wf_fixed <- list( + prior_weightfunction("one.sided.fixed", list(c(.05), c(1, .5))) + ) + + model_syntax_wf4 <- "model{}" + + fit_weightfunction_fixed <- JAGS_fit(model_syntax_wf4, data = list(), prior_list = priors_wf_fixed, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) + result <- save_fit(fit_weightfunction_fixed, "fit_weightfunction_fixed", + weightfunction_priors = TRUE, + note = "One-sided fixed weightfunction (weights: 1, .5)") + model_registry[["fit_weightfunction_fixed"]] <<- result$registry_entry + fit_weightfunction_fixed <- result$fit + + # No weightfunction (prior_none) + priors_wf_none <- list( + omega = prior_none() + ) + + model_syntax_wf5 <- "model{}" + + fit_weightfunction_none <- JAGS_fit(model_syntax_wf5, data = list(), prior_list = priors_wf_none, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 5) + result <- save_fit(fit_weightfunction_none, "fit_weightfunction_none", + note = "No weightfunction using prior_none()") + model_registry[["fit_weightfunction_none"]] <<- result$registry_entry + fit_weightfunction_none <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided2.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided3.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_twosided.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_fixed.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_none.RDS"))) +}) + + +# ============================================================================== +# SECTION 5: SPIKE-AND-SLAB PRIORS +# ============================================================================== +test_that("Spike-and-slab prior models fit correctly", { + + skip_if_not_installed("rjags") + + # Simple spike-and-slab + priors_spike_slab_simple <- list( + "mu" = prior_spike_and_slab(prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1,1))) + ) + + model_syntax_ss1 <- "model{}" + + fit_spike_slab_simple <- JAGS_fit(model_syntax_ss1, data = list(), prior_list = priors_spike_slab_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_spike_slab_simple, "fit_spike_slab_simple", + spike_and_slab_priors = TRUE, + note = "Simple spike-and-slab with normal alternative and beta inclusion prior") + model_registry[["fit_spike_slab_simple"]] <<- result$registry_entry + fit_spike_slab_simple <- result$fit + + # Spike-and-slab with factor prior + priors_spike_slab_factor <- list( + "beta" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), + prior_inclusion = prior("beta", list(1,1))) + ) + + # Set levels attribute on the factor prior component within the spike_and_slab mixture + # The spike_and_slab prior contains multiple components; we need to set levels on the factor component + components <- attr(priors_spike_slab_factor$beta, "components") + alternative_idx <- which(components == "alternative") + # Set to 3 levels for a 3-level factor (A, B, C) + attr(priors_spike_slab_factor$beta[[alternative_idx]], "levels") <- 3 + + model_syntax_ss2 <- "model{}" + + fit_spike_slab_factor <- JAGS_fit(model_syntax_ss2, data = list(), prior_list = priors_spike_slab_factor, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_spike_slab_factor, "fit_spike_slab_factor", + spike_and_slab_priors = TRUE, factor_priors = TRUE, + note = "Spike-and-slab with orthonormal factor prior (3 levels) as alternative") + model_registry[["fit_spike_slab_factor"]] <<- result$registry_entry + fit_spike_slab_factor <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_slab_simple.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_slab_factor.RDS"))) +}) + + +# ============================================================================== +# SECTION 6: MIXTURE PRIORS +# ============================================================================== +test_that("Mixture prior models fit correctly", { + + skip_if_not_installed("rjags") + + # Simple mixture + priors_mixture_simple <- list( + "mu" = prior_mixture( + list( + prior("normal", list(0, 1), prior_weights = 1), + prior("normal", list(-3, 1), prior_weights = 5), + prior("gamma", list(5, 10), prior_weights = 1) + ), + is_null = c(T, F, T) + ) + ) + + model_syntax_mix1 <- "model{}" + + fit_mixture_simple <- JAGS_fit(model_syntax_mix1, data = list(), prior_list = priors_mixture_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_mixture_simple, "fit_mixture_simple", + mixture_priors = TRUE, + note = "Mixture of 3 components (2 normals, 1 gamma) with is_null flags") + model_registry[["fit_mixture_simple"]] <<- result$registry_entry + fit_mixture_simple <- result$fit + + # Mixture with components + priors_mixture_components <- list( + "beta" = prior_mixture( + list( + prior("normal", list(0, 1), prior_weights = 1), + prior("normal", list(-3, 1), prior_weights = 5) + ), + components = c("b", "a") + ) + ) + + model_syntax_mix2 <- "model{}" + + fit_mixture_components <- JAGS_fit(model_syntax_mix2, data = list(), prior_list = priors_mixture_components, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_mixture_components, "fit_mixture_components", + mixture_priors = TRUE, + note = "Mixture with named components (a, b)") + model_registry[["fit_mixture_components"]] <<- result$registry_entry + fit_mixture_components <- result$fit + + # Mixture with spike + priors_mixture_spike <- list( + "gamma" = prior_mixture( + list( + prior("spike", list(2)), + prior("normal", list(-3, 1)) + ) + ) + ) + + model_syntax_mix3 <- "model{}" + + fit_mixture_spike <- JAGS_fit(model_syntax_mix3, data = list(), prior_list = priors_mixture_spike, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_mixture_spike, "fit_mixture_spike", + mixture_priors = TRUE, + note = "Mixture containing spike prior at value 2") + model_registry[["fit_mixture_spike"]] <<- result$registry_entry + fit_mixture_spike <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_simple.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_components.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_spike.RDS"))) +}) + + +# ============================================================================== +# SECTION 7: FORMULA-BASED MODELS (SIMPLE REGRESSION) +# ============================================================================== +test_that("Simple formula-based regression models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_cont1 = rnorm(100), + x_fac2t = factor(rep(c("A", "B"), 50), levels = c("A", "B")), + x_fac3o = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")) + ) + data <- list( + y = rnorm(100, .4 * data_formula$x_cont1, 1), + N = 100 + ) + + # Simple linear regression + formula_list_simple <- list(mu = ~ x_cont1) + formula_data_list_simple <- list(mu = data_formula) + formula_prior_list_simple <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)) + ) + ) + prior_list_simple <- list(sigma = prior("lognormal", list(0, 1))) + + model_syntax_simple <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + + fit_formula_simple <- JAGS_fit( + model_syntax = model_syntax_simple, data = data, prior_list = prior_list_simple, + formula_list = formula_list_simple, formula_data_list = formula_data_list_simple, + formula_prior_list = formula_prior_list_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_formula_simple, "fit_formula_simple", + formulas = TRUE, simple_priors = TRUE, + note = "Simple linear regression with continuous predictor") + model_registry[["fit_formula_simple"]] <<- result$registry_entry + fit_formula_simple <- result$fit + + # Regression with treatment factor + formula_list_treatment <- list(mu = ~ x_cont1 + x_fac2t) + formula_data_list_treatment <- list(mu = data_formula) + formula_prior_list_treatment <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) + ) + ) + + fit_formula_treatment <- JAGS_fit( + model_syntax = model_syntax_simple, data = data, prior_list = prior_list_simple, + formula_list = formula_list_treatment, formula_data_list = formula_data_list_treatment, + formula_prior_list = formula_prior_list_treatment, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_formula_treatment, "fit_formula_treatment", + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with continuous predictor and 2-level treatment factor") + model_registry[["fit_formula_treatment"]] <<- result$registry_entry + fit_formula_treatment <- result$fit + + # Regression with orthonormal factor + formula_list_orthonormal <- list(mu = ~ x_cont1 + x_fac3o) + formula_data_list_orthonormal <- list(mu = data_formula) + formula_prior_list_orthonormal <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + ) + ) + + fit_formula_orthonormal <- JAGS_fit( + model_syntax = model_syntax_simple, data = data, prior_list = prior_list_simple, + formula_list = formula_list_orthonormal, formula_data_list = formula_data_list_orthonormal, + formula_prior_list = formula_prior_list_orthonormal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_formula_orthonormal, "fit_formula_orthonormal", + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with continuous predictor and 3-level orthonormal factor") + model_registry[["fit_formula_orthonormal"]] <<- result$registry_entry + fit_formula_orthonormal <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_simple.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_treatment.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS"))) +}) + + +# ============================================================================== +# SECTION 8: FORMULA-BASED MODELS (INTERACTIONS) +# ============================================================================== +test_that("Formula-based interaction models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_cont1 = rnorm(100), + x_cont2 = rnorm(100), + x_fac2t = factor(rep(c("A", "B"), 50), levels = c("A", "B")), + x_fac3o = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")) + ) + data <- list( + y = rnorm(100, .4 * data_formula$x_cont1 - 0.15 * data_formula$x_cont1 * data_formula$x_cont2, 1), + N = 100 + ) + + model_syntax <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + prior_list <- list(sigma = prior("lognormal", list(0, 1))) + + # Continuous interaction + formula_list_cont_int <- list(mu = ~ x_cont1 * x_cont2) + formula_data_list_cont_int <- list(mu = data_formula) + formula_prior_list_cont_int <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_cont2" = prior("normal", list(0, 1)), + "x_cont1:x_cont2" = prior("normal", list(0, 1)) + ) + ) + + fit_formula_interaction_cont <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_cont_int, formula_data_list = formula_data_list_cont_int, + formula_prior_list = formula_prior_list_cont_int, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_formula_interaction_cont, "fit_formula_interaction_cont", + formulas = TRUE, interactions = TRUE, simple_priors = TRUE, + note = "Continuous-continuous interaction") + model_registry[["fit_formula_interaction_cont"]] <<- result$registry_entry + fit_formula_interaction_cont <- result$fit + + # Continuous-factor interaction + formula_list_mix_int <- list(mu = ~ x_cont1 * x_fac3o) + formula_data_list_mix_int <- list(mu = data_formula) + formula_prior_list_mix_int <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), + "x_cont1:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + ) + ) + + fit_formula_interaction_mix <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_mix_int, formula_data_list = formula_data_list_mix_int, + formula_prior_list = formula_prior_list_mix_int, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_formula_interaction_mix, "fit_formula_interaction_mix", + formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Continuous-factor interaction with 3-level orthonormal factor") + model_registry[["fit_formula_interaction_mix"]] <<- result$registry_entry + fit_formula_interaction_mix <- result$fit + + # Factor-factor interaction + formula_list_fac_int <- list(mu = ~ x_fac2t * x_fac3o) + formula_data_list_fac_int <- list(mu = data_formula) + formula_prior_list_fac_int <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)), + "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), + "x_fac2t:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + ) + ) + + fit_formula_interaction_fac <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_fac_int, formula_data_list = formula_data_list_fac_int, + formula_prior_list = formula_prior_list_fac_int, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_formula_interaction_fac, "fit_formula_interaction_fac", + formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Factor-factor interaction: 2-level treatment x 3-level orthonormal") + model_registry[["fit_formula_interaction_fac"]] <<- result$registry_entry + fit_formula_interaction_fac <- result$fit + + # Regression with prior_mixture for factor predictor + # Testing mixture of spike and normal factor priors + set.seed(1) + data_formula_mix <- data.frame( + x_cont = rnorm(100), + x_fac3t = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")) + ) + data_mix <- list( + y = rnorm(100, 0.20 * data_formula_mix$x_cont, 1), + N = 100 + ) + + formula_list_factor_mix <- list(mu = ~ x_cont + x_fac3t) + formula_data_list_factor_mix <- list(mu = data_formula_mix) + formula_prior_list_factor_mix <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont" = prior("normal", list(0, 1)), + "x_fac3t" = prior_mixture(list( + prior("spike", list(0)), + prior_factor("normal", list(0, 0.3), contrast = "treatment") + ), is_null = c(TRUE, FALSE)) + ) + ) + + fit_formula_factor_mixture <- JAGS_fit( + model_syntax = model_syntax, data = data_mix, prior_list = prior_list, + formula_list = formula_list_factor_mix, formula_data_list = formula_data_list_factor_mix, + formula_prior_list = formula_prior_list_factor_mix, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) + result <- save_fit(fit_formula_factor_mixture, "fit_formula_factor_mixture", + formulas = TRUE, mixture_priors = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with mixture prior on 3-level treatment factor (spike vs normal)") + model_registry[["fit_formula_factor_mixture"]] <<- result$registry_entry + fit_formula_factor_mixture <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_cont.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_fac.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_factor_mixture.RDS"))) +}) + + +# ============================================================================== +# SECTION 9: FORMULA-BASED MODELS (MULTIPLE FORMULAS) +# ============================================================================== +test_that("Multi-formula models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_cont1 = rnorm(100), + x_fac2t = factor(rep(c("A", "B"), 50), levels = c("A", "B")) + ) + data_mu <- 0.20 * data_formula$x_cont1 + data_sigma <- 0.50 * exp(ifelse(data_formula$x_fac2t == "A", -0.5, 0.5)) + data <- list( + y = rnorm(100, data_mu, data_sigma), + N = 100 + ) + + # Model with two formulas (mu and sigma) + formula_list_multi <- list( + mu = ~ x_cont1, + sigma_exp = ~ x_fac2t + ) + formula_data_list_multi <- list( + mu = data_formula, + sigma_exp = data_formula + ) + formula_prior_list_multi <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)) + ), + sigma_exp = list( + "intercept" = prior("spike", list(0)), + "x_fac2t" = prior_factor("mnormal", list(0, 1), contrast = "meandif") + ) + ) + prior_list_multi <- list( + "sigma" = prior("normal", list(0, 5), list(0, Inf)) + ) + + model_syntax_multi <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma * exp(sigma_exp[i]), 2))\n", + "}\n", + "}" + ) + + fit_formula_multi <- JAGS_fit( + model_syntax = model_syntax_multi, data = data, prior_list = prior_list_multi, + formula_list = formula_list_multi, formula_data_list = formula_data_list_multi, + formula_prior_list = formula_prior_list_multi, + chains = 2, adapt = 500, burnin = 500, sample = 500, seed = 1) + result <- save_fit(fit_formula_multi, "fit_formula_multi", + formulas = TRUE, multi_formula = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Two formulas: mu (continuous) and sigma_exp (meandif factor)") + model_registry[["fit_formula_multi"]] <<- result$registry_entry + fit_formula_multi <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_multi.RDS"))) +}) + + +# ============================================================================== +# SECTION 10: RANDOM EFFECTS MODELS +# ============================================================================== +test_that("Random effects models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_cont1 = rnorm(100), + x_fac3 = as.factor(sample(LETTERS[1:3], 100, replace = TRUE)), + id = factor(rep(LETTERS[1:10], 10)) + ) + id_values <- rnorm(10, 0, 0.5) + names(id_values) <- LETTERS[1:10] + + data <- list( + y = rnorm(100, 0.4 * data_formula$x_cont1 + id_values[data_formula$id]), + N = 100 + ) + + model_syntax <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + prior_list <- list(sigma = prior("lognormal", list(0, 1))) + + # Random intercept only + # Note: Using || for uncorrelated random effects (as opposed to | for correlated) + formula_list_re_int <- list(mu = ~ 1 + (1 ||id)) + formula_data_list_re_int <- list(mu = data_formula) + formula_prior_list_re_int <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "intercept|id" = prior("normal", list(0, 1), list(0, 1)) + ) + ) + + fit_random_intercept <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_re_int, formula_data_list = formula_data_list_re_int, + formula_prior_list = formula_prior_list_re_int, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_random_intercept, "fit_random_intercept", + formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, + note = "Random intercept model (uncorrelated random effects)") + model_registry[["fit_random_intercept"]] <<- result$registry_entry + fit_random_intercept <- result$fit + + # Random slope (no intercept) + formula_list_re_slope <- list(mu = ~ 1 + (0 + x_cont1 ||id)) + formula_data_list_re_slope <- list(mu = data_formula) + formula_prior_list_re_slope <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1|id" = prior("normal", list(0, 1), list(0, 1)) + ) + ) + + fit_random_slope <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_re_slope, formula_data_list = formula_data_list_re_slope, + formula_prior_list = formula_prior_list_re_slope, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_random_slope, "fit_random_slope", + formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, + note = "Random slope for continuous predictor (no random intercept)") + model_registry[["fit_random_slope"]] <<- result$registry_entry + fit_random_slope <- result$fit + + # Random factor slope + formula_list_re_fac <- list(mu = ~ 1 + x_cont1 + (x_fac3 ||id)) + formula_data_list_re_fac <- list(mu = data_formula) + formula_prior_list_re_fac <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "intercept|id" = prior("normal", list(0, 1), list(0, 1)), + "x_fac3|id" = prior("normal", list(0, 1), list(0, 1)) + ) + ) + + fit_random_factor_slope <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_re_fac, formula_data_list = formula_data_list_re_fac, + formula_prior_list = formula_prior_list_re_fac, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_random_factor_slope, "fit_random_factor_slope", + formulas = TRUE, random_effects = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Random factor slopes with random intercept") + model_registry[["fit_random_factor_slope"]] <<- result$registry_entry + fit_random_factor_slope <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_intercept.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_slope.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope.RDS"))) +}) + + +# ============================================================================== +# SECTION 11: SPIKE FACTOR PRIORS +# ============================================================================== +test_that("Spike factor prior models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_fac2i = factor(rep(c("A", "B"), 50), levels = c("A", "B")), + x_fac3o = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")), + x_fac3t = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")), + x_fac3md = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")) + ) + data <- list(y = rnorm(100, 0, 1), N = 100) + + model_syntax <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + prior_list <- list(sigma = prior("lognormal", list(0, 1))) + + # Spike priors with different contrasts + # Note: Using - 1 to remove the intercept since spike priors for independent factors + # define all levels explicitly, and we're testing different contrast behaviors + formula_list_spike <- list(mu = ~ x_fac2i + x_fac3o + x_fac3t + x_fac3md - 1) + formula_data_list_spike <- list(mu = data_formula) + formula_prior_list_spike <- list( + mu = list( + "x_fac2i" = prior_factor("spike", contrast = "independent", list(1)), + "x_fac3o" = prior_factor("spike", contrast = "orthonormal", list(0)), + "x_fac3t" = prior_factor("spike", contrast = "treatment", list(2)), + "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) + ) + ) + + fit_spike_factors <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_spike, formula_data_list = formula_data_list_spike, + formula_prior_list = formula_prior_list_spike, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_spike_factors, "fit_spike_factors", + formulas = TRUE, factor_priors = TRUE, + note = "Spike priors with all 4 contrast types: independent, orthonormal, treatment, meandif") + model_registry[["fit_spike_factors"]] <<- result$registry_entry + fit_spike_factors <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors.RDS"))) +}) + + +# ============================================================================== +# SECTION 12: JOINT MODELS (FORMULA + SPIKE-AND-SLAB + MIXTURE) +# ============================================================================== +test_that("Joint complex models fit correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data_formula <- data.frame( + x_cont1 = rnorm(100), + x_fac2t = factor(rep(c("A", "B"), 50), levels = c("A", "B")), + x_fac3t = factor(rep(c("A", "B", "C"), length.out = 100), levels = c("A", "B", "C")) + ) + data <- list( + y = rnorm(100, 0.20 * data_formula$x_cont1, 1), + N = 100 + ) + + # Model with mixture intercept, spike-and-slab continuous, spike-and-slab factor + formula_list_joint <- list(mu = ~ x_cont1 + x_fac3t) + formula_data_list_joint <- list(mu = data_formula) + formula_prior_list_joint <- list( + mu = list( + "intercept" = prior_mixture( + list( + prior("spike", list(0), prior_weights = 2), + prior("normal", list(-1, 0.5), prior_weights = 1), + prior("normal", list( 1, 0.5), prior_weights = 1) + ), + is_null = c(T, F, F) + ), + "x_cont1" = prior_mixture( + list( + prior("spike", list(0), prior_weights = 1), + prior("normal", list(0, 1), prior_weights = 1) + ), + is_null = c(T, F) + ), + "x_fac3t" = prior_spike_and_slab( + prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), + prior_inclusion = prior("spike", list(0.5)) + ) + ) + ) + # Scale the continuous predictor by sigma (standard practice for hierarchical centering) + attr(formula_prior_list_joint$mu$x_cont1, "multiply_by") <- "sigma" + + prior_list_joint <- list( + "sigma" = prior_mixture( + list( + prior("normal", list(0, 1), truncation = list(0, Inf)), + prior("lognormal", list(0, 1)) + ), + is_null = c(T, F) + ) + ) + + model_syntax_joint <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + + fit_joint_complex <- JAGS_fit( + model_syntax = model_syntax_joint, data = data, prior_list = prior_list_joint, + formula_list = formula_list_joint, formula_data_list = formula_data_list_joint, + formula_prior_list = formula_prior_list_joint, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_joint_complex, "fit_joint_complex", + formulas = TRUE, mixture_priors = TRUE, spike_and_slab_priors = TRUE, + factor_priors = TRUE, simple_priors = TRUE, + note = "Complex model: mixture intercept, mixture sigma, spike-and-slab continuous, spike-and-slab factor") + model_registry[["fit_joint_complex"]] <<- result$registry_entry + fit_joint_complex <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_joint_complex.RDS"))) +}) + + +# ============================================================================== +# SECTION 13: EXPRESSION PRIORS +# ============================================================================== +test_that("Expression prior models fit correctly", { + + skip_if_not_installed("rjags") + + # Simple prior with expression + priors_expr_simple <- list( + x = prior("normal", list(0, expression(x_sigma))), + x_sigma = prior("invgamma", list(1/2, 1/2)) + ) + + model_syntax_expr1 <- "model{}" + + fit_expression_simple <- JAGS_fit(model_syntax_expr1, data = list(), prior_list = priors_expr_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + result <- save_fit(fit_expression_simple, "fit_expression_simple", + expression_priors = TRUE, simple_priors = TRUE, + note = "Normal prior with expression referencing another parameter (x_sigma)") + model_registry[["fit_expression_simple"]] <<- result$registry_entry + fit_expression_simple <- result$fit + + # Spike-and-slab with expression + priors_expr_ss <- list( + x = prior_spike_and_slab( + prior("normal", list(0, expression(x_sigma))) + ), + x_sigma = prior("invgamma", list(1/2, 1/2)) + ) + + model_syntax_expr2 <- "model{}" + + fit_expression_spike_slab <- JAGS_fit(model_syntax_expr2, data = list(), prior_list = priors_expr_ss, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + result <- save_fit(fit_expression_spike_slab, "fit_expression_spike_slab", + expression_priors = TRUE, spike_and_slab_priors = TRUE, simple_priors = TRUE, + note = "Spike-and-slab with expression in alternative prior") + model_registry[["fit_expression_spike_slab"]] <<- result$registry_entry + fit_expression_spike_slab <- result$fit + + # Mixture with expression + priors_expr_mix <- list( + x = prior_mixture(list( + prior("normal", list(0, expression(x_sigma))), + prior("cauchy", list(0, 1)) + ), is_null = c(T, F)), + x_sigma = prior("invgamma", list(1/2, 1/2)) + ) + + model_syntax_expr3 <- "model{}" + + fit_expression_mixture <- JAGS_fit(model_syntax_expr3, data = list(), prior_list = priors_expr_mix, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_expression_mixture, "fit_expression_mixture", + expression_priors = TRUE, mixture_priors = TRUE, simple_priors = TRUE, + note = "Mixture prior with expression in one component") + model_registry[["fit_expression_mixture"]] <<- result$registry_entry + fit_expression_mixture <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_simple.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_spike_slab.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_mixture.RDS"))) +}) + + +# ============================================================================== +# SECTION 14: ADVANCED JAGS_FIT FEATURES +# ============================================================================== +test_that("Advanced JAGS_fit features work correctly", { + + skip_if_not_installed("rjags") + + set.seed(1) + data <- list( + x = rnorm(20, 0, 1), + N = 20 + ) + priors_list <- list( + m = prior("normal", list(0, 1)), + s = prior("normal", list(0, 1), list(0, Inf)) + ) + model_syntax <- + "model + { + for(i in 1:N){ + x[i] ~ dnorm(m, pow(s, -2)) + } + }" + + # Test 1: add_parameters - monitoring additional parameters not in prior_list + model_syntax_add_param <- + "model + { + g ~ dnorm(0, 1) + for(i in 1:N){ + x[i] ~ dnorm(m, pow(s, -2)) + } + }" + + fit_add_parameters <- JAGS_fit(model_syntax_add_param, data, priors_list, + add_parameters = "g", + chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 1) + result <- save_fit(fit_add_parameters, "fit_add_parameters", + simple_priors = TRUE, add_parameters = TRUE, + note = "Model with additional monitored parameter 'g' not in prior_list") + model_registry[["fit_add_parameters"]] <<- result$registry_entry + fit_add_parameters <- result$fit + + # Verify that 'g' is in the output + expect_true("g" %in% colnames(fit_add_parameters$mcmc[[1]])) + expect_equal(ncol(fit_add_parameters$mcmc[[1]]), 3) # m, s, g + + # Test 2: autofit - automatic refitting until convergence + # Using a model that requires more samples to converge + priors_autofit <- list( + m = prior("normal", list(0, 1)) + ) + data_autofit <- list( + x = c(-500), + N = 1 + ) + model_syntax_autofit <- + "model + { + l = 1 + for(i in 1:N){ + x[i] ~ dt(m, pow(.3, -2), 1) + } + }" + + runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) + + # First fit without autofit (should have poor convergence) + fit_no_autofit <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, + autofit = FALSE, + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) + result <- save_fit(fit_no_autofit, "fit_no_autofit", + simple_priors = TRUE, + note = "Model without autofit (poor convergence expected)") + model_registry[["fit_no_autofit"]] <<- result$registry_entry + fit_no_autofit <- result$fit + + summary_no_autofit <- suppressWarnings(summary(fit_no_autofit)) + # Check that convergence is poor + expect_true(summary_no_autofit[1,"MCerr"] > 0.069 || summary_no_autofit[1,"MC%ofSD"] > 8) + + # Now fit with autofit using max_error criterion + fit_autofit_error <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, + autofit = TRUE, + autofit_control = list(max_error = 0.05, sample_extend = 100), + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) + result <- save_fit(fit_autofit_error, "fit_autofit_error", + simple_priors = TRUE, autofit = TRUE, + note = "Autofit with max_error criterion (< 0.05)") + model_registry[["fit_autofit_error"]] <<- result$registry_entry + fit_autofit_error <- result$fit + + summary_autofit_error <- summary(fit_autofit_error) + # Should have better convergence + expect_true(summary_autofit_error[1,"MCerr"] < 0.05) + + # Test autofit with min_ESS criterion + fit_autofit_ess <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, + autofit = TRUE, + autofit_control = list(min_ESS = 200, sample_extend = 100), + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 3) + result <- save_fit(fit_autofit_ess, "fit_autofit_ess", + simple_priors = TRUE, autofit = TRUE, + note = "Autofit with min_ESS criterion (> 200)") + model_registry[["fit_autofit_ess"]] <<- result$registry_entry + fit_autofit_ess <- result$fit + + summary_autofit_ess <- summary(fit_autofit_ess) + expect_true(summary_autofit_ess[1,"SSeff"] > 200) + + # Test 3: parallel - running chains in parallel + # Note: parallel execution is tested but results should be the same as non-parallel + fit_parallel <- JAGS_fit(model_syntax, data, priors_list, + parallel = TRUE, cores = 2, + chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 4) + result <- save_fit(fit_parallel, "fit_parallel", + simple_priors = TRUE, parallel = TRUE, + note = "Model fitted with parallel chains (cores=2)") + model_registry[["fit_parallel"]] <<- result$registry_entry + fit_parallel <- result$fit + + # Verify the fit worked and has the expected structure + expect_equal(length(fit_parallel$mcmc), 2) # 2 chains + expect_true(all(sapply(fit_parallel$mcmc, function(mcmc) ncol(mcmc) == 2))) # m and s + + expect_true(file.exists(file.path(temp_fits_dir, "fit_add_parameters.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_no_autofit.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_autofit_error.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_autofit_ess.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_parallel.RDS"))) +}) + + +# ============================================================================== +# SAVE MODEL REGISTRY +# ============================================================================== +# Convert the model registry list to a data frame for easy inspection and querying +test_that("Model registry is created and saved", { + + skip_on_cran() + + # Combine all registry entries into a single data frame + model_registry_df <- do.call(rbind, model_registry) + rownames(model_registry_df) <- NULL + + # Save the registry alongside the fitted models + registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + saveRDS(model_registry_df, registry_file) + + # Verify registry was created + expect_true(file.exists(registry_file)) + expect_s3_class(model_registry_df, "data.frame") + expect_true(nrow(model_registry_df) > 0) +}) + From e24efd15fe424cf4b5aee8ce42340614cb4b9ffd Mon Sep 17 00:00:00 2001 From: Copilot <198982749+Copilot@users.noreply.github.com> Date: Tue, 9 Dec 2025 20:18:49 +0100 Subject: [PATCH 03/38] Refactor test-model-averaging.R and test-summary-tables.R to use prefitted models with pre-computed marginal likelihoods, centralize all model fitting, and add test organization guide (#52) --- tests/TEST_ORGANIZATION.md | 211 +++++ ...eraging-plot-ss-posterior-bias-pet.new.svg | 76 ++ ...ng-plot-ss-posterior-intercept-con.new.svg | 54 ++ ...raging-plot-ss-posterior-intercept.new.svg | 74 ++ ...raging-plot-ss-posterior-omega-con.new.svg | 728 ++++++++++++++++++ ...veraging-plot-ss-posterior-pet-con.new.svg | 384 +++++++++ ...-averaging-plot-ss-posterior-sigma.new.svg | 62 ++ ...ot-ss-posterior-weightfunction-con.new.svg | 59 ++ ...g-plot-ss-posterior-weightfunction.new.svg | 59 ++ ...ging-plot-ss-posterior-x-cont1-con.new.svg | 58 ++ ...veraging-plot-ss-posterior-x-cont1.new.svg | 78 ++ ...ging-plot-ss-posterior-x-fac2t-con.new.svg | 55 ++ ...veraging-plot-ss-posterior-x-fac2t.new.svg | 75 ++ ...ging-plot-ss-posterior-x-fac3t-con.new.svg | 62 ++ ...veraging-plot-ss-posterior-x-fac3t.new.svg | 80 ++ ...simple-plot-ss-posterior-intercept.new.svg | 54 ++ ...g-simple-plot-ss-posterior-x-cont1.new.svg | 58 ++ ...g-simple-plot-ss-posterior-x-fac3t.new.svg | 62 ++ .../model-averaging-formulas.new.svg | 256 ++++++ .../model-averaging-formulas.svg | 256 ++++++ .../model-averaging-simple-priors.new.svg | 269 +++++++ .../model-averaging-simple-priors.svg | 269 +++++++ tests/testthat/test-00-model-fits.R | 172 ++++- tests/testthat/test-model-averaging.R | 154 ++++ tests/testthat/test-summary-tables.R | 57 +- 25 files changed, 3685 insertions(+), 37 deletions(-) create mode 100644 tests/TEST_ORGANIZATION.md create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg create mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg create mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg create mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg create mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg diff --git a/tests/TEST_ORGANIZATION.md b/tests/TEST_ORGANIZATION.md new file mode 100644 index 0000000..050b72f --- /dev/null +++ b/tests/TEST_ORGANIZATION.md @@ -0,0 +1,211 @@ +# BayesTools Test Organization Guide + +## Overview + +This document describes the organization and maintenance of tests in the BayesTools package, specifically regarding model fitting and model averaging tests. + +## Key Principles + +### 1. Single Source of Truth for Model Fitting + +**All model fitting and marginal likelihood computation must be done in `test-00-model-fits.R`.** + +- `test-00-model-fits.R` is the **only** file that should: + - Fit JAGS models using `JAGS_fit()` + - Compute marginal likelihoods using `JAGS_bridgesampling()` + - Save fitted models as RDS files + - Save marginal likelihoods as separate RDS files + +- Other test files should: + - **Only load** pre-fitted models using `readRDS()` + - **Only load** pre-computed marginal likelihoods using `readRDS()` + - Test the functionality they are designed for (e.g., model averaging, plotting, etc.) + +### 2. Avoid Duplication + +**Before adding a new model to `test-00-model-fits.R`, check if a similar model already exists.** + +Models are considered duplicates if they have: +- The same model structure (same JAGS syntax) +- The same type of priors (even with different parameter values) +- The same data structure + +For example: +- ✅ GOOD: One model with normal prior `prior("normal", list(0, 1))` and another with spike prior `prior("spike", list(0))` +- ❌ BAD: Two models both with normal priors but different parameters `list(0, 1)` vs `list(0, 2)` + +### 3. Model Naming Convention + +Models in `test-00-model-fits.R` should follow this naming pattern: +- `fit_{category}_{descriptor}` + +Examples: +- `fit_simple_normal` - Simple model with normal priors +- `fit_simple_spike` - Simple model with spike prior +- `fit_formula_simple` - Formula-based model with simple regression +- `fit_formula_treatment` - Formula-based model with treatment factors + +### 4. Saving Models with Marginal Likelihoods + +When saving a model that has a marginal likelihood: + +```r +# Fit the model +fit_model_name <- JAGS_fit(...) + +# Compute marginal likelihood (only if model has data) +log_posterior <- function(parameters, data) { ... } +marglik_model_name <- JAGS_bridgesampling(fit_model_name, + log_posterior = log_posterior, + data = data, + prior_list = priors) + +# Save both +result <- save_fit(fit_model_name, "fit_model_name", + marglik = marglik_model_name, # Include marglik here + simple_priors = TRUE, + note = "Description of the model") +model_registry[["fit_model_name"]] <<- result$registry_entry +fit_model_name <- result$fit +``` + +This will save: +- `fit_model_name.RDS` - The fitted model +- `fit_model_name_marglik.RDS` - The marginal likelihood + +### 5. Loading Models in Other Tests + +In `test-model-averaging.R` and other test files: + +```r +# Load pre-fitted model +fit_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name.RDS")) + +# Load pre-computed marginal likelihood (if available) +marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.RDS")) + +# Use in tests +models <- list( + list(fit = fit_model_name, marglik = marglik_model_name, prior_weights = 1) +) +``` + +### 6. When Marginal Likelihoods Are Available + +Not all models have marginal likelihoods. Marginal likelihoods are only computed for models that: +- Have actual data (not empty `data = list()`) +- Have a proper log posterior function +- Are **NOT** spike-and-slab or mixture prior models (bridgesampling is not implemented for these) + +### 7. Test File Organization + +#### test-00-model-fits.R +- **Purpose**: Fit all models and compute marginal likelihoods +- **Run order**: Runs first (prefix `00-`) +- **Dependencies**: None +- **Outputs**: RDS files in temp directory + +#### test-model-averaging.R +- **Purpose**: Test model averaging functionality +- **Dependencies**: Requires `test-00-model-fits.R` to run first +- **Inputs**: Loads pre-fitted models and marginal likelihoods +- **Sections**: + 1. Basic function tests (no JAGS required) + 2. JAGS model averaging with pre-fitted models + +#### test-summary-tables.R +- **Purpose**: Test summary table formatting functions +- **Dependencies**: Requires `test-00-model-fits.R` to run first +- **Inputs**: Loads pre-fitted models and marginal likelihoods +- **Note**: Tests table output formatting, not raw object printing + +## Maintenance Checklist + +When adding a new test that requires model fitting: + +- [ ] Check if a similar model already exists in `test-00-model-fits.R` +- [ ] If not, add the model to `test-00-model-fits.R` (not to the test file itself) +- [ ] Compute and save marginal likelihood if the model has data +- [ ] Update the model registry +- [ ] Add file existence check at the end of the test block +- [ ] In your test file, load the pre-fitted model using `readRDS()` +- [ ] Load the pre-computed marginal likelihood if available +- [ ] Document the model purpose in the `note` parameter + +## Example: Adding a New Model for Model Averaging + +### Step 1: Add to test-00-model-fits.R + +```r +# In the appropriate section of test-00-model-fits.R + +# Model: Description +priors_new_model <- list( + param1 = prior("normal", list(0, 1)), + param2 = prior("gamma", list(2, 1)) +) + +model_syntax_new <- "model { ... }" +data_new <- list(y = ..., N = ...) + +fit_new_model <- JAGS_fit(model_syntax_new, data_new, priors_new_model, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + +# Compute marginal likelihood +log_posterior_new <- function(parameters, data) { + # Define log likelihood +} +marglik_new_model <- JAGS_bridgesampling(fit_new_model, + log_posterior = log_posterior_new, + data = data_new, + prior_list = priors_new_model) + +result <- save_fit(fit_new_model, "fit_new_model", + marglik = marglik_new_model, + simple_priors = TRUE, + note = "Description") +model_registry[["fit_new_model"]] <<- result$registry_entry +fit_new_model <- result$fit + +# Add to file existence check +expect_true(file.exists(file.path(temp_fits_dir, "fit_new_model.RDS"))) +``` + +### Step 2: Use in test-model-averaging.R + +```r +test_that("Test new model averaging", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Load pre-fitted model and marginal likelihood + fit_new_model <- readRDS(file.path(temp_fits_dir, "fit_new_model.RDS")) + marglik_new_model <- readRDS(file.path(temp_fits_dir, "fit_new_model_marglik.RDS")) + + # Load another model for comparison + fit_other_model <- readRDS(file.path(temp_fits_dir, "fit_other_model.RDS")) + marglik_other_model <- readRDS(file.path(temp_fits_dir, "fit_other_model_marglik.RDS")) + + # Create model list + models <- list( + list(fit = fit_new_model, marglik = marglik_new_model, prior_weights = 1), + list(fit = fit_other_model, marglik = marglik_other_model, prior_weights = 1) + ) + + # Test ensemble inference + inference <- ensemble_inference(model_list = models, ...) + + # Tests + expect_true(is.list(inference)) + # ... more tests +}) +``` + +## Benefits of This Organization + +1. **No duplication**: Each model is fitted exactly once +2. **Faster tests**: Pre-computed marginal likelihoods save time +3. **Easier maintenance**: Model definitions in one place +4. **Cleaner code**: Test files focus on testing, not setup +5. **Consistency**: All models use the same data and parameters across tests diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg new file mode 100644 index 0000000..dc9a7ce --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + +0 +1 +2 +3 + + + + + + + + + +0 +0.02 +0.04 +0.06 +0.08 +0.1 +0.12 +0.14 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg new file mode 100644 index 0000000..3eb9d44 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg new file mode 100644 index 0000000..ee8b34b --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg new file mode 100644 index 0000000..9d8b13a --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg @@ -0,0 +1,728 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +omega[0,0.025] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +5000 +10000 +15000 + + + + + + + + + + + + + + + + + + + + + + +omega[0.025,0.05] +omega[0.025,0.05] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +2000 +4000 +6000 +8000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0.05,0.975] +omega[0.05,0.975] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +2000 +4000 +6000 +8000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +omega[0,0.025] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +2000 +4000 +6000 +8000 + + + + + + + + + + + + + + + + + +omega[0.025,0.05] +omega[0.025,0.05] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +500 +1000 +2000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0.05,0.975] +omega[0.05,0.975] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +500 +1000 +1500 +2000 +2500 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +omega[0,0.025] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +1000 +2000 +3000 +4000 +5000 + + + + + + + + + + + + + + + + + +omega[0.025,0.05] +omega[0.025,0.05] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0.05,0.975] +omega[0.05,0.975] +Frequency + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg new file mode 100644 index 0000000..ca775a5 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg @@ -0,0 +1,384 @@ + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + + + +0 +2000 +6000 +10000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + + +0 +1000 +2000 +3000 +4000 +5000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + + + +0 +20 +40 +60 +80 +100 +120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg new file mode 100644 index 0000000..cecb8df --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + +0 +2 +4 +6 +8 +10 +12 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg new file mode 100644 index 0000000..1bdce00 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + + + +0 +0.05 +0.975 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg new file mode 100644 index 0000000..22398bc --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + + + +0 +0.05 +0.975 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg new file mode 100644 index 0000000..0a29d5d --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg new file mode 100644 index 0000000..4205eaf --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg new file mode 100644 index 0000000..c4dae9f --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + +-1 +0 +1 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + + + + A + B + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg new file mode 100644 index 0000000..25d5fb4 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + +Density + + + + +-1 +0 +1 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + + + A + B + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg new file mode 100644 index 0000000..abea367 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg new file mode 100644 index 0000000..3b44b5a --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg new file mode 100644 index 0000000..9c8a1c0 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +-2.0 +-1.5 +-1.0 +-0.5 +0.0 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg new file mode 100644 index 0000000..9df4cbd --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg new file mode 100644 index 0000000..5cdd89f --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg new file mode 100644 index 0000000..afb5849 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg @@ -0,0 +1,256 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 +mixed_posteriors$mu_x_cont1 +Frequency + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac2t +mixed_posteriors$mu_x_fac2t +Frequency + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac3o[1] +mixed_posteriors$mu_x_fac3o[, 1] +Frequency + + + + + + + + + + + +-0.1 +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac3o[2] +mixed_posteriors$mu_x_fac3o[, 2] +Frequency + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg new file mode 100644 index 0000000..ca2e5f5 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg @@ -0,0 +1,256 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 +mixed_posteriors$mu_x_cont1 +Frequency + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac2t +mixed_posteriors$mu_x_fac2t +Frequency + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac3o[1] +mixed_posteriors$mu_x_fac3o[, 1] +Frequency + + + + + + + + + + + +-0.1 +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_fac3o[2] +mixed_posteriors$mu_x_fac3o[, 2] +Frequency + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + +0 +200 +400 +600 +800 + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg new file mode 100644 index 0000000..1671f29 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg @@ -0,0 +1,269 @@ + + + + + + + + + + + + + + + + + + + +model-averaged (m) +mixed_posteriors$m +Frequency + + + + + + + +-0.1 +0.0 +0.1 +0.2 + + + + + + +0 +2000 +4000 +6000 +8000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +conditional (m) +mixed_posteriors_conditional$m +Frequency + + + + + + + +-0.1 +0.0 +0.1 +0.2 + + + + + + + + +0 +200 +400 +600 +800 +1200 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +model-averaged (s) +mixed_posteriors$s +Frequency + + + + + + + + + + +0.30 +0.35 +0.40 +0.45 +0.50 +0.55 +0.60 + + + + + +0 +500 +1000 +1500 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +conditional (s) +mixed_posteriors_conditional$s +Frequency + + + + + + + + + + +0.30 +0.35 +0.40 +0.45 +0.50 +0.55 +0.60 + + + + + +0 +500 +1000 +1500 + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg new file mode 100644 index 0000000..04a232c --- /dev/null +++ b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg @@ -0,0 +1,269 @@ + + + + + + + + + + + + + + + + + + + +model-averaged (m) +mixed_posteriors$m +Frequency + + + + + + + +-0.1 +0.0 +0.1 +0.2 + + + + + + +0 +2000 +4000 +6000 +8000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +conditional (m) +mixed_posteriors_conditional$m +Frequency + + + + + + + +-0.1 +0.0 +0.1 +0.2 + + + + + + + + +0 +200 +400 +600 +800 +1200 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +model-averaged (s) +mixed_posteriors$s +Frequency + + + + + + + + + + +0.30 +0.35 +0.40 +0.45 +0.50 +0.55 +0.60 + + + + + +0 +500 +1000 +1500 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +conditional (s) +mixed_posteriors_conditional$s +Frequency + + + + + + + + + + +0.30 +0.35 +0.40 +0.45 +0.50 +0.55 +0.60 + + + + + +0 +500 +1000 +1500 + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 3e836eb..559bc7f 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -16,7 +16,7 @@ Sys.setenv(BAYESTOOLS_TEST_FITS_DIR = temp_fits_dir) model_registry <- list() # Helper function to save fitted models and register metadata -save_fit <- function(fit, name, simple_priors = FALSE, vector_priors = FALSE, +save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_priors = FALSE, factor_priors = FALSE, pub_bias_priors = FALSE, weightfunction_priors = FALSE, spike_and_slab_priors = FALSE, mixture_priors = FALSE, formulas = FALSE, @@ -25,12 +25,19 @@ save_fit <- function(fit, name, simple_priors = FALSE, vector_priors = FALSE, autofit = FALSE, parallel = FALSE, thinning = FALSE, add_parameters = FALSE, note = "") { saveRDS(fit, file = file.path(temp_fits_dir, paste0(name, ".RDS"))) + + # Save marglik if provided + if (!is.null(marglik)) { + saveRDS(marglik, file = file.path(temp_fits_dir, paste0(name, "_marglik.RDS"))) + } # Return model metadata entry for registry list( fit = fit, + marglik = marglik, registry_entry = data.frame( model_name = name, + has_marglik = !is.null(marglik), simple_priors = simple_priors, vector_priors = vector_priors, factor_priors = factor_priors, @@ -59,6 +66,7 @@ save_fit <- function(fit, name, simple_priors = FALSE, vector_priors = FALSE, test_that("Simple prior models fit correctly", { skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") set.seed(1) data <- list( @@ -81,13 +89,44 @@ test_that("Simple prior models fit correctly", { fit_simple_normal <- JAGS_fit(model_syntax, data, priors_simple_normal, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + + # Compute marginal likelihood for model averaging + log_posterior_simple_normal <- function(parameters, data){ + sum(stats::dnorm(data$x, parameters[["m"]], parameters[["s"]], log = TRUE)) + } + marglik_simple_normal <- JAGS_bridgesampling(fit_simple_normal, + log_posterior = log_posterior_simple_normal, + data = data, prior_list = priors_simple_normal) + result <- save_fit(fit_simple_normal, "fit_simple_normal", + marglik = marglik_simple_normal, simple_priors = TRUE, note = "Normal and truncated normal priors with data") model_registry[["fit_simple_normal"]] <<- result$registry_entry fit_simple_normal <- result$fit - # Model 2: Various prior distributions + # Model 2: Spike and normal priors (for model averaging) + priors_simple_spike <- list( + m = prior("spike", list(0)), + s = prior("normal", list(0, 1), list(0, Inf)) + ) + + fit_simple_spike <- JAGS_fit(model_syntax, data, priors_simple_spike, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + # Compute marginal likelihood for model averaging + marglik_simple_spike <- JAGS_bridgesampling(fit_simple_spike, + log_posterior = log_posterior_simple_normal, + data = data, prior_list = priors_simple_spike) + + result <- save_fit(fit_simple_spike, "fit_simple_spike", + marglik = marglik_simple_spike, + simple_priors = TRUE, + note = "Spike and truncated normal priors with data (for model averaging)") + model_registry[["fit_simple_spike"]] <<- result$registry_entry + fit_simple_spike <- result$fit + + # Model 3: Various prior distributions priors_various <- list( p1 = prior("normal", list(0, 1)), p2 = prior("lognormal", list(0, .5)), @@ -111,7 +150,7 @@ test_that("Simple prior models fit correctly", { model_registry[["fit_simple_various"]] <<- result$registry_entry fit_simple_various <- result$fit - # Model 3: PET and PEESE priors + # Model 4: PET and PEESE priors priors_pub_bias <- list( PET = prior_PET("normal", list(0, 1)), PEESE = prior_PEESE("gamma", list(1, 1)) @@ -127,7 +166,7 @@ test_that("Simple prior models fit correctly", { model_registry[["fit_simple_pub_bias"]] <<- result$registry_entry fit_simple_pub_bias <- result$fit - # Model 4: Test with thinning parameter + # Model 5: Test with thinning parameter priors_thin <- list( mu = prior("normal", list(0, 1)) ) @@ -142,12 +181,106 @@ test_that("Simple prior models fit correctly", { fit_simple_thin <- result$fit expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_normal.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_spike.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_various.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_pub_bias.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_thin.RDS"))) }) +# ============================================================================== +# SECTION 1B: MODELS FOR SUMMARY TABLES TESTING +# ============================================================================== +test_that("Summary tables models fit correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + set.seed(1) + data_summary <- list( + x = rnorm(20, 0, 1), + N = 20 + ) + + model_syntax_summary <- + "model + { + for(i in 1:N){ + x[i] ~ dnorm(m, 1) + } + }" + + # Log posterior for summary tables (constant, no data dependency) + log_posterior_summary <- function(parameters, data){ + return(0) + } + + # Model 1: Normal prior with prior_none weightfunction + priors_summary0 <- list( + m = prior("normal", list(0, 1)), + omega = prior_none() + ) + + fit_summary0 <- JAGS_fit(model_syntax_summary, data_summary, priors_summary0, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 0) + + marglik_summary0 <- JAGS_bridgesampling(fit_summary0, + log_posterior = log_posterior_summary, + data = data_summary, prior_list = priors_summary0) + + result <- save_fit(fit_summary0, "fit_summary0", + marglik = marglik_summary0, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with no weightfunction") + model_registry[["fit_summary0"]] <<- result$registry_entry + fit_summary0 <- result$fit + + # Model 2: Normal prior with one-sided weightfunction (2 intervals) + priors_summary1 <- list( + m = prior("normal", list(0, .5)), + omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + ) + + fit_summary1 <- JAGS_fit(model_syntax_summary, data_summary, priors_summary1, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) + + marglik_summary1 <- JAGS_bridgesampling(fit_summary1, + log_posterior = log_posterior_summary, + data = data_summary, prior_list = priors_summary1) + + result <- save_fit(fit_summary1, "fit_summary1", + marglik = marglik_summary1, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with one-sided weightfunction (cutpoint at .05)") + model_registry[["fit_summary1"]] <<- result$registry_entry + fit_summary1 <- result$fit + + # Model 3: Normal prior with one-sided weightfunction (3 intervals) + priors_summary2 <- list( + m = prior("normal", list(0, .3)), + omega = prior_weightfunction("one.sided", list(c(0.05, 0.50), c(1, 1, 1))) + ) + + fit_summary2 <- JAGS_fit(model_syntax_summary, data_summary, priors_summary2, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) + + marglik_summary2 <- JAGS_bridgesampling(fit_summary2, + log_posterior = log_posterior_summary, + data = data_summary, prior_list = priors_summary2) + + result <- save_fit(fit_summary2, "fit_summary2", + marglik = marglik_summary2, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with one-sided weightfunction (cutpoints at .05, .50)") + model_registry[["fit_summary2"]] <<- result$registry_entry + fit_summary2 <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_summary0.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_summary1.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_summary2.RDS"))) +}) + + # ============================================================================== # SECTION 2: VECTOR PRIOR DISTRIBUTIONS # ============================================================================== @@ -506,6 +639,7 @@ test_that("Mixture prior models fit correctly", { test_that("Simple formula-based regression models fit correctly", { skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") set.seed(1) data_formula <- data.frame( @@ -542,7 +676,19 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_simple, formula_data_list = formula_data_list_simple, formula_prior_list = formula_prior_list_simple, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + + # Compute marginal likelihood for model averaging + log_posterior_formula <- function(parameters, data){ + sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) + } + marglik_formula_simple <- JAGS_bridgesampling( + fit_formula_simple, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list_simple, + formula_list = formula_list_simple, formula_data_list = formula_data_list_simple, + formula_prior_list = formula_prior_list_simple) + result <- save_fit(fit_formula_simple, "fit_formula_simple", + marglik = marglik_formula_simple, formulas = TRUE, simple_priors = TRUE, note = "Simple linear regression with continuous predictor") model_registry[["fit_formula_simple"]] <<- result$registry_entry @@ -564,7 +710,16 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_treatment, formula_data_list = formula_data_list_treatment, formula_prior_list = formula_prior_list_treatment, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + # Compute marginal likelihood for model averaging + marglik_formula_treatment <- JAGS_bridgesampling( + fit_formula_treatment, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list_simple, + formula_list = formula_list_treatment, formula_data_list = formula_data_list_treatment, + formula_prior_list = formula_prior_list_treatment) + result <- save_fit(fit_formula_treatment, "fit_formula_treatment", + marglik = marglik_formula_treatment, formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, note = "Regression with continuous predictor and 2-level treatment factor") model_registry[["fit_formula_treatment"]] <<- result$registry_entry @@ -586,7 +741,16 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_orthonormal, formula_data_list = formula_data_list_orthonormal, formula_prior_list = formula_prior_list_orthonormal, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + + # Compute marginal likelihood for model averaging + marglik_formula_orthonormal <- JAGS_bridgesampling( + fit_formula_orthonormal, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list_simple, + formula_list = formula_list_orthonormal, formula_data_list = formula_data_list_orthonormal, + formula_prior_list = formula_prior_list_orthonormal) + result <- save_fit(fit_formula_orthonormal, "fit_formula_orthonormal", + marglik = marglik_formula_orthonormal, formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, note = "Regression with continuous predictor and 3-level orthonormal factor") model_registry[["fit_formula_orthonormal"]] <<- result$registry_entry diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R index 9b03f1c..3a272ca 100644 --- a/tests/testthat/test-model-averaging.R +++ b/tests/testthat/test-model-averaging.R @@ -1,5 +1,8 @@ context("Model-averaging functions") +# ============================================================================== +# SECTION 1: BASIC MODEL-AVERAGING FUNCTIONS (NO JAGS FITS) +# ============================================================================== test_that("Model-averaging functions work", { expect_equal(compute_inference(c(1,1), c(1, 1))$prior_probs, c(0.5, 0.5)) @@ -62,3 +65,154 @@ test_that("Model-averaging functions work", { prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.05, 0.10)), prior_weights = 1/2) )), list(NULL, c(2, 1, 1), c(3, 2, 1))) }) + + +# ============================================================================== +# SECTION 2: JAGS MODEL-AVERAGING WITH PREFITTED MODELS +# ============================================================================== +# Skip on CRAN as these tests use pre-fitted models +skip_on_cran() + +# Get the directory where prefitted models are stored +# First check environment variable, then fall back to standard temp directory +temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") +if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { + temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") +} +if (!dir.exists(temp_fits_dir)) { + skip("Pre-fitted models not available. Run test-00-model-fits.R first.") +} + +test_that("JAGS model-averaging with simple priors", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Load pre-fitted models and their marginal likelihoods + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + # Create model list + models <- list( + list(fit = fit_simple_spike, marglik = marglik_spike, prior_weights = 1), + list(fit = fit_simple_normal, marglik = marglik_normal, prior_weights = 1) + ) + + # Test ensemble inference + inference <- ensemble_inference(model_list = models, parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), conditional = FALSE) + inference_conditional <- ensemble_inference(model_list = models, parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), conditional = TRUE) + + # Test mix posteriors + mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), seed = 1) + mixed_posteriors_conditional <- mix_posteriors(model_list = models, parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), conditional = TRUE, seed = 1) + + # Checks + expect_true(is.list(inference)) + expect_true(all(c("m", "s") %in% names(inference))) + expect_true(is.numeric(inference$m$BF)) + expect_true(is.numeric(inference$s$BF)) + expect_equal(length(mixed_posteriors$m), length(mixed_posteriors$s)) + expect_true(mean(mixed_posteriors$m == 0) > 0) # Some spike samples + + # Visual check + vdiffr::expect_doppelganger("model-averaging-simple-priors", function(){ + par(mfrow = c(2, 2)) + hist(mixed_posteriors$m, main = "model-averaged (m)") + hist(mixed_posteriors_conditional$m, main = "conditional (m)") + hist(mixed_posteriors$s, main = "model-averaged (s)") + hist(mixed_posteriors_conditional$s, main = "conditional (s)") + }) +}) + +test_that("JAGS model-averaging with weightfunction priors - coefficient mapping", { + + skip_if_not_installed("rjags") + + # Test coefficient mapping with weightfunctions (doesn't require actual model averaging) + priors_none <- prior_none() + priors_onesided2 <- prior_weightfunction("one.sided", list(c(.05), c(1, 1))) + priors_onesided3 <- prior_weightfunction("one.sided", list(c(.05, 0.10), c(1, 2, 3))) + priors_twosided <- prior_weightfunction("two.sided", list(c(.05), c(1, 1))) + + # Test coefficient mapping + expect_equal( + weightfunctions_mapping(list(priors_none, priors_onesided2, priors_onesided3)), + list(NULL, c(2, 1, 1), c(3, 2, 1)) + ) + + expect_equal( + weightfunctions_mapping(list(priors_twosided, priors_onesided3)), + list(c(2, 1, 1, 1, 2), c(3, 3, 2, 1, 1)) + ) +}) + +test_that("JAGS model-averaging with formula models", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Load pre-fitted formula models with their marginal likelihoods + fit_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple.RDS")) + fit_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment.RDS")) + fit_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS")) + + marglik_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple_marglik.RDS")) + marglik_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment_marglik.RDS")) + marglik_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal_marglik.RDS")) + + # Create model list + models <- list( + list(fit = fit_formula_simple, marglik = marglik_simple, prior_weights = 1), + list(fit = fit_formula_treatment, marglik = marglik_treatment, prior_weights = 1), + list(fit = fit_formula_orthonormal, marglik = marglik_orthonormal, prior_weights = 1) + ) + + # Test ensemble inference + inference <- ensemble_inference( + model_list = models, + parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o"), + is_null_list = list( + "mu_x_cont1" = c(FALSE, FALSE, FALSE), + "mu_x_fac2t" = c(TRUE, FALSE, TRUE), + "mu_x_fac3o" = c(TRUE, TRUE, FALSE) + ), + conditional = FALSE) + + # Test mix posteriors + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o"), + is_null_list = list( + "mu_x_cont1" = c(FALSE, FALSE, FALSE), + "mu_x_fac2t" = c(TRUE, FALSE, TRUE), + "mu_x_fac3o" = c(TRUE, TRUE, FALSE) + ), + seed = 1, n_samples = 1000) + + # Checks + expect_true(is.list(inference)) + expect_true(all(c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o") %in% names(inference))) + expect_true(is.numeric(inference$mu_x_cont1$BF)) + expect_true(is.numeric(inference$mu_x_fac2t$BF)) + expect_true(is.numeric(inference$mu_x_fac3o$BF)) + # Allow for small difference in sample size due to spike samples + expect_true(abs(length(mixed_posteriors$mu_x_cont1) - 1000) <= 1) + + # Visual check + vdiffr::expect_doppelganger("model-averaging-formulas", function(){ + par(mfrow = c(2, 2)) + hist(mixed_posteriors$mu_x_cont1, main = "mu_x_cont1") + hist(mixed_posteriors$mu_x_fac2t, main = "mu_x_fac2t") + if(is.matrix(mixed_posteriors$mu_x_fac3o)) { + hist(mixed_posteriors$mu_x_fac3o[,1], main = "mu_x_fac3o[1]") + hist(mixed_posteriors$mu_x_fac3o[,2], main = "mu_x_fac3o[2]") + } + }) +}) diff --git a/tests/testthat/test-summary-tables.R b/tests/testthat/test-summary-tables.R index 9c6657c..edde826 100644 --- a/tests/testthat/test-summary-tables.R +++ b/tests/testthat/test-summary-tables.R @@ -1,41 +1,32 @@ context("Summary tables functions") +# Get the directory where prefitted models are stored +temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") +if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { + temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") +} + test_that("Summary tables functions work",{ - runjags::runjags.options(silent.jags = T, silent.runjags = T) - set.seed(1) - data <- list( - x = rnorm(20, 0, 1), - N = 20 - ) - priors_list0 <- list( - m =prior("normal", list(0, 1)), - omega = prior_none() - ) - priors_list1 <- list( - m = prior("normal", list(0, .5)), - omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - ) - priors_list2 <- list( - m = prior("normal", list(0, .3)), - omega = prior_weightfunction("one.sided", list(c(0.05, 0.50), c(1, 1, 1))) - ) - model_syntax <- - "model - { - for(i in 1:N){ - x[i] ~ dnorm(m, 1) - } - }" - log_posterior <- function(parameters, data){ - return(0) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + if (!dir.exists(temp_fits_dir)) { + skip("Pre-fitted models not available. Run test-00-model-fits.R first.") } - fit0 <- JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 0) - fit1 <- JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - fit2 <- JAGS_fit(model_syntax, data, priors_list2, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) - marglik2 <- JAGS_bridgesampling(fit2, log_posterior = log_posterior, data = data, prior_list = priors_list2) + + runjags::runjags.options(silent.jags = T, silent.runjags = T) + + # Load pre-fitted models and their marginal likelihoods + fit0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + fit2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) + marglik2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1, fit_summary = runjags_estimates_table(fit0)), list(fit = fit1, marglik = marglik1, prior_weights = 1, fit_summary = runjags_estimates_table(fit1)), From 1a41993d88d8c6e5d254eeaaaf8f1278b0a6713d Mon Sep 17 00:00:00 2001 From: Copilot <198982749+Copilot@users.noreply.github.com> Date: Wed, 10 Dec 2025 09:58:25 +0100 Subject: [PATCH 04/38] Refactor test-summary-tables.R to use prefitted models with file-based print testing (#53) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Initial plan * Update test-summary-tables.R to use prefitted models with file-based print testing - Created new test-summary-tables.R that uses prefitted models from test-00-model-fits.R - Implemented file-based print testing using saved reference files - Created generate_print_references.R script to generate reference output files - Added tests/results/print/ directory with reference files - Tests now cover multiple model types: simple priors, weightfunction, formulas, interactions, random effects, expressions - Note: Some model types in test-00-model-fits.R have issues with empty data lists that need separate fixing Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Add documentation and cleanup for test-summary-tables update - Added comprehensive README explaining changes and usage - Removed old backup file - Updated .gitignore to exclude backup files - Documented known issue with empty data lists in test-00-model-fits.R Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Address code review feedback: improve path handling and remove UPDATE_OUTPUT - Fixed .gitignore newline issue - Replaced read.table with readLines for simpler file reading - Use testthat::test_path for robust path resolution - Removed UPDATE_OUTPUT flag from test file (use generate_print_references.R instead) - Improved path handling in generate_print_references.R script - Updated README to reflect correct usage Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Fix consistency between file reading and writing methods - Changed generate_print_references.R to use writeLines instead of write.table - Regenerated reference files with consistent writeLines format - Updated README to show readLines in example (matching actual code) - Simplified path resolution in generate_print_references.R - Added clarifying comment about test_path() path construction Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Fix: use seq_along instead of 1:length for safer iteration - Changed loop in test-summary-tables.R to use seq_along(fits) to avoid issues with empty vectors - This follows R best practices and matches the pattern already used in generate_print_references.R Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Address PR feedback: consolidate tests and move generation to if(FALSE) block - Removed all class-only tests that didn't validate printed output - Consolidated all testing into single comprehensive print test - Moved generate_print_references.R content into test-summary-tables.R in if(FALSE) block - Expanded reference files from 6 to 16 to cover more table types - Tests now compare printed output for: weightfunction models, simple priors, transformations, and empty tables - Deleted standalone generate_print_references.R file Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Update README to reflect new test structure with if(FALSE) block - Documented that generation code is now in test file in if(FALSE) block - Updated instructions for regenerating reference files - Clarified that there are now 16 reference files covering more table types - Removed references to standalone generate_print_references.R script Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Add test and vignette organization instructions Added .github/instructions/tests.instructions.md and vignettes.instructions.md to provide guidelines for organizing tests and vignettes. Removed outdated TEST_ORGANIZATION.md and test-summary-tables-README.md. Refactored test-summary-tables.R to use a helper for reference file management, added configuration for reference file generation, and improved coverage for advanced table features and empty table cases. * finish summary tables --------- Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com> Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> Co-authored-by: František Bartoš --- .github/instructions/tests.instructions.md | 168 ++ .../instructions/vignettes.instructions.md | 355 ++++ .gitignore | 3 +- tests/TEST_ORGANIZATION.md | 211 --- .../advanced_conditional.txt | 6 + .../advanced_custom_probs.txt | 6 + .../advanced_custom_transform.txt | 2 + .../advanced_factor_treatment.txt | 2 + .../advanced_formula_prefix_false.txt | 6 + .../advanced_formula_prefix_true.txt | 6 + .../advanced_orthonormal_transform.txt | 4 + .../advanced_remove_inclusion.txt | 4 + .../advanced_spike_slab_estimates.txt | 4 + .../advanced_spike_slab_inference.txt | 2 + .../advanced_transform.txt | 6 + .../advanced_unconditional.txt | 6 + .../empty_ensemble_estimates.txt | 2 + .../empty_ensemble_inference.txt | 2 + .../empty_runjags_estimates.txt | 2 + .../fit_add_parameters_runjags_estimates.txt | 4 + .../fit_autofit_error_runjags_estimates.txt | 2 + .../fit_autofit_ess_runjags_estimates.txt | 2 + ...t_expression_mixture_runjags_estimates.txt | 4 + ...it_expression_simple_runjags_estimates.txt | 3 + ...xpression_spike_slab_runjags_estimates.txt | 4 + ...t_factor_independent_runjags_estimates.txt | 4 + .../fit_factor_meandif_runjags_estimates.txt | 3 + ...t_factor_orthonormal_runjags_estimates.txt | 3 + ...fit_factor_treatment_runjags_estimates.txt | 2 + ...rmula_factor_mixture_runjags_estimates.txt | 7 + ...ula_interaction_cont_runjags_estimates.txt | 6 + ...mula_interaction_fac_runjags_estimates.txt | 8 + ...mula_interaction_mix_runjags_estimates.txt | 8 + .../fit_formula_multi_runjags_estimates.txt | 5 + .../fit_formula_orthonormal_model_summary.txt | 6 + ..._formula_orthonormal_runjags_estimates.txt | 6 + .../fit_formula_simple_model_summary.txt | 6 + .../fit_formula_simple_runjags_estimates.txt | 4 + .../fit_formula_treatment_model_summary.txt | 6 + ...it_formula_treatment_runjags_estimates.txt | 5 + .../fit_joint_complex_runjags_estimates.txt | 10 + ...t_mixture_components_runjags_estimates.txt | 4 + .../fit_mixture_simple_runjags_estimates.txt | 3 + .../fit_mixture_spike_runjags_estimates.txt | 3 + .../fit_no_autofit_runjags_estimates.txt | 2 + .../fit_parallel_runjags_estimates.txt | 3 + ..._random_factor_slope_runjags_estimates.txt | 7 + ...fit_random_intercept_runjags_estimates.txt | 4 + .../fit_random_slope_runjags_estimates.txt | 4 + .../fit_simple_normal_model_summary.txt | 6 + .../fit_simple_normal_runjags_estimates.txt | 3 + .../fit_simple_pub_bias_runjags_estimates.txt | 3 + .../fit_simple_spike_model_summary.txt | 6 + .../fit_simple_spike_runjags_estimates.txt | 2 + .../fit_simple_thin_runjags_estimates.txt | 2 + .../fit_simple_various_runjags_estimates.txt | 11 + .../fit_spike_factors_runjags_estimates.txt | 6 + ...it_spike_slab_factor_runjags_estimates.txt | 4 + ...it_spike_slab_simple_runjags_estimates.txt | 3 + .../fit_summary0_model_summary.txt | 6 + .../fit_summary0_runjags_estimates.txt | 2 + .../fit_summary1_model_summary.txt | 6 + .../fit_summary1_runjags_estimates.txt | 4 + .../fit_summary2_model_summary.txt | 6 + .../fit_summary2_runjags_estimates.txt | 5 + .../fit_vector_mcauchy_runjags_estimates.txt | 3 + .../fit_vector_mnormal_runjags_estimates.txt | 4 + .../fit_vector_mt_runjags_estimates.txt | 3 + ...weightfunction_fixed_runjags_estimates.txt | 3 + ...htfunction_onesided2_runjags_estimates.txt | 3 + ...htfunction_onesided3_runjags_estimates.txt | 4 + ...ghtfunction_twosided_runjags_estimates.txt | 3 + tests/testthat/test-00-model-fits.R | 141 +- tests/testthat/test-JAGS-summary-tables.R | 211 +++ tests/testthat/test-summary-tables.R | 1454 ----------------- 75 files changed, 1095 insertions(+), 1744 deletions(-) create mode 100644 .github/instructions/tests.instructions.md create mode 100644 .github/instructions/vignettes.instructions.md delete mode 100644 tests/TEST_ORGANIZATION.md create mode 100644 tests/results/JAGS-summary-tables/advanced_conditional.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_custom_probs.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_custom_transform.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_factor_treatment.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_spike_slab_inference.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_transform.txt create mode 100644 tests/results/JAGS-summary-tables/advanced_unconditional.txt create mode 100644 tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/empty_ensemble_inference.txt create mode 100644 tests/results/JAGS-summary-tables/empty_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_orthonormal_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_simple_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_treatment_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_normal_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_spike_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary0_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary1_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary2_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt create mode 100644 tests/testthat/test-JAGS-summary-tables.R delete mode 100644 tests/testthat/test-summary-tables.R diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md new file mode 100644 index 0000000..7c4465c --- /dev/null +++ b/.github/instructions/tests.instructions.md @@ -0,0 +1,168 @@ +--- +applyTo: "**/tests/testthat/*.R" +description: Guidelines for organizing and maintaining tests in BayesTools, including model fitting, model averaging, and summary table tests. Ensures consistency and avoids duplication. +--- + +# BayesTools Test Organization Guidelines + +## Overview + +Tests in BayesTools follow a structured organization where model fitting is centralized in `test-00-model-fits.R` and consumed by other test files. This approach ensures consistency, avoids duplication, and speeds up test execution. + +## Key Principles + +### 1. Single Source of Truth for Model Fitting + +**All model fitting and marginal likelihood computation must be done in `test-00-model-fits.R`.** + +- `test-00-model-fits.R` is the **only** file that should: + - Fit JAGS models using `JAGS_fit()` + - Compute marginal likelihoods using `JAGS_bridgesampling()` + - Save fitted models as RDS files + - Save marginal likelihoods as separate RDS files + +- Other test files should: + - **Only load** pre-fitted models using `readRDS()` + - **Only load** pre-computed marginal likelihoods using `readRDS()` + - Test the functionality they are designed for (e.g., model averaging, plotting, etc.) + +### 2. Avoid Duplication + +**Before adding a new model to `test-00-model-fits.R`, check if a similar model already exists.** + +Models are duplicates if they have the same model structure, prior types, and data structure. Use one model per prior type. + +### 3. Model Naming Convention + +Use pattern: `fit_{category}_{descriptor}` (e.g., `fit_simple_normal`, `fit_formula_treatment`) + +**Model Registry**: `test-00-model-fits.R` maintains a registry of all fitted models in `model_registry.RDS`. Other test files should load this registry to discover available models rather than hardcoding model names: + +```r +registry_file <- file.path(temp_fits_dir, "model_registry.RDS") +model_registry <- readRDS(registry_file) +model_names <- model_registry$model_name +``` + +### 4. Saving and Loading Models + +```r +# In test-00-model-fits.R: Save with save_fit() helper +result <- save_fit(fit_model_name, "fit_model_name", + marglik = marglik_model_name, # If available + simple_priors = TRUE, note = "Description") + +# In other test files: Load with readRDS() +fit_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name.RDS")) +marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.RDS")) +``` + +**Note**: Marginal likelihoods are only computed for models with actual data (not spike-and-slab or mixture priors). + +### 5. Helper Functions for Reference Files + +**Use a helper function to reduce repetition** when saving/testing reference files: + +```r +# Define at the top of test files with reference outputs +test_reference <- function(table, filename, info_msg = NULL, + print_dir = testthat::test_path("..", "results", "print")) { + if (GENERATE_REFERENCE_FILES) { + # Save mode + if (!dir.exists(print_dir)) { + dir.create(print_dir, recursive = TRUE) + } + writeLines(capture_output_lines(table, print = TRUE, width = 150), + file.path(print_dir, filename)) + } else { + # Test mode + ref_file <- file.path(print_dir, filename) + if (file.exists(ref_file)) { + expected_output <- readLines(ref_file, warn = FALSE) + actual_output <- capture_output_lines(table, print = TRUE, width = 150) + expect_equal(actual_output, expected_output, info = info_msg) + } else { + skip(paste("Reference file", filename, "not found.")) + } + } +} +``` + +### 6. Test File Organization + +#### test-00-model-fits.R +- **Purpose**: Fit all models and compute marginal likelihoods +- **Run order**: First (prefix `00-`) +- **Outputs**: RDS files in `tempdir()` via `BAYESTOOLS_TEST_FITS_DIR` env var +- **Registry**: Maintains `model_registry` with model metadata + +#### Tests Using JAGS Models +All tests that use JAGS models (e.g., `test-model-averaging.R`, `test-JAGS-*.R`, `test-summary-tables.R`) must: +- Load pre-fitted models from `temp_fits_dir` using `readRDS()` +- **Never** fit models directly (only `test-00-model-fits.R` fits models) +- Check model availability with `if (!dir.exists(temp_fits_dir))` and skip appropriately +- Use `skip_if_not_installed("rjags")` and `skip_if_not_installed("bridgesampling")` + +**For tests with reference files** (e.g., `test-summary-tables.R`, visual regression tests): +- **Configuration**: `GENERATE_REFERENCE_FILES` flag (FALSE = test, TRUE = generate) + - **IMPORTANT**: **Never** modify this flag. Only the package maintainer changes this flag when intentionally updating reference files after format changes. + - Default value is `FALSE` (testing mode) + - Changing to `TRUE` regenerates all reference files (tables, figures, etc.) and should only be done by the maintainer +- **Outputs**: Reference files (`.txt`, `.svg`, `.png`, etc.) stored in `tests/results/` subdirectories + +## Maintenance Checklist + +**Adding a new model:** +- [ ] Check for duplicates in `test-00-model-fits.R` +- [ ] Add model to `test-00-model-fits.R` with `save_fit()` and appropriate metadata +**Using pre-fitted models:** +- [ ] Load with `readRDS()`, never fit models outside `test-00-model-fits.R` +- [ ] Add skip conditions for missing models/packages +- [ ] Check marginal likelihood file existence before loading + +**Updating summary table tests (MAINTAINER ONLY):** +- [ ] Set `GENERATE_REFERENCE_FILES <- TRUE` in `test-summary-tables.R` +- [ ] Run tests to generate reference files +- [ ] Review diffs carefully before committing +- [ ] Reset flag to `FALSE` +- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES`CE_FILES <- TRUE` in `test-summary-tables.R` +- [ ] Run tests to generate reference files +- [ ] Review diffs carefully before committing +- [ ] Reset flag to `FALSE` + +## Quick Examples + +### Adding and Using a Model + +```r +# 1. In test-00-model-fits.R +fit_new <- JAGS_fit(model_syntax, data, priors, ...) +marglik_new <- JAGS_bridgesampling(fit_new, log_posterior, data, priors) +result <- save_fit(fit_new, "fit_new", marglik = marglik_new, note = "Description") + +# 2. In any test file using JAGS models +fit_new <- readRDS(file.path(temp_fits_dir, "fit_new.RDS")) +marglik_file <- file.path(temp_fits_dir, "fit_new_marglik.RDS") +if (file.exists(marglik_file)) { + marglik_new <- readRDS(marglik_file) +} + +# 3. Add to test-summary-tables.R model_names vector +model_names <- c(..., "fit_new") +``` +## Common Pitfalls + +❌ Fitting models outside `test-00-model-fits.R` +❌ Creating duplicate models with different parameters +❌ **Modifying `GENERATE_REFERENCE_FILES` flag** (maintainer only) + +✅ Always load pre-fitted models with `readRDS()` +✅ Use one model per prior type +✅ Leave `GENERATE_REFERENCE_FILES <- FALSE` unchanged +✅ Set `GENERATE_REFERENCE_FILES <- TRUE` when updating formats +## Troubleshooting + +- **"Pre-fitted models not available"**: Run `devtools::test(filter = "00-model-fits")` +- **Summary table mismatch**: Contact maintainer; **do not** modify `GENERATE_REFERENCE_FILES` +- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture +- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture \ No newline at end of file diff --git a/.github/instructions/vignettes.instructions.md b/.github/instructions/vignettes.instructions.md new file mode 100644 index 0000000..8dc4e09 --- /dev/null +++ b/.github/instructions/vignettes.instructions.md @@ -0,0 +1,355 @@ +--- +applyTo: "**/vignettes/*.Rmd" +--- + +# Vignette Writing Instructions for RoBMA + +This document provides guidance for writing and maintaining vignettes in the RoBMA package. + +## Overview + +RoBMA vignettes are R Markdown documents that demonstrate package functionality with real-world examples. They are pre-computed and cached to avoid CRAN check timeouts, as Bayesian model fitting is computationally intensive. + +## Vignette Structure + +### Current Vignettes +1. **Tutorial.Rmd** - Introduction to RoBMA-PSMA (publication bias adjustment) +2. **ReproducingBMA.Rmd** - Classic Bayesian model-averaged meta-analysis (no publication bias) +3. **MetaRegression.Rmd** - `RoBMA.reg()` with moderators +4. **HierarchicalRoBMA.Rmd** - Multilevel RoBMA +5. **HierarchicalRoBMARegression.Rmd** - Multilevel RoBMA with moderators +6. **HierarchicalBMA.Rmd** - Simpler multilevel models via `study_ids` +7. **MedicineBMA.Rmd** - Informed priors for medical meta-analysis (continuous outcomes) +8. **MedicineBiBMA.Rmd** - Informed priors for binary outcomes (log OR, RR, RD, HR) +9. **CustomEnsembles.Rmd** - Advanced ensemble customization +10. **FastRoBMA.Rmd** - Spike-and-slab algorithm (`algorithm = "ss"`) +11. **ZCurveDiagnostics.Rmd** - Meta-analytic z-curve publication bias diagnostics + +## Standard YAML Header + +```yaml +--- +title: "Your Vignette Title" +author: "Author Name(s)" +date: "`r Sys.Date()`" # or fixed year for published papers +output: + rmarkdown::html_vignette: + self_contained: yes +bibliography: ../inst/REFERENCES.bib +csl: ../inst/apa.csl +vignette: > + %\VignetteIndexEntry{Your Vignette Title} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown_notangle} +--- +``` + +**Important**: Use `../inst/REFERENCES.bib` (relative path) for bibliography, not absolute paths. + +## Code Chunk Strategy (Pre-computation Pattern) + +All vignettes follow a **three-chunk pattern** to handle computationally expensive model fitting: + +### Chunk 1: Setup & Check Detection +```r +```{r setup, include = FALSE} +is_check <- ("CheckExEnv" %in% search()) || + any(c("_R_CHECK_TIMINGS_", "_R_CHECK_LICENSE_") %in% names(Sys.getenv())) || + !file.exists("../models/YourVignette/your_model.RDS") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = !is_check, + dev = "png") +if(.Platform$OS.type == "windows"){ + knitr::opts_chunk$set(dev.args = list(type = "cairo")) +} +``` +``` + +**Purpose**: Detect CRAN checks or missing cached models and disable evaluation to avoid timeouts. + +### Chunk 2: Load Pre-computed Models +```r +```{r include = FALSE} +library(RoBMA) +# Pre-load fitted models to avoid re-fitting during vignette build +fit_model <- readRDS(file = "../models/YourVignette/your_model.RDS") +``` +``` + +**Purpose**: Load cached model results silently (not shown to user). + +### Chunk 3: Model Fitting Code (Not Evaluated) +```r +```{r include = FALSE, eval = FALSE} +# R package version updating +library(RoBMA) + +# Actual model fitting code that was used to create cached models +fit_model <- RoBMA(d = data$d, se = data$se, seed = 1, parallel = TRUE) + +# Save for future vignette builds +saveRDS(fit_model, file = "../models/YourVignette/your_model.RDS") +``` +``` + +**Purpose**: Document the exact code used to generate cached models. This is **never evaluated** during package checks but serves as a record for updating models when package versions change. + +### Why This Pattern? + +- **CRAN compliance**: Vignettes must build in < 10 minutes; MCMC fitting takes much longer +- **Reproducibility**: Exact fitting code is preserved but not executed +- **Version tracking**: When RoBMA updates, re-run chunk 3 to regenerate all cached models +- **User clarity**: Users see the actual fitting code in chunk 3 (via `include = FALSE` it doesn't clutter output) + +## Model Caching Location + +All pre-computed models are stored in `models/` directory: +``` +models/ + Tutorial/ + fit_RoBMA_Lui2015.RDS + ReproducingBMA/ + PowerPoseTest.RDS + MetaRegression/ + fit_RoBMA.RDS + ... +``` + +- **Naming convention**: Use descriptive names (dataset + model type) +- **Compression**: Use `compress = "xz"` for large models: `saveRDS(fit, file = "path.RDS", compress = "xz")` +- **Git tracking**: Models are committed to the repository (not gitignored) + +## Code Presentation for Users + +Code that **users should see and run** goes in regular chunks: + +```r +```{r} +library(RoBMA) +data("Lui2015", package = "RoBMA") +head(Lui2015) +``` +``` + +**Never show** the model loading code (`readRDS()`) to users. They should see the fitting code from chunk 3. + +## Displaying Pre-computed Results + +After loading cached models with `readRDS()`, display them normally: + +```r +```{r} +# This uses the pre-loaded fit_model from chunk 2 +summary(fit_model) +plot(fit_model, parameter = "mu") +``` +``` + +Users see the output without knowing it came from cache. + +## Citations + +Use `\insertCite{key}{RoBMA}` for inline citations: +- `\insertCite{bartos2021no}{RoBMA}` → (Bartoš et al., 2021) +- `\insertCite{bartos2021no;textual}{RoBMA}` → Bartoš et al. (2021) + +Add new references to `inst/REFERENCES.bib`. The bibliography is automatically rendered at the end. + +## Code Style in Vignettes + +- **Function calls**: Use full argument names for clarity (no abbreviations) +- **Seeds**: Always set `seed = 1` (or another fixed value) for reproducibility +- **Parallel processing**: Use `parallel = TRUE` when fitting to speed up model generation +- **Save argument**: Consider `save = "min"` to reduce model size if posterior samples aren't needed + +### Example +```r +fit <- RoBMA( + d = data$effectSize, + se = data$SE, + seed = 1, + parallel = TRUE, + save = "min" # Reduces file size +) +``` + +## Figures + +- **Captions**: Use `fig.cap` for meaningful captions + ```r + ```{r, fig.cap="Forest Plot of Effect Sizes"} + forest(fit_model) + ``` + ``` +- **Size**: Let knitr use defaults; override only if necessary +- **Device**: The setup chunk handles Windows Cairo device automatically + +## Updating Vignettes for New Package Versions + +When RoBMA is updated and model structures change: + +1. **Identify affected vignettes** (check NEWS.md for breaking changes) +2. **Re-run chunk 3** in each affected vignette: + ```r + # Set eval = TRUE temporarily in chunk 3 header + ```{r include = FALSE, eval = TRUE} + ``` +3. **Verify outputs** match expectations +4. **Commit updated .RDS files** to `models/` +5. **Reset chunk 3** back to `eval = FALSE` +6. **Rebuild vignettes**: `devtools::build_vignettes()` + +## Testing Vignettes Locally + +```r +# Build all vignettes +devtools::build_vignettes() + +# Preview specific vignette +rmarkdown::render("vignettes/Tutorial.Rmd") + +# Check if vignettes build during R CMD check +devtools::check() +``` + +## Common Pitfalls + +❌ **Don't** use `library()` or `require()` in package functions (only in vignettes is OK) +❌ **Don't** use absolute paths (`C:/Users/...`) +❌ **Don't** commit temporary files (`.html` vignette outputs go to `doc/`) +❌ **Don't** use `eval = TRUE` in chunk 3 (model fitting) unless intentionally regenerating +✅ **Do** use relative paths (`../models/`, `../inst/`) +✅ **Do** compress models (`compress = "xz"`) +✅ **Do** test that vignettes build with `is_check = TRUE` condition (simulates CRAN) + +## Example Vignette Skeleton + +```rmd +--- +title: "My New RoBMA Vignette" +author: "Your Name" +date: "`r Sys.Date()`" +output: + rmarkdown::html_vignette: + self_contained: yes +bibliography: ../inst/REFERENCES.bib +csl: ../inst/apa.csl +vignette: > + %\VignetteIndexEntry{My New RoBMA Vignette} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +is_check <- ("CheckExEnv" %in% search()) || + any(c("_R_CHECK_TIMINGS_", "_R_CHECK_LICENSE_") %in% names(Sys.getenv())) || + !file.exists("../models/MyVignette/my_model.RDS") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = !is_check, + dev = "png") +if(.Platform$OS.type == "windows"){ + knitr::opts_chunk$set(dev.args = list(type = "cairo")) +} +``` + +```{r include = FALSE} +library(RoBMA) +my_model <- readRDS(file = "../models/MyVignette/my_model.RDS") +``` + +```{r include = FALSE, eval = FALSE} +library(RoBMA) +data("MyData", package = "RoBMA") + +my_model <- RoBMA(d = MyData$d, se = MyData$se, seed = 1, parallel = TRUE) +saveRDS(my_model, file = "../models/MyVignette/my_model.RDS") +``` + +## Introduction + +This vignette demonstrates... + +```{r} +library(RoBMA) +data("MyData", package = "RoBMA") +head(MyData) +``` + +## Analysis + +```{r} +summary(my_model) +``` + +## References +``` + +## Prose Editing Guidelines + +When editing vignette prose, follow the Eric-Jan Wagenmakers style: concise, direct, and logically structured. Clarify meaning, tighten flow, and preserve all scientific content. + +### Writing Style & Formatting +- **Concise and Direct**: Use simple sentences to describe outputs. Avoid flowery language or filler phrases. +- **No Excessive Bold**: Use bold text sparingly. Do not bold every list item or emphasis point. Use it only for headers or defining key terms. +- **Flowing Text**: Prefer paragraphs over bulleted lists when describing plots or outputs. Integrate the description into a narrative flow. +- **Interpretation Focused**: Focus on what the output *means* (interpretation) rather than just listing what is displayed. +- **Concrete Examples**: Use specific values from the example to illustrate points (e.g., "In our example, we find..."). +- **Technical but Accessible**: Use correct terminology (e.g., "heterogeneity allocation parameter") but explain it simply. + +### Non-Negotiables +- **Do not** add/remove references, change results, mathematical notation, or variable names +- **Preserve UI specifics exactly**: argument names like `priors_effect`, function names like `RoBMA.reg()`, parameter names like `mu`, `tau`, `omega` +- **Keep defined abbreviations**; spell out on first use (e.g., "Markov Chain Monte Carlo (MCMC)") +- **Prefer full terms**: "prior distributions" over "priors"; spell out "null hypothesis" and "alternative hypothesis" +- **Do not omit technical details**: exact argument labels, full file paths, figure references + +### Voice & Rhythm +- **Prefer passive tense** for objectivity, but use collaborative first-person plural ("we set...", "we estimate...") when it improves flow +- **Avoid "we... we..." runs**: vary sentence structure to maintain rhythm +- **Keep tone precise and readable**: cut redundancy, avoid filler phrases, use commas for disambiguation only + +### Editing Passes (Apply in Order) + +1. **Meaning**: Remove clutter; define key terms briefly when first introduced; add a concrete example if needed for clarity +2. **Structure**: Smooth transitions between paragraphs; align parallel or contrasting ideas; keep section logic tight +3. **Emphasis & Rhythm**: Place key words in strong positions (sentence start/end); use light anaphora/epistrophe only if it clarifies +4. **Style**: One tasteful rhetorical device per sentence at most (e.g., parallelism, anticipating objections); maintain EJW tone +5. **Polish**: Fix punctuation for disambiguation; correct typos quietly + +### Clarity Techniques (Use Sparingly) +- **Parallelism**: Align list items or related sentences for easier comparison +- **Procatalepsis**: Anticipate and answer likely reader objections in one sentence when helpful +- **Selective repetition**: Repeat key terms for emphasis, but avoid redundancy + +### Examples + +❌ **Verbose**: "In this section, we are going to discuss how to fit models using the RoBMA package" +✅ **Concise**: "We fit models using the `RoBMA()` function" + +❌ **Vague**: "We can use different priors for the analysis" +✅ **Specific**: "We specify prior distributions via the `priors_effect` and `priors_heterogeneity` arguments" + +❌ **Redundant**: "The results show that the effect is significant and statistically significant" +✅ **Tight**: "The effect is statistically significant" + +❌ **Cluttered**: "We can see from the output that..." +✅ **Direct**: "The output shows..." + +❌ **Excessive Bold/Lists**: +> This plot displays: +> - **x-axis**: One-sided *p*-value cutoffs +> - **y-axis**: Relative probability of publication + +✅ **Flowing Description**: +> The plot displays one-sided *p*-value cutoffs (x-axis) against relative publication probability (y-axis). + +## Additional Resources + +- [R Markdown Guide](https://rmarkdown.rstudio.com/articles_intro.html) +- [Vignette Best Practices](https://r-pkgs.org/vignettes.html) +- RoBMA paper: \insertCite{bartos2022adjusting}{RoBMA} diff --git a/.gitignore b/.gitignore index c80bee9..2d49b54 100644 --- a/.gitignore +++ b/.gitignore @@ -11,4 +11,5 @@ BayesTools.Rcheck ..Rcheck/ Rplots.pdf check/ -tests/vdiffr.Rout.fail \ No newline at end of file +tests/vdiffr.Rout.fail +tests/testthat/test-summary-tables-old.R diff --git a/tests/TEST_ORGANIZATION.md b/tests/TEST_ORGANIZATION.md deleted file mode 100644 index 050b72f..0000000 --- a/tests/TEST_ORGANIZATION.md +++ /dev/null @@ -1,211 +0,0 @@ -# BayesTools Test Organization Guide - -## Overview - -This document describes the organization and maintenance of tests in the BayesTools package, specifically regarding model fitting and model averaging tests. - -## Key Principles - -### 1. Single Source of Truth for Model Fitting - -**All model fitting and marginal likelihood computation must be done in `test-00-model-fits.R`.** - -- `test-00-model-fits.R` is the **only** file that should: - - Fit JAGS models using `JAGS_fit()` - - Compute marginal likelihoods using `JAGS_bridgesampling()` - - Save fitted models as RDS files - - Save marginal likelihoods as separate RDS files - -- Other test files should: - - **Only load** pre-fitted models using `readRDS()` - - **Only load** pre-computed marginal likelihoods using `readRDS()` - - Test the functionality they are designed for (e.g., model averaging, plotting, etc.) - -### 2. Avoid Duplication - -**Before adding a new model to `test-00-model-fits.R`, check if a similar model already exists.** - -Models are considered duplicates if they have: -- The same model structure (same JAGS syntax) -- The same type of priors (even with different parameter values) -- The same data structure - -For example: -- ✅ GOOD: One model with normal prior `prior("normal", list(0, 1))` and another with spike prior `prior("spike", list(0))` -- ❌ BAD: Two models both with normal priors but different parameters `list(0, 1)` vs `list(0, 2)` - -### 3. Model Naming Convention - -Models in `test-00-model-fits.R` should follow this naming pattern: -- `fit_{category}_{descriptor}` - -Examples: -- `fit_simple_normal` - Simple model with normal priors -- `fit_simple_spike` - Simple model with spike prior -- `fit_formula_simple` - Formula-based model with simple regression -- `fit_formula_treatment` - Formula-based model with treatment factors - -### 4. Saving Models with Marginal Likelihoods - -When saving a model that has a marginal likelihood: - -```r -# Fit the model -fit_model_name <- JAGS_fit(...) - -# Compute marginal likelihood (only if model has data) -log_posterior <- function(parameters, data) { ... } -marglik_model_name <- JAGS_bridgesampling(fit_model_name, - log_posterior = log_posterior, - data = data, - prior_list = priors) - -# Save both -result <- save_fit(fit_model_name, "fit_model_name", - marglik = marglik_model_name, # Include marglik here - simple_priors = TRUE, - note = "Description of the model") -model_registry[["fit_model_name"]] <<- result$registry_entry -fit_model_name <- result$fit -``` - -This will save: -- `fit_model_name.RDS` - The fitted model -- `fit_model_name_marglik.RDS` - The marginal likelihood - -### 5. Loading Models in Other Tests - -In `test-model-averaging.R` and other test files: - -```r -# Load pre-fitted model -fit_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name.RDS")) - -# Load pre-computed marginal likelihood (if available) -marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.RDS")) - -# Use in tests -models <- list( - list(fit = fit_model_name, marglik = marglik_model_name, prior_weights = 1) -) -``` - -### 6. When Marginal Likelihoods Are Available - -Not all models have marginal likelihoods. Marginal likelihoods are only computed for models that: -- Have actual data (not empty `data = list()`) -- Have a proper log posterior function -- Are **NOT** spike-and-slab or mixture prior models (bridgesampling is not implemented for these) - -### 7. Test File Organization - -#### test-00-model-fits.R -- **Purpose**: Fit all models and compute marginal likelihoods -- **Run order**: Runs first (prefix `00-`) -- **Dependencies**: None -- **Outputs**: RDS files in temp directory - -#### test-model-averaging.R -- **Purpose**: Test model averaging functionality -- **Dependencies**: Requires `test-00-model-fits.R` to run first -- **Inputs**: Loads pre-fitted models and marginal likelihoods -- **Sections**: - 1. Basic function tests (no JAGS required) - 2. JAGS model averaging with pre-fitted models - -#### test-summary-tables.R -- **Purpose**: Test summary table formatting functions -- **Dependencies**: Requires `test-00-model-fits.R` to run first -- **Inputs**: Loads pre-fitted models and marginal likelihoods -- **Note**: Tests table output formatting, not raw object printing - -## Maintenance Checklist - -When adding a new test that requires model fitting: - -- [ ] Check if a similar model already exists in `test-00-model-fits.R` -- [ ] If not, add the model to `test-00-model-fits.R` (not to the test file itself) -- [ ] Compute and save marginal likelihood if the model has data -- [ ] Update the model registry -- [ ] Add file existence check at the end of the test block -- [ ] In your test file, load the pre-fitted model using `readRDS()` -- [ ] Load the pre-computed marginal likelihood if available -- [ ] Document the model purpose in the `note` parameter - -## Example: Adding a New Model for Model Averaging - -### Step 1: Add to test-00-model-fits.R - -```r -# In the appropriate section of test-00-model-fits.R - -# Model: Description -priors_new_model <- list( - param1 = prior("normal", list(0, 1)), - param2 = prior("gamma", list(2, 1)) -) - -model_syntax_new <- "model { ... }" -data_new <- list(y = ..., N = ...) - -fit_new_model <- JAGS_fit(model_syntax_new, data_new, priors_new_model, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) - -# Compute marginal likelihood -log_posterior_new <- function(parameters, data) { - # Define log likelihood -} -marglik_new_model <- JAGS_bridgesampling(fit_new_model, - log_posterior = log_posterior_new, - data = data_new, - prior_list = priors_new_model) - -result <- save_fit(fit_new_model, "fit_new_model", - marglik = marglik_new_model, - simple_priors = TRUE, - note = "Description") -model_registry[["fit_new_model"]] <<- result$registry_entry -fit_new_model <- result$fit - -# Add to file existence check -expect_true(file.exists(file.path(temp_fits_dir, "fit_new_model.RDS"))) -``` - -### Step 2: Use in test-model-averaging.R - -```r -test_that("Test new model averaging", { - - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") - - # Load pre-fitted model and marginal likelihood - fit_new_model <- readRDS(file.path(temp_fits_dir, "fit_new_model.RDS")) - marglik_new_model <- readRDS(file.path(temp_fits_dir, "fit_new_model_marglik.RDS")) - - # Load another model for comparison - fit_other_model <- readRDS(file.path(temp_fits_dir, "fit_other_model.RDS")) - marglik_other_model <- readRDS(file.path(temp_fits_dir, "fit_other_model_marglik.RDS")) - - # Create model list - models <- list( - list(fit = fit_new_model, marglik = marglik_new_model, prior_weights = 1), - list(fit = fit_other_model, marglik = marglik_other_model, prior_weights = 1) - ) - - # Test ensemble inference - inference <- ensemble_inference(model_list = models, ...) - - # Tests - expect_true(is.list(inference)) - # ... more tests -}) -``` - -## Benefits of This Organization - -1. **No duplication**: Each model is fitted exactly once -2. **Faster tests**: Pre-computed marginal likelihoods save time -3. **Easier maintenance**: Model definitions in one place -4. **Cleaner code**: Test files focus on testing, not setup -5. **Consistency**: All models use the same data and parameters across tests diff --git a/tests/results/JAGS-summary-tables/advanced_conditional.txt b/tests/results/JAGS-summary-tables/advanced_conditional.txt new file mode 100644 index 0000000..3c43238 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_conditional.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI +(mu) intercept 0.035 0.104 -0.178 0.040 0.243 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 +sigma 1.040 0.077 0.905 1.033 1.203 diff --git a/tests/results/JAGS-summary-tables/advanced_custom_probs.txt b/tests/results/JAGS-summary-tables/advanced_custom_probs.txt new file mode 100644 index 0000000..3d5f3d2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_custom_probs.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_custom_transform.txt b/tests/results/JAGS-summary-tables/advanced_custom_transform.txt new file mode 100644 index 0000000..1612b96 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_custom_transform.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt b/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt new file mode 100644 index 0000000..1612b96 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt b/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt new file mode 100644 index 0000000..9229c5b --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 +x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt b/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt new file mode 100644 index 0000000..3d5f3d2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt new file mode 100644 index 0000000..cff708f --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 0.02589 0.032 1000 1.001 +p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 0.02517 0.032 1000 0.999 +p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 0.02565 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt b/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt new file mode 100644 index 0000000..f0c07d4 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI +beta [dif: 1] 0.008 0.811 -1.606 0.010 1.632 +beta [dif: 2] -0.049 0.842 -1.669 -0.084 1.618 +beta [dif: 3] 0.041 0.823 -1.482 0.029 1.751 diff --git a/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt b/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt new file mode 100644 index 0000000..c8bb523 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion) 0.527 NA NA NA NA NA NA NA NA +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_spike_slab_inference.txt b/tests/results/JAGS-summary-tables/advanced_spike_slab_inference.txt new file mode 100644 index 0000000..a335067 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_spike_slab_inference.txt @@ -0,0 +1,2 @@ + Prior prob. Post. prob. Inclusion BF +beta 0.500 0.527 1.114 diff --git a/tests/results/JAGS-summary-tables/advanced_transform.txt b/tests/results/JAGS-summary-tables/advanced_transform.txt new file mode 100644 index 0000000..f651959 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_transform.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 1.041 0.109 0.837 1.040 1.276 0.00365 0.034 901 1.001 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_unconditional.txt b/tests/results/JAGS-summary-tables/advanced_unconditional.txt new file mode 100644 index 0000000..3d5f3d2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_unconditional.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt b/tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt new file mode 100644 index 0000000..2d49d4b --- /dev/null +++ b/tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt @@ -0,0 +1,2 @@ +[1] Mean Median 0.025 0.95 +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/empty_ensemble_inference.txt b/tests/results/JAGS-summary-tables/empty_ensemble_inference.txt new file mode 100644 index 0000000..a6e4ded --- /dev/null +++ b/tests/results/JAGS-summary-tables/empty_ensemble_inference.txt @@ -0,0 +1,2 @@ +[1] Models Prior prob. Post. prob. Inclusion BF +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt b/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt new file mode 100644 index 0000000..ef5e212 --- /dev/null +++ b/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt @@ -0,0 +1,2 @@ +[1] Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt new file mode 100644 index 0000000..6bb0deb --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.168 0.209 -0.252 0.164 0.570 0.00854 0.041 600 1.004 +s 0.951 0.157 0.696 0.925 1.318 0.00861 0.055 332 1.002 +g 0.027 0.980 -1.774 -0.001 1.967 0.04004 0.041 600 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt new file mode 100644 index 0000000..b8c75bb --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m -0.034 1.003 -1.932 -0.060 2.012 0.04937 0.049 452 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt new file mode 100644 index 0000000..bc1644d --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.025 1.002 -1.701 -0.012 2.039 0.06445 0.064 249 0.998 diff --git a/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt new file mode 100644 index 0000000..7c2585f --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +x (inclusion) 0.466 NA NA NA NA NA NA NA NA +x 3457.005 110604.018 -62.527 -0.100 65.334 3497.63310 0.032 1000 1.291 +x_sigma 2009.580 44689.794 0.233 2.394 1843.054 1809.67684 0.040 804 1.287 diff --git a/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt new file mode 100644 index 0000000..61afab5 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +x 6283.001 208274.534 -129.928 -0.009 144.604 5394.96951 0.026 1307 1.192 +x_sigma 14992.279 321938.407 0.235 2.202 508.311 10181.93310 0.032 1000 1.236 diff --git a/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt new file mode 100644 index 0000000..a54dd03 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +x (inclusion) 0.530 NA NA NA NA NA NA NA NA +x 542.626 17568.812 -99.394 0.000 34.736 555.57478 0.032 1000 1.290 +x_sigma 3306.894 89013.203 0.158 2.367 831.086 2815.16476 0.032 1000 1.279 diff --git a/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt new file mode 100644 index 0000000..5960ff8 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.652 0.486 0.071 0.537 1.886 0.01604 0.033 925 0.999 +p1[2] 0.694 0.476 0.090 0.594 1.922 0.01442 0.030 1105 1.000 +p1[3] 0.685 0.483 0.085 0.595 1.948 0.01527 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt new file mode 100644 index 0000000..13ded9d --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.039 0.496 -0.986 0.060 0.937 0.01570 0.032 1000 1.000 +p1[2] -0.012 0.503 -0.967 -0.001 1.026 0.01590 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt new file mode 100644 index 0000000..52e0bfe --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.017 0.977 -1.862 0.031 1.936 0.03092 0.032 1000 1.000 +p1[2] 0.050 1.002 -1.998 0.074 1.966 0.03171 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt new file mode 100644 index 0000000..1612b96 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt new file mode 100644 index 0000000..f8d8234 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt @@ -0,0 +1,7 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.004 0.120 -0.218 -0.008 0.260 0.00568 0.047 447 1.000 +(mu) x_cont 0.195 0.112 -0.039 0.195 0.410 0.00354 0.032 1000 1.001 +(mu) x_fac3t (inclusion) 0.398 NA NA NA NA NA NA NA NA +(mu) x_fac3t[B] -0.082 0.154 -0.493 0.000 0.076 0.00716 0.046 465 1.001 +(mu) x_fac3t[C] -0.001 0.114 -0.260 0.000 0.278 0.00453 0.040 633 1.005 +sigma 0.972 0.072 0.847 0.967 1.128 0.00308 0.043 549 1.003 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt new file mode 100644 index 0000000..3d5f3d2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 +(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 +(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 +(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 +sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt new file mode 100644 index 0000000..582aa6f --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt @@ -0,0 +1,8 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.060 0.164 -0.251 0.062 0.400 0.00840 0.051 392 1.001 +(mu) x_fac2t[B] 0.046 0.228 -0.414 0.048 0.476 0.01168 0.051 381 0.999 +(mu) x_fac3o[1] -0.077 0.263 -0.585 -0.074 0.458 0.01262 0.048 437 0.999 +(mu) x_fac3o[2] -0.046 0.256 -0.544 -0.043 0.443 0.01299 0.051 389 1.002 +(mu) x_fac2t:x_fac3o[1] -0.002 0.358 -0.678 0.004 0.714 0.01623 0.045 487 1.000 +(mu) x_fac2t:x_fac3o[2] -0.122 0.367 -0.835 -0.134 0.596 0.01924 0.052 369 1.005 +sigma 1.167 0.087 1.007 1.162 1.358 0.00365 0.042 579 1.006 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt new file mode 100644 index 0000000..5b7ba70 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt @@ -0,0 +1,8 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.013 0.113 -0.197 0.016 0.234 0.00359 0.032 1000 1.002 +(mu) x_cont1 0.457 0.125 0.215 0.457 0.710 0.00411 0.033 928 1.000 +(mu) x_fac3o[1] 0.029 0.189 -0.334 0.026 0.417 0.00585 0.031 1045 1.000 +(mu) x_fac3o[2] -0.095 0.193 -0.465 -0.088 0.273 0.00610 0.032 1000 1.002 +(mu) x_cont1:x_fac3o[1] -0.221 0.220 -0.667 -0.211 0.216 0.00696 0.032 1000 1.000 +(mu) x_cont1:x_fac3o[2] -0.062 0.200 -0.442 -0.060 0.319 0.00655 0.033 938 1.000 +sigma 1.082 0.080 0.945 1.075 1.249 0.00294 0.037 726 1.019 diff --git a/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt new file mode 100644 index 0000000..cce5c63 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.014 0.039 -0.097 -0.013 0.061 0.00115 0.029 1187 1.001 +(mu) x_cont1 0.194 0.044 0.110 0.194 0.282 0.00142 0.032 1005 1.000 +(sigma_exp) x_fac2t 0.511 0.072 0.368 0.508 0.652 0.00533 0.074 183 1.002 +sigma 0.491 0.035 0.428 0.489 0.564 0.00148 0.043 550 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_formula_orthonormal_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_model_summary.txt new file mode 100644 index 0000000..16379db --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -148.68 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1) + Inclusion BF Inf sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt new file mode 100644 index 0000000..0cd322f --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.041 0.097 -0.226 -0.041 0.150 0.00306 0.032 1000 1.001 +(mu) x_cont1 0.401 0.107 0.193 0.405 0.600 0.00364 0.034 883 0.999 +(mu) x_fac3o[1] 0.187 0.168 -0.148 0.186 0.518 0.00604 0.036 818 1.008 +(mu) x_fac3o[2] 0.118 0.170 -0.217 0.127 0.431 0.00491 0.029 1284 1.003 +sigma 0.970 0.068 0.840 0.966 1.109 0.00303 0.044 505 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_formula_simple_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_simple_model_summary.txt new file mode 100644 index 0000000..99967c5 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_simple_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -146.01 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 sigma ~ Lognormal(0, 1) + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt new file mode 100644 index 0000000..5c41c2c --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.042 0.097 -0.242 -0.040 0.149 0.00308 0.032 1000 1.001 +(mu) x_cont1 0.391 0.108 0.183 0.393 0.603 0.00317 0.029 1218 1.000 +sigma 0.970 0.069 0.846 0.964 1.124 0.00267 0.039 674 1.016 diff --git a/tests/results/JAGS-summary-tables/fit_formula_treatment_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_treatment_model_summary.txt new file mode 100644 index 0000000..c45bd27 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_treatment_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -147.65 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_fac2t ~ treatment contrast: Normal(0, 1) + Inclusion BF Inf sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt new file mode 100644 index 0000000..d070a06 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.049 0.130 -0.299 -0.048 0.206 0.00679 0.052 371 1.004 +(mu) x_cont1 0.394 0.111 0.177 0.399 0.613 0.00351 0.032 1000 0.999 +(mu) x_fac2t[B] 0.019 0.182 -0.355 0.021 0.350 0.00950 0.052 380 1.005 +sigma 0.979 0.073 0.855 0.972 1.133 0.00346 0.047 457 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt new file mode 100644 index 0000000..3b9dc16 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt @@ -0,0 +1,10 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.027 NA NA NA NA NA NA NA NA +(mu) intercept -0.001 0.017 0.000 0.000 0.000 0.00052 0.030 1085 1.062 +(mu) x_cont1 (inclusion) 0.363 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.077 0.124 0.000 0.000 0.390 0.00569 0.046 471 1.009 +(mu) x_fac3t (inclusion) 0.066 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.007 0.049 0.000 0.000 0.126 0.00261 0.053 467 1.000 +(mu) x_fac3t[2] 0.008 0.051 0.000 0.000 0.167 0.00216 0.042 638 1.034 +sigma (inclusion) 0.495 NA NA NA NA NA NA NA NA +sigma 0.972 0.070 0.843 0.969 1.125 0.00250 0.036 815 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt new file mode 100644 index 0000000..030990e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion: b) 0.171 NA NA NA NA NA NA NA NA +beta (inclusion: a) 0.829 NA NA NA NA NA NA NA NA +beta -2.532 1.502 -4.985 -2.755 0.888 0.04607 0.031 1073 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt new file mode 100644 index 0000000..43fd1d5 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu (inclusion) 0.721 NA NA NA NA NA NA NA NA +mu -2.094 1.720 -4.668 -2.463 1.020 0.05747 0.033 908 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt new file mode 100644 index 0000000..6e9c0ae --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +gamma (inclusion) 1.000 NA NA NA NA NA NA NA NA +gamma -0.489 2.545 -4.498 -0.843 2.000 0.08051 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt new file mode 100644 index 0000000..1ebcd40 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.046 0.990 -1.728 0.000 2.114 0.09487 0.096 112 1.024 diff --git a/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt new file mode 100644 index 0000000..d41ce15 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.189 0.206 -0.229 0.185 0.621 0.00838 0.041 600 1.012 +s 0.946 0.157 0.689 0.928 1.309 0.00859 0.055 332 1.008 diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt new file mode 100644 index 0000000..8b0f29e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt @@ -0,0 +1,7 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.298 0.134 0.024 0.300 0.545 0.00668 0.050 419 1.014 +(mu) x_cont1 0.495 0.120 0.261 0.496 0.734 0.00379 0.032 1005 1.003 +sd((mu) intercept|id) 0.185 0.141 0.007 0.155 0.530 0.00690 0.049 418 1.001 +sd((mu) x_fac3[B]|id) 0.336 0.226 0.021 0.294 0.837 0.01145 0.051 395 1.002 +sd((mu) x_fac3[C]|id) 0.343 0.235 0.013 0.317 0.870 0.01117 0.048 444 1.000 +sigma 1.043 0.084 0.895 1.033 1.222 0.00365 0.044 544 1.009 diff --git a/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt new file mode 100644 index 0000000..591eba8 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.331 0.145 0.054 0.328 0.619 0.00590 0.041 603 1.027 +sd((mu) intercept|id) 0.195 0.148 0.008 0.166 0.578 0.00811 0.055 335 0.999 +sigma 1.152 0.081 1.004 1.149 1.319 0.00355 0.044 519 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt new file mode 100644 index 0000000..d64e1f6 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.326 0.109 0.117 0.327 0.536 0.00358 0.033 933 1.005 +sd((mu) x_cont1|id) 0.513 0.191 0.156 0.501 0.923 0.01198 0.063 256 1.000 +sigma 1.068 0.079 0.922 1.065 1.231 0.00408 0.052 377 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_simple_normal_model_summary.txt b/tests/results/JAGS-summary-tables/fit_simple_normal_model_summary.txt new file mode 100644 index 0000000..6db2929 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_normal_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 m ~ Normal(0, 1) + log(marglik) -31.95 s ~ Normal(0, 1)[0, Inf] + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt new file mode 100644 index 0000000..7d673c6 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt new file mode 100644 index 0000000..7585d05 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +PET 0.819 0.625 0.041 0.671 2.263 0.01978 0.032 1000 0.999 +PEESE 1.031 1.020 0.034 0.735 3.787 0.03222 0.032 1000 1.013 diff --git a/tests/results/JAGS-summary-tables/fit_simple_spike_model_summary.txt b/tests/results/JAGS-summary-tables/fit_simple_spike_model_summary.txt new file mode 100644 index 0000000..acc0bb8 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_spike_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt new file mode 100644 index 0000000..1e074a2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +s 0.423 0.043 0.352 0.420 0.514 0.00191 0.044 509 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt new file mode 100644 index 0000000..ccae69e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.033 1.031 -1.956 0.080 2.016 0.04722 0.046 496 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt new file mode 100644 index 0000000..e1ce884 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt @@ -0,0 +1,11 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1 0.038 1.023 -1.996 0.021 2.135 0.03234 0.032 1000 1.002 +p2 1.117 0.632 0.372 0.965 2.706 0.02082 0.033 919 1.005 +p3 -0.010 0.666 -1.270 -0.022 1.408 0.02265 0.034 886 1.001 +p4 -1.753 2.080 -7.718 -0.889 -0.032 0.06345 0.031 1126 1.001 +p5 2.009 1.378 0.235 1.755 5.459 0.04426 0.032 1000 1.003 +p6 1.547 0.492 1.011 1.399 2.785 0.01558 0.032 1000 0.999 +p7 0.657 0.606 0.013 0.497 2.274 0.01915 0.032 1000 1.008 +p8 0.608 0.194 0.223 0.615 0.939 0.00614 0.032 1000 1.000 +p9 3.018 1.158 1.103 3.006 4.904 0.03956 0.034 877 0.999 +p10 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt new file mode 100644 index 0000000..9ffa3ae --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) x_fac2i[A] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA +(mu) x_fac2i[B] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA +(mu) x_fac3t[B] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA +(mu) x_fac3t[C] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA +sigma 2.575 0.185 2.257 2.561 2.969 0.00853 0.046 557 1.043 diff --git a/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt new file mode 100644 index 0000000..c8bb523 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion) 0.527 NA NA NA NA NA NA NA NA +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt new file mode 100644 index 0000000..9f5d5b8 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu (inclusion) 0.504 NA NA NA NA NA NA NA NA +mu -0.003 0.666 -1.553 0.000 1.506 0.02105 0.032 1000 1.003 diff --git a/tests/results/JAGS-summary-tables/fit_summary0_model_summary.txt b/tests/results/JAGS-summary-tables/fit_summary0_model_summary.txt new file mode 100644 index 0000000..5015c4f --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary0_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 m ~ Normal(0, 1) + log(marglik) -1.11 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt new file mode 100644 index 0000000..171d74d --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.198 0.212 -0.204 0.193 0.632 0.01019 0.048 434 NA diff --git a/tests/results/JAGS-summary-tables/fit_summary1_model_summary.txt b/tests/results/JAGS-summary-tables/fit_summary1_model_summary.txt new file mode 100644 index 0000000..2cb3659 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary1_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 m ~ Normal(0, 0.5) + log(marglik) -0.54 omega[one-sided: .05] ~ CumDirichlet(1, 1) + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt new file mode 100644 index 0000000..564650e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.155 0.198 -0.247 0.167 0.497 0.00921 0.047 461 NA +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.509 0.301 0.028 0.508 0.983 0.01348 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_summary2_model_summary.txt b/tests/results/JAGS-summary-tables/fit_summary2_model_summary.txt new file mode 100644 index 0000000..7993fbd --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary2_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 m ~ Normal(0, 0.3) + log(marglik) -0.33 omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt new file mode 100644 index 0000000..9a0dc20 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.125 0.176 -0.202 0.128 0.479 0.00787 0.045 500 NA +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,0.5] 0.666 0.237 0.157 0.710 0.988 0.01061 0.045 500 NA +omega[0.5,1] 0.353 0.229 0.017 0.333 0.837 0.01023 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt new file mode 100644 index 0000000..173fd55 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] -0.227 16.382 -16.511 -0.071 18.750 0.51809 0.032 1000 1.031 +p1[2] 1.192 34.440 -15.713 -0.088 19.254 1.08910 0.032 1000 1.244 diff --git a/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt new file mode 100644 index 0000000..e3d0127 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.012 0.997 -1.956 0.042 1.967 0.03154 0.032 1000 1.001 +p1[2] -0.009 0.994 -1.884 -0.024 2.035 0.03144 0.032 1000 0.999 +p1[3] 0.010 0.988 -1.985 0.047 1.893 0.03124 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt new file mode 100644 index 0000000..1e411d9 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 1.990 0.627 0.887 1.974 3.230 0.01982 0.032 1000 1.002 +p1[2] 2.026 0.639 0.737 2.044 3.280 0.02022 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt new file mode 100644 index 0000000..9877c68 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.500 0.000 0.500 0.500 0.500 0.00000 NA 0 NA diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt new file mode 100644 index 0000000..dcfb027 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.510 0.283 0.037 0.525 0.968 0.00894 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt new file mode 100644 index 0000000..527e780 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,0.1] 0.834 0.145 0.467 0.871 0.994 0.00458 0.032 1000 1.001 +omega[0.1,1] 0.510 0.187 0.154 0.510 0.852 0.00592 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt new file mode 100644 index 0000000..acdcbe8 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.506 0.297 0.027 0.514 0.975 0.00998 0.034 896 1.002 diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 559bc7f..15c78aa 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -25,7 +25,7 @@ save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_pr autofit = FALSE, parallel = FALSE, thinning = FALSE, add_parameters = FALSE, note = "") { saveRDS(fit, file = file.path(temp_fits_dir, paste0(name, ".RDS"))) - + # Save marglik if provided if (!is.null(marglik)) { saveRDS(marglik, file = file.path(temp_fits_dir, paste0(name, "_marglik.RDS"))) @@ -89,15 +89,15 @@ test_that("Simple prior models fit correctly", { fit_simple_normal <- JAGS_fit(model_syntax, data, priors_simple_normal, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) - + # Compute marginal likelihood for model averaging log_posterior_simple_normal <- function(parameters, data){ sum(stats::dnorm(data$x, parameters[["m"]], parameters[["s"]], log = TRUE)) } - marglik_simple_normal <- JAGS_bridgesampling(fit_simple_normal, - log_posterior = log_posterior_simple_normal, + marglik_simple_normal <- JAGS_bridgesampling(fit_simple_normal, + log_posterior = log_posterior_simple_normal, data = data, prior_list = priors_simple_normal) - + result <- save_fit(fit_simple_normal, "fit_simple_normal", marglik = marglik_simple_normal, simple_priors = TRUE, @@ -110,15 +110,15 @@ test_that("Simple prior models fit correctly", { m = prior("spike", list(0)), s = prior("normal", list(0, 1), list(0, Inf)) ) - + fit_simple_spike <- JAGS_fit(model_syntax, data, priors_simple_spike, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - + # Compute marginal likelihood for model averaging - marglik_simple_spike <- JAGS_bridgesampling(fit_simple_spike, - log_posterior = log_posterior_simple_normal, + marglik_simple_spike <- JAGS_bridgesampling(fit_simple_spike, + log_posterior = log_posterior_simple_normal, data = data, prior_list = priors_simple_spike) - + result <- save_fit(fit_simple_spike, "fit_simple_spike", marglik = marglik_simple_spike, simple_priors = TRUE, @@ -142,8 +142,8 @@ test_that("Simple prior models fit correctly", { model_syntax_simple <- "model{}" - fit_simple_various <- JAGS_fit(model_syntax_simple, data = list(), prior_list = priors_various, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_simple_various <- suppressWarnings(JAGS_fit(model_syntax_simple, data = NULL, prior_list = priors_various, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_simple_various, "fit_simple_various", simple_priors = TRUE, note = "Various univariate distributions: normal, lognormal, t, Cauchy, gamma, invgamma, exp, beta, uniform, point") @@ -158,8 +158,8 @@ test_that("Simple prior models fit correctly", { model_syntax_pb <- "model{}" - fit_simple_pub_bias <- JAGS_fit(model_syntax_pb, data = list(), prior_list = priors_pub_bias, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_simple_pub_bias <- suppressWarnings(JAGS_fit(model_syntax_pb, data = NULL, prior_list = priors_pub_bias, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_simple_pub_bias, "fit_simple_pub_bias", pub_bias_priors = TRUE, note = "PET and PEESE priors for publication bias") @@ -172,8 +172,8 @@ test_that("Simple prior models fit correctly", { ) model_syntax_thin <- "model{}" - fit_simple_thin <- JAGS_fit(model_syntax_thin, data = list(), prior_list = priors_thin, - chains = 2, adapt = 100, burnin = 150, sample = 300, thin = 3, seed = 2) + fit_simple_thin <- suppressWarnings(JAGS_fit(model_syntax_thin, data = NULL, prior_list = priors_thin, + chains = 2, adapt = 100, burnin = 150, sample = 300, thin = 3, seed = 2)) result <- save_fit(fit_simple_thin, "fit_simple_thin", simple_priors = TRUE, thinning = TRUE, note = "Simple normal prior with thinning parameter (thin=3)") @@ -295,8 +295,8 @@ test_that("Vector prior models fit correctly", { model_syntax_vec <- "model{}" - fit_vector_mnormal <- JAGS_fit(model_syntax_vec, data = list(), prior_list = priors_mnormal, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_vector_mnormal <- suppressWarnings(JAGS_fit(model_syntax_vec, data = NULL, prior_list = priors_mnormal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_vector_mnormal, "fit_vector_mnormal", vector_priors = TRUE, note = "Multivariate normal prior (K=3)") @@ -310,8 +310,8 @@ test_that("Vector prior models fit correctly", { model_syntax_mc <- "model{}" - fit_vector_mcauchy <- JAGS_fit(model_syntax_mc, data = list(), prior_list = priors_mcauchy, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_vector_mcauchy <- suppressWarnings(JAGS_fit(model_syntax_mc, data = NULL, prior_list = priors_mcauchy, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_vector_mcauchy, "fit_vector_mcauchy", vector_priors = TRUE, note = "Multivariate Cauchy prior (K=2)") @@ -325,8 +325,8 @@ test_that("Vector prior models fit correctly", { model_syntax_mt <- "model{}" - fit_vector_mt <- JAGS_fit(model_syntax_mt, data = list(), prior_list = priors_mt, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + fit_vector_mt <- suppressWarnings(JAGS_fit(model_syntax_mt, data = NULL, prior_list = priors_mt, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_vector_mt, "fit_vector_mt", vector_priors = TRUE, note = "Multivariate t prior with df=5 (K=2)") @@ -354,8 +354,8 @@ test_that("Factor prior models fit correctly", { model_syntax_orth <- "model{}" - fit_factor_orthonormal <- JAGS_fit(model_syntax_orth, data = list(), prior_list = priors_orthonormal, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_factor_orthonormal <- suppressWarnings(JAGS_fit(model_syntax_orth, data = NULL, prior_list = priors_orthonormal, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_factor_orthonormal, "fit_factor_orthonormal", factor_priors = TRUE, note = "Orthonormal contrast with 3 levels") @@ -370,8 +370,8 @@ test_that("Factor prior models fit correctly", { model_syntax_treat <- "model{}" - fit_factor_treatment <- JAGS_fit(model_syntax_treat, data = list(), prior_list = priors_treatment, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_factor_treatment <- suppressWarnings(JAGS_fit(model_syntax_treat, data = NULL, prior_list = priors_treatment, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_factor_treatment, "fit_factor_treatment", factor_priors = TRUE, note = "Treatment contrast with 2 levels and beta prior") @@ -386,8 +386,8 @@ test_that("Factor prior models fit correctly", { model_syntax_ind <- "model{}" - fit_factor_independent <- JAGS_fit(model_syntax_ind, data = list(), prior_list = priors_independent, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + fit_factor_independent <- suppressWarnings(JAGS_fit(model_syntax_ind, data = NULL, prior_list = priors_independent, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_factor_independent, "fit_factor_independent", factor_priors = TRUE, note = "Independent contrast with 3 levels and gamma prior") @@ -402,8 +402,8 @@ test_that("Factor prior models fit correctly", { model_syntax_md <- "model{}" - fit_factor_meandif <- JAGS_fit(model_syntax_md, data = list(), prior_list = priors_meandif, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) + fit_factor_meandif <- suppressWarnings(JAGS_fit(model_syntax_md, data = NULL, prior_list = priors_meandif, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) result <- save_fit(fit_factor_meandif, "fit_factor_meandif", factor_priors = TRUE, note = "Meandif contrast with 3 levels") @@ -431,8 +431,8 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf1 <- "model{}" - fit_weightfunction_onesided2 <- JAGS_fit(model_syntax_wf1, data = list(), prior_list = priors_wf_onesided2, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_weightfunction_onesided2 <- suppressWarnings(JAGS_fit(model_syntax_wf1, data = NULL, prior_list = priors_wf_onesided2, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_weightfunction_onesided2, "fit_weightfunction_onesided2", weightfunction_priors = TRUE, note = "One-sided weightfunction with 2 intervals (cutpoint at .05)") @@ -446,8 +446,8 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf2 <- "model{}" - fit_weightfunction_onesided3 <- JAGS_fit(model_syntax_wf2, data = list(), prior_list = priors_wf_onesided3, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_weightfunction_onesided3 <- suppressWarnings(JAGS_fit(model_syntax_wf2, data = NULL, prior_list = priors_wf_onesided3, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_weightfunction_onesided3, "fit_weightfunction_onesided3", weightfunction_priors = TRUE, note = "One-sided weightfunction with 3 intervals (cutpoints at .05, .10)") @@ -461,8 +461,8 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf3 <- "model{}" - fit_weightfunction_twosided <- JAGS_fit(model_syntax_wf3, data = list(), prior_list = priors_wf_twosided, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + fit_weightfunction_twosided <- suppressWarnings(JAGS_fit(model_syntax_wf3, data = NULL, prior_list = priors_wf_twosided, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_weightfunction_twosided, "fit_weightfunction_twosided", weightfunction_priors = TRUE, note = "Two-sided weightfunction with cutpoint at .05") @@ -476,33 +476,18 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf4 <- "model{}" - fit_weightfunction_fixed <- JAGS_fit(model_syntax_wf4, data = list(), prior_list = priors_wf_fixed, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) + fit_weightfunction_fixed <- suppressWarnings(JAGS_fit(model_syntax_wf4, data = NULL, prior_list = priors_wf_fixed, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) result <- save_fit(fit_weightfunction_fixed, "fit_weightfunction_fixed", weightfunction_priors = TRUE, note = "One-sided fixed weightfunction (weights: 1, .5)") model_registry[["fit_weightfunction_fixed"]] <<- result$registry_entry fit_weightfunction_fixed <- result$fit - # No weightfunction (prior_none) - priors_wf_none <- list( - omega = prior_none() - ) - - model_syntax_wf5 <- "model{}" - - fit_weightfunction_none <- JAGS_fit(model_syntax_wf5, data = list(), prior_list = priors_wf_none, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 5) - result <- save_fit(fit_weightfunction_none, "fit_weightfunction_none", - note = "No weightfunction using prior_none()") - model_registry[["fit_weightfunction_none"]] <<- result$registry_entry - fit_weightfunction_none <- result$fit - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided2.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided3.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_twosided.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_fixed.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_none.RDS"))) }) @@ -521,8 +506,8 @@ test_that("Spike-and-slab prior models fit correctly", { model_syntax_ss1 <- "model{}" - fit_spike_slab_simple <- JAGS_fit(model_syntax_ss1, data = list(), prior_list = priors_spike_slab_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_spike_slab_simple <- suppressWarnings(JAGS_fit(model_syntax_ss1, data = NULL, prior_list = priors_spike_slab_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_spike_slab_simple, "fit_spike_slab_simple", spike_and_slab_priors = TRUE, note = "Simple spike-and-slab with normal alternative and beta inclusion prior") @@ -544,8 +529,8 @@ test_that("Spike-and-slab prior models fit correctly", { model_syntax_ss2 <- "model{}" - fit_spike_slab_factor <- JAGS_fit(model_syntax_ss2, data = list(), prior_list = priors_spike_slab_factor, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_spike_slab_factor <- suppressWarnings(JAGS_fit(model_syntax_ss2, data = NULL, prior_list = priors_spike_slab_factor, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_spike_slab_factor, "fit_spike_slab_factor", spike_and_slab_priors = TRUE, factor_priors = TRUE, note = "Spike-and-slab with orthonormal factor prior (3 levels) as alternative") @@ -578,8 +563,8 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix1 <- "model{}" - fit_mixture_simple <- JAGS_fit(model_syntax_mix1, data = list(), prior_list = priors_mixture_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_mixture_simple <- suppressWarnings(JAGS_fit(model_syntax_mix1, data = NULL, prior_list = priors_mixture_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_mixture_simple, "fit_mixture_simple", mixture_priors = TRUE, note = "Mixture of 3 components (2 normals, 1 gamma) with is_null flags") @@ -599,8 +584,8 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix2 <- "model{}" - fit_mixture_components <- JAGS_fit(model_syntax_mix2, data = list(), prior_list = priors_mixture_components, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_mixture_components <- suppressWarnings(JAGS_fit(model_syntax_mix2, data = NULL, prior_list = priors_mixture_components, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_mixture_components, "fit_mixture_components", mixture_priors = TRUE, note = "Mixture with named components (a, b)") @@ -619,8 +604,8 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix3 <- "model{}" - fit_mixture_spike <- JAGS_fit(model_syntax_mix3, data = list(), prior_list = priors_mixture_spike, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + fit_mixture_spike <- suppressWarnings(JAGS_fit(model_syntax_mix3, data = NULL, prior_list = priors_mixture_spike, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_mixture_spike, "fit_mixture_spike", mixture_priors = TRUE, note = "Mixture containing spike prior at value 2") @@ -676,17 +661,17 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_simple, formula_data_list = formula_data_list_simple, formula_prior_list = formula_prior_list_simple, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) - + # Compute marginal likelihood for model averaging log_posterior_formula <- function(parameters, data){ sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) } marglik_formula_simple <- JAGS_bridgesampling( - fit_formula_simple, log_posterior = log_posterior_formula, data = data, + fit_formula_simple, log_posterior = log_posterior_formula, data = data, prior_list = prior_list_simple, formula_list = formula_list_simple, formula_data_list = formula_data_list_simple, formula_prior_list = formula_prior_list_simple) - + result <- save_fit(fit_formula_simple, "fit_formula_simple", marglik = marglik_formula_simple, formulas = TRUE, simple_priors = TRUE, @@ -710,14 +695,14 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_treatment, formula_data_list = formula_data_list_treatment, formula_prior_list = formula_prior_list_treatment, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - + # Compute marginal likelihood for model averaging marglik_formula_treatment <- JAGS_bridgesampling( - fit_formula_treatment, log_posterior = log_posterior_formula, data = data, + fit_formula_treatment, log_posterior = log_posterior_formula, data = data, prior_list = prior_list_simple, formula_list = formula_list_treatment, formula_data_list = formula_data_list_treatment, formula_prior_list = formula_prior_list_treatment) - + result <- save_fit(fit_formula_treatment, "fit_formula_treatment", marglik = marglik_formula_treatment, formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, @@ -741,14 +726,14 @@ test_that("Simple formula-based regression models fit correctly", { formula_list = formula_list_orthonormal, formula_data_list = formula_data_list_orthonormal, formula_prior_list = formula_prior_list_orthonormal, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) - + # Compute marginal likelihood for model averaging marglik_formula_orthonormal <- JAGS_bridgesampling( - fit_formula_orthonormal, log_posterior = log_posterior_formula, data = data, + fit_formula_orthonormal, log_posterior = log_posterior_formula, data = data, prior_list = prior_list_simple, formula_list = formula_list_orthonormal, formula_data_list = formula_data_list_orthonormal, formula_prior_list = formula_prior_list_orthonormal) - + result <- save_fit(fit_formula_orthonormal, "fit_formula_orthonormal", marglik = marglik_formula_orthonormal, formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, @@ -1219,8 +1204,8 @@ test_that("Expression prior models fit correctly", { model_syntax_expr1 <- "model{}" - fit_expression_simple <- JAGS_fit(model_syntax_expr1, data = list(), prior_list = priors_expr_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + fit_expression_simple <- suppressWarnings(JAGS_fit(model_syntax_expr1, data = NULL, prior_list = priors_expr_simple, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_expression_simple, "fit_expression_simple", expression_priors = TRUE, simple_priors = TRUE, note = "Normal prior with expression referencing another parameter (x_sigma)") @@ -1237,8 +1222,8 @@ test_that("Expression prior models fit correctly", { model_syntax_expr2 <- "model{}" - fit_expression_spike_slab <- JAGS_fit(model_syntax_expr2, data = list(), prior_list = priors_expr_ss, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + fit_expression_spike_slab <- suppressWarnings(JAGS_fit(model_syntax_expr2, data = NULL, prior_list = priors_expr_ss, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_expression_spike_slab, "fit_expression_spike_slab", expression_priors = TRUE, spike_and_slab_priors = TRUE, simple_priors = TRUE, note = "Spike-and-slab with expression in alternative prior") @@ -1256,8 +1241,8 @@ test_that("Expression prior models fit correctly", { model_syntax_expr3 <- "model{}" - fit_expression_mixture <- JAGS_fit(model_syntax_expr3, data = list(), prior_list = priors_expr_mix, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + fit_expression_mixture <- suppressWarnings(JAGS_fit(model_syntax_expr3, data = NULL, prior_list = priors_expr_mix, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_expression_mixture, "fit_expression_mixture", expression_priors = TRUE, mixture_priors = TRUE, simple_priors = TRUE, note = "Mixture prior with expression in one component") diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R new file mode 100644 index 0000000..3e863c9 --- /dev/null +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -0,0 +1,211 @@ +context("Summary tables functions") + +# ============================================================================== +# CONFIGURATION: Set to TRUE to regenerate reference files, FALSE to run tests +# ============================================================================== +GENERATE_REFERENCE_FILES <- FALSE + +# Get the directory where prefitted models are stored +temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") +if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { + temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") +} + +# Skip tests on CRAN as they require pre-fitted models +skip_on_cran() + +# ============================================================================== +# HELPER FUNCTIONS +# ============================================================================== + +# Process reference file: save if GENERATE_REFERENCE_FILES=TRUE, test otherwise +test_reference <- function(table, filename, info_msg = NULL, + print_dir = testthat::test_path("..", "results", "JAGS-summary-tables")) { + if (GENERATE_REFERENCE_FILES) { + # Save mode + if (!dir.exists(print_dir)) { + dir.create(print_dir, recursive = TRUE) + } + writeLines(capture_output_lines(table, print = TRUE, width = 150), + file.path(print_dir, filename)) + } else { + # Test mode + ref_file <- file.path(print_dir, filename) + if (file.exists(ref_file)) { + expected_output <- readLines(ref_file, warn = FALSE) + actual_output <- capture_output_lines(table, print = TRUE, width = 150) + expect_equal(actual_output, expected_output, info = info_msg) + } else { + skip(paste("Reference file", filename, "not found.")) + } + } +} + +# ============================================================================== +# SECTION 1: Test Empty Tables +# ============================================================================== +test_that("Empty summary tables work correctly", { + + runjags_summary_empty <- runjags_estimates_empty_table() + ensemble_estimates_empty <- ensemble_estimates_empty_table() + ensemble_inference_empty <- ensemble_inference_empty_table() + + expect_equivalent(nrow(runjags_summary_empty), 0) + expect_equivalent(nrow(ensemble_estimates_empty), 0) + expect_equivalent(nrow(ensemble_inference_empty), 0) + + # Test that empty tables have correct structure + expect_s3_class(runjags_summary_empty, "BayesTools_table") + expect_s3_class(ensemble_estimates_empty, "BayesTools_table") + expect_s3_class(ensemble_inference_empty, "BayesTools_table") + + test_reference(runjags_summary_empty, "empty_runjags_estimates.txt", "Empty runjags_estimates table mismatch") + test_reference(ensemble_estimates_empty, "empty_ensemble_estimates.txt", "Empty ensemble_estimates table mismatch") + test_reference(ensemble_inference_empty, "empty_ensemble_inference.txt", "Empty ensemble_inference table mismatch") +}) + +# ============================================================================== +# SECTION 2: Test Advanced Features (Transformations, Formula Handling, etc.) +# ============================================================================== +test_that("Summary table advanced features work correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Use fit_formula_interaction_cont for testing advanced features + # This model has continuous interactions and formulas + fit_complex <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_cont.RDS")) + + # Test 1: Parameter transformations + runjags_summary_transform <- runjags_estimates_table( + fit_complex, + transformations = list("mu_intercept" = list(fun = exp)) + ) + + # Test 2: Formula handling with prefix + runjags_summary_prefix_true <- runjags_estimates_table(fit_complex, formula_prefix = TRUE) + runjags_summary_prefix_false <- runjags_estimates_table(fit_complex, formula_prefix = FALSE) + + # Test 3: Conditional vs unconditional + runjags_summary_conditional <- runjags_estimates_table(fit_complex, conditional = TRUE) + runjags_summary_unconditional <- runjags_estimates_table(fit_complex, conditional = FALSE) + + # Test 4: Factor transformations (use fit_factor_treatment for this) + fit_factor <- readRDS(file.path(temp_fits_dir, "fit_factor_treatment.RDS")) + + runjags_summary_factor <- runjags_estimates_table(fit_factor) + + # Test 5: Use fit with spike and slab + fit_spike <- readRDS(file.path(temp_fits_dir, "fit_spike_slab_factor.RDS")) + + runjags_summary_spike <- runjags_estimates_table(fit_spike) + runjags_inference_spike <- runjags_inference_table(fit_spike) + + # Test 6: Orthonormal contrast transformations to differences from the mean + fit_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_factor_orthonormal.RDS")) + + runjags_summary_orthonormal <- suppressMessages(runjags_estimates_table(fit_orthonormal, transform_factors = TRUE)) + + # Test 7: Custom transformations with transform_factors = FALSE + # Use a model with factor parameters for transformation testing + runjags_summary_custom_transform <- suppressMessages(runjags_estimates_table( + fit_factor, + transform_factors = FALSE, + transformations = list("mu_x_fac3t[2]" = list(fun = exp)) + )) + + # Test 8: Conditional with remove_inclusion + runjags_summary_remove_inclusion <- suppressMessages(runjags_estimates_table( + fit_spike, + transform_factors = TRUE, + conditional = TRUE, + remove_inclusion = TRUE + )) + + # Test 9: Custom probs parameter + runjags_summary_custom_probs <- runjags_estimates_table(fit_complex) + + # Test basic properties + expect_s3_class(runjags_summary_transform, "BayesTools_table") + expect_s3_class(runjags_summary_prefix_true, "BayesTools_table") + expect_s3_class(runjags_summary_prefix_false, "BayesTools_table") + expect_s3_class(runjags_summary_conditional, "BayesTools_table") + expect_s3_class(runjags_summary_unconditional, "BayesTools_table") + expect_s3_class(runjags_summary_factor, "BayesTools_table") + expect_s3_class(runjags_summary_spike, "BayesTools_table") + expect_s3_class(runjags_inference_spike, "BayesTools_table") + expect_s3_class(runjags_summary_orthonormal, "BayesTools_table") + expect_s3_class(runjags_summary_custom_transform, "BayesTools_table") + expect_s3_class(runjags_summary_remove_inclusion, "BayesTools_table") + expect_s3_class(runjags_summary_custom_probs, "BayesTools_table") + + # Test that row names differ with different formula_prefix settings + expect_false(identical(rownames(runjags_summary_prefix_true), + rownames(runjags_summary_prefix_false))) + + # Test that remove_inclusion reduces the number of rows + expect_true(nrow(runjags_summary_remove_inclusion) <= nrow(runjags_summary_spike)) + + test_reference(runjags_summary_transform, "advanced_transform.txt", "Transform table mismatch") + test_reference(runjags_summary_prefix_true, "advanced_formula_prefix_true.txt", "Formula prefix true table mismatch") + test_reference(runjags_summary_prefix_false, "advanced_formula_prefix_false.txt", "Formula prefix false table mismatch") + test_reference(runjags_summary_conditional, "advanced_conditional.txt", "Conditional table mismatch") + test_reference(runjags_summary_unconditional, "advanced_unconditional.txt", "Unconditional table mismatch") + test_reference(runjags_summary_factor, "advanced_factor_treatment.txt", "Factor treatment table mismatch") + test_reference(runjags_summary_spike, "advanced_spike_slab_estimates.txt", "Spike slab estimates table mismatch") + test_reference(runjags_inference_spike, "advanced_spike_slab_inference.txt", "Spike slab inference table mismatch") + test_reference(runjags_summary_orthonormal, "advanced_orthonormal_transform.txt", "Orthonormal transform table mismatch") + test_reference(runjags_summary_custom_transform, "advanced_custom_transform.txt", "Custom transform table mismatch") + test_reference(runjags_summary_remove_inclusion, "advanced_remove_inclusion.txt", "Remove inclusion table mismatch") + test_reference(runjags_summary_custom_probs, "advanced_custom_probs.txt", "Custom probs table mismatch") + +}) + +# ============================================================================== +# SECTION 3: Test Summary Tables for All Saved Models +# ============================================================================== +test_that("Summary tables for all saved models", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) + + # Load model registry to get list of all fitted models + registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + + model_registry <- readRDS(registry_file) + model_names <- model_registry$model_name + + print_dir <- testthat::test_path("..", "results", "print") + + for (model_name in model_names) { + fit_file <- file.path(temp_fits_dir, paste0(model_name, ".RDS")) + marglik_file <- file.path(temp_fits_dir, paste0(model_name, "_marglik.RDS")) + + fit <- readRDS(fit_file) + has_marglik <- file.exists(marglik_file) + + if (has_marglik) { + marglik <- readRDS(marglik_file) + } + + # Process model summary table + if (has_marglik) { + model_list <- list( + list(fit = fit, marglik = marglik, prior_weights = 1, + fit_summary = runjags_estimates_table(fit)) + ) + model_list <- models_inference(model_list) + model_summary <- model_summary_table(model_list[[1]]) + test_reference(model_summary, paste0(model_name, "_model_summary.txt"), + paste0("Model summary mismatch for ", model_name)) + } + + # Process runjags estimates table + runjags_summary <- runjags_estimates_table(fit) + test_reference(runjags_summary, paste0(model_name, "_runjags_estimates.txt"), + paste0("Runjags estimates mismatch for ", model_name)) + + } +}) diff --git a/tests/testthat/test-summary-tables.R b/tests/testthat/test-summary-tables.R deleted file mode 100644 index edde826..0000000 --- a/tests/testthat/test-summary-tables.R +++ /dev/null @@ -1,1454 +0,0 @@ -context("Summary tables functions") - -# Get the directory where prefitted models are stored -temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") -if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { - temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") -} - -test_that("Summary tables functions work",{ - - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") - - if (!dir.exists(temp_fits_dir)) { - skip("Pre-fitted models not available. Run test-00-model-fits.R first.") - } - - runjags::runjags.options(silent.jags = T, silent.runjags = T) - - # Load pre-fitted models and their marginal likelihoods - fit0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) - - fit1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - fit2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) - marglik2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) - - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1, fit_summary = runjags_estimates_table(fit0)), - list(fit = fit1, marglik = marglik1, prior_weights = 1, fit_summary = runjags_estimates_table(fit1)), - list(fit = fit2, marglik = marglik2, prior_weights = 1, fit_summary = runjags_estimates_table(fit2)) - ) - models <- models_inference(models) - inference <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), conditional = FALSE) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1) - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[2]]) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ")) - expect_equal(model_summary[,2], c("2", "0.333", "-0.61", "0.325", "0.964")) - expect_equal(model_summary[,4], c("Parameter prior distributions", "m ~ Normal(0, 0.5)", "omega[one-sided: .05] ~ CumDirichlet(1, 1)", "", "")) - - # runjags summary - runjags_summary <- models[[2]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("m", "omega[0,0.05]", "omega[0.05,1]")) - expect_equal(unname(unlist(runjags_summary[1,])), c(0.155080816, 0.197817354, -0.247495448, 0.167295089, 0.496803251, 0.009208408, 0.0466 , 461.4872, NA), tolerance = 1e-4) - - # ensemble estimates - estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("m", "omega"), probs = c(.025, 0.95)) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("m", "omega[0,0.05]", "omega[0.05,0.5]", "omega[0.5,1]")) - expect_equal(unname(unlist(estimates_table[1,])), c(0.1522389, 0.1519897, -0.2204951, 0.4610624), tolerance = 1e-4) - expect_equal(unname(unlist(estimates_table[3,])), c(0.6794735, 0.7447313, 0.0643561, 1.0000000), tolerance = 1e-4) - - # ensemble inference - inference_table <- ensemble_inference_table(inference, names(inference)) - expect_equal(colnames(inference_table), c("models", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(inference_table), c("m", "omega")) - expect_equal(unname(unlist(inference_table[1,])), c(3, 1, 1, Inf)) - expect_equal(unname(unlist(inference_table[2,])), c(2.0000000, 0.6666667, 0.8001882, 2.0023549), tolerance = 1e-4) - - # ensemble summary - summary_table <- ensemble_summary_table(models, c("m", "omega")) - expect_equal(colnames(summary_table), c("Model", "m", "omega", "prior_prob", "marglik", "post_prob", "inclusion_BF")) - expect_equal(unname(as.vector(summary_table[,1])), c(1, 2, 3)) - expect_equal(unname(as.vector(summary_table[,2])), c("Normal(0, 1)", "Normal(0, 0.5)", "Normal(0, 0.3)")) - expect_equal(unname(as.vector(summary_table[,3])), c("", "omega[one-sided: .05] ~ CumDirichlet(1, 1)", "omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1)")) - expect_equal(unname(as.vector(summary_table[,4])), c(0.3333333, 0.3333333, 0.3333333), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,5])), c(-1.1023042, -0.6149897, -0.2365613), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,6])), c(0.1998118, 0.3252813, 0.4749069), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,7])), c(0.4994120, 0.9641984, 1.8088483), tolerance = 1e-4) - - # ensemble diagnostics - diagnostics_table <- ensemble_diagnostics_table(models, c("m", "omega")) - expect_equal(colnames(diagnostics_table), c("Model", "m", "omega", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")) - - expect_equal(unname(as.vector(diagnostics_table[,1])), c(1, 2, 3)) - expect_equal(unname(as.vector(diagnostics_table[,2])), c("Normal(0, 1)", "Normal(0, 0.5)", "Normal(0, 0.3)")) - expect_equal(unname(as.vector(diagnostics_table[,3])), c("", "omega[one-sided: .05] ~ CumDirichlet(1, 1)", "omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1)")) - expect_equal(unname(as.vector(diagnostics_table[,4])), c(0.01019039, 0.01348211, 0.01061287), tolerance = 1e-4) - expect_equal(unname(as.vector(diagnostics_table[,5])), c(0.048, 0.047, 0.045), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,6])), c(434, 461, 500), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,7])), c(NA, NA, NA)) - - - ### test additional settings - # transformations - runjags_summary2t <- runjags_estimates_table(fit2, transformations = list("m" = list(fun = exp))) - expect_equal(exp(as.data.frame(models[[3]]$fit_summary[1,c("lCI","Median","uCI")])), as.data.frame(runjags_summary2t[1,c("lCI","Median","uCI")]), tolerance = 1e-5) - expect_equal(colnames(models[[3]]$fit_summary), colnames(runjags_summary2t)) - expect_equal(rownames(models[[3]]$fit_summary), rownames(runjags_summary2t)) - - ### test an empty tables - runjags_summary_empty <- runjags_estimates_empty_table() - expect_equivalent(nrow(runjags_summary_empty), 0) - expect_equal(colnames(runjags_summary_empty), colnames(runjags_summary)) - expect_equal(capture_output_lines(runjags_summary_empty, width = 150)[1], capture_output_lines(runjags_summary, width = 150)[1]) - - ensemble_estimates_empty <- ensemble_estimates_empty_table() - expect_equivalent(nrow(ensemble_estimates_empty), 0) - expect_equal(colnames(ensemble_estimates_empty), colnames(estimates_table)) - expect_equal(capture_output_lines(ensemble_estimates_empty, width = 150)[1], capture_output_lines(estimates_table, width = 150)[1]) - - ensemble_inference_empty <- ensemble_inference_empty_table() - expect_equivalent(nrow(ensemble_inference_empty), 0) - expect_equal(colnames(ensemble_inference_empty), colnames(inference_table)) - expect_equal(capture_output_lines(ensemble_inference_empty, width = 150)[1], capture_output_lines(inference_table, width = 150)[1]) - - ensemble_summary_table <- ensemble_summary_empty_table() - expect_equivalent(nrow(ensemble_summary_table), 0) - summary_table.trimmed <- remove_column(summary_table, 2) - summary_table.trimmed <- remove_column(summary_table.trimmed, 2) - expect_equal(colnames(ensemble_summary_table), colnames(summary_table.trimmed)) - expect_equal(capture_output_lines(ensemble_summary_table, width = 150)[1], capture_output_lines(summary_table.trimmed, width = 150)[1]) - - ensemble_diagnostics_empty <- ensemble_diagnostics_empty_table() - expect_equivalent(nrow(ensemble_diagnostics_empty), 0) - diagnostics_table.trimmed <- remove_column(diagnostics_table, 2) - diagnostics_table.trimmed <- remove_column(diagnostics_table.trimmed, 2) - expect_equal(colnames(ensemble_diagnostics_empty), colnames(diagnostics_table.trimmed)) - expect_equal(capture_output_lines(ensemble_diagnostics_empty, width = 150)[1], capture_output_lines(diagnostics_table.trimmed, width = 150)[1]) - - model_summary_empty <- model_summary_empty_table() - expect_equivalent(nrow(model_summary_empty), 5) - expect_equal(model_summary_empty[,1], model_summary[,1]) - expect_equal(model_summary_empty[1,4], model_summary[1,4]) - - ### test print functions - expect_equal(capture_output_lines(model_summary, print = TRUE, width = 150), - c(" ", - " Model 2 Parameter prior distributions", - " Prior prob. 0.333 m ~ Normal(0, 0.5) ", - " log(marglik) -0.61 omega[one-sided: .05] ~ CumDirichlet(1, 1)", - " Post. prob. 0.325 ", - " Inclusion BF 0.964 " - )) - expect_equal(capture_output_lines(runjags_summary, print = TRUE, width = 150), - c(" Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "m 0.155 0.198 -0.247 0.167 0.497 0.00921 0.047 461 NA", - "omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA", - "omega[0.05,1] 0.509 0.301 0.028 0.508 0.983 0.01348 0.045 500 NA" - - )) - expect_equal(capture_output_lines(estimates_table, print = TRUE, width = 150), - c(" Mean Median 0.025 0.95", - "m 0.152 0.152 -0.220 0.461", - "omega[0,0.05] 1.000 1.000 1.000 1.000", - "omega[0.05,0.5] 0.679 0.745 0.064 1.000", - "omega[0.5,1] 0.529 0.483 0.023 1.000" - - )) - expect_equal(capture_output_lines(inference_table, print = TRUE, width = 150), - c(" Models Prior prob. Post. prob. Inclusion BF", - "m 3/3 1.000 1.000 Inf", - "omega 2/3 0.667 0.800 2.002" - - )) - expect_equal(capture_output_lines(summary_table, print = TRUE, width = 150), - c(" Model Prior m Prior omega Prior prob. log(marglik) Post. prob. Inclusion BF", - " 1 Normal(0, 1) 0.333 -1.10 0.200 0.499", - " 2 Normal(0, 0.5) omega[one-sided: .05] ~ CumDirichlet(1, 1) 0.333 -0.61 0.325 0.964", - " 3 Normal(0, 0.3) omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) 0.333 -0.24 0.475 1.809" - )) - expect_equal(capture_output_lines(diagnostics_table, print = TRUE, width = 150), - c(" Model Prior m Prior omega max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat)", - " 1 Normal(0, 1) 0.01019 0.048 434 NA", - " 2 Normal(0, 0.5) omega[one-sided: .05] ~ CumDirichlet(1, 1) 0.01348 0.047 461 NA", - " 3 Normal(0, 0.3) omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) 0.01061 0.045 500 NA" - )) - - - ### test adding columns - expect_error(add_column(runjags_summary, column_title = "New Title", column_values = c(0.2, 0.3, 0.4, 0.5)), - "The 'column_values' must be a vector of the same length as has the table rows.") - expect_error(add_column(runjags_summary, column_title = "New Title", column_values = c(0.2, 0.3, 0.4), column_type = "random text"), - "The 'random text' values are not recognized by the 'column_type' argument.") - expect_error(add_column(runjags_summary, column_title = "New Title", column_values = c(0.2, 0.3, 0.4), column_position = 55), - "The 'column_position' must be equal or lower than ") - expect_error(add_column(data.frame(a = 1:3, b = c("A", "B", "C")), column_title = "New Title", column_values = c(0.2, 0.3, 0.4)), - "The 'table' must be of class 'BayesTools_table'.") - - expect_equal(capture_output_lines( - add_column(runjags_summary, column_title = "New Title", column_values = c(0.2, 0.3, 0.4)), print = TRUE, width = 150), - c(" Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat New Title", - "m 0.155 0.198 -0.247 0.167 0.497 0.00921 0.047 461 NA 0.200", - "omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA 0.300", - "omega[0.05,1] 0.509 0.301 0.028 0.508 0.983 0.01348 0.045 500 NA 0.400" - )) - expect_equal(capture_output_lines( - add_column(estimates_table, column_title = "Models", column_values = c(1:4), column_position = 1), print = TRUE, width = 150), - c(" Models Mean Median 0.025 0.95", - "m 1 0.152 0.152 -0.220 0.461", - "omega[0,0.05] 2 1.000 1.000 1.000 1.000", - "omega[0.05,0.5] 3 0.679 0.745 0.064 1.000", - "omega[0.5,1] 4 0.529 0.483 0.023 1.000" - )) - expect_equal(capture_output_lines( - add_column(inference_table, column_title = "BF2", column_values = inference_table[,4], column_position = 5, column_type = "BF"), print = TRUE, width = 150), - c(" Models Prior prob. Post. prob. Inclusion BF Inclusion BF", - "m 3/3 1.000 1.000 Inf Inf", - "omega 2/3 0.667 0.800 2.002 2.002" - )) - expect_equal(capture_output_lines( - add_column(summary_table, column_title = "Distribution", column_values = c("A", "B", "C"), column_position = 2, column_type = "string"), print = TRUE, width = 150), - c(" Model Distribution Prior m Prior omega Prior prob. log(marglik) Post. prob. Inclusion BF", - " 1 A Normal(0, 1) 0.333 -1.10 0.200 0.499", - " 2 B Normal(0, 0.5) omega[one-sided: .05] ~ CumDirichlet(1, 1) 0.333 -0.61 0.325 0.964", - " 3 C Normal(0, 0.3) omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) 0.333 -0.24 0.475 1.809" - )) - - - ### test removing columns - expect_error(remove_column(runjags_summary, column_position = 10), - "The 'column_position' must be equal or lower than 9.") - - expect_equal(capture_output_lines( - remove_column(inference_table, column_position = 1), print = TRUE, width = 150), - c(" Prior prob. Post. prob. Inclusion BF", - "m 1.000 1.000 Inf", - "omega 0.667 0.800 2.002" - )) - - - ### test explanatory texts - inference <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), conditional = FALSE) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1) - - expect_equal(interpret(inference, mixed_posteriors, list( - list( - inference = "m", - samples = "m", - inference_name = "effect", - inference_BF_name = "BF_10", - samples_name = "y", - samples_units = NULL - ) - ), "Test"), "Test found strong evidence in favor of the effect, BF_10 = Inf, with mean model-averaged estimate y = 0.152, 95% CI [-0.220, 0.525].") - - inference[["m"]][["BF"]] <- 1/5 - expect_equal(interpret(inference, mixed_posteriors, list( - list( - inference = "m", - samples = "m", - inference_name = "effect", - inference_BF_name = "BF_10", - samples_name = "y", - samples_units = "mm", - samples_conditional = TRUE - ), - list( - inference = "omega", - inference_name = "bias", - inference_BF_name = "BF_pb" - ) - ), "Test2"), "Test2 found moderate evidence against the effect, BF_10 = 0.200, with mean conditional estimate y = 0.152 mm, 95% CI [-0.220, 0.525]. Test2 found weak evidence in favor of the bias, BF_pb = 2.00.") - -}) - -# skip the rest as it takes too long -skip_on_cran() - -test_that("Summary tables functions work (formulas + factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(60), - x_fac2t = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3t = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(60, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_fac2t) - formula_list1 <- list(mu = ~ x_cont1 + x_fac3t) - formula_list2 <- list(mu = ~ x_fac3o) - formula_list3 <- list(mu = ~ x_cont1 * x_fac3o) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - formula_prior_list3 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), - "x_cont1:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - fit2 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2, seed = 3) - fit3 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3, seed = 4) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - marglik2 <- JAGS_bridgesampling( - fit2, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2) - marglik3 <- JAGS_bridgesampling( - fit3, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3) - - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1), prior_weights = 1), - list(fit = fit2, marglik = marglik2, fit_summary = runjags_estimates_table(fit2), prior_weights = 1), - list(fit = fit3, marglik = marglik3, fit_summary = runjags_estimates_table(fit3), prior_weights = 1) - ) - models <- models_inference(models) - - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1:x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1:x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[4]]) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ", " ")) - expect_equal(model_summary[,4], c("Parameter prior distributions","(mu) intercept ~ Normal(0, 5)","(mu) x_cont1 ~ Normal(0, 1)","(mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1)","(mu) x_cont1:x_fac3o ~ orthonormal contrast: mNormal(0, 1)","sigma ~ Lognormal(0, 1)")) - - model_summary2 <- model_summary_table(models[[4]], formula_prefix = FALSE, remove_parameters = "sigma") - expect_equal(model_summary2[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ")) - expect_equal(model_summary2[,4], c("Parameter prior distributions","intercept ~ Normal(0, 5)","x_cont1 ~ Normal(0, 1)","x_fac3o ~ orthonormal contrast: mNormal(0, 1)","x_cont1:x_fac3o ~ orthonormal contrast: mNormal(0, 1)")) - - - # runjags summary - runjags_summary <- models[[2]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("(mu) intercept", "(mu) x_cont1", "(mu) x_fac3t[B]", "(mu) x_fac3t[C]", "sigma")) - expect_equal(unname(unlist(runjags_summary[3,])), c(5.746362e-03, 2.808364e-01, -5.496105e-01, 1.058318e-02, 5.504860e-01, 4.142589e-03, 1.500000e-02, 4.596000e+03, 1.000580e+00), tolerance = 1e-3) - - runjags_summary2 <- runjags_estimates_table(fit1, formula_prefix = FALSE) - expect_equal(colnames(runjags_summary2), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary2), c("intercept", "x_cont1", "x_fac3t[B]", "x_fac3t[C]", "sigma")) - expect_equal(unname(unlist(runjags_summary2[3,])), c(5.746362e-03, 2.808364e-01, -5.496105e-01, 1.058318e-02, 5.504860e-01, 4.142589e-03, 1.500000e-02, 4.596000e+03, 1.000580e+00), tolerance = 1e-3) - - runjags_summary <- models[[4]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("(mu) intercept", "(mu) x_cont1", "(mu) x_fac3o[1]", "(mu) x_fac3o[2]", "(mu) x_cont1:x_fac3o[1]", "(mu) x_cont1:x_fac3o[2]", "sigma" )) - expect_equal(unname(unlist(runjags_summary[1,])), c(1.876569e-01, 1.210763e-01, -5.091384e-02, 1.878474e-01, 4.285015e-01, 9.894116e-04, 8.000000e-03, 1.497500e+04, 1.000068e+00), tolerance = 1e-3) - - - # ensemble estimates - estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_cont1", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), probs = c(.025, 0.95)) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("(mu) x_cont1", "(mu) x_fac3t[B]", "(mu) x_fac3t[C]", "(mu) x_fac3o[1]", "(mu) x_fac3o[2]", "(mu) x_cont1:x_fac3o[1]", "(mu) x_cont1:x_fac3o[2]")) - expect_equal(unname(unlist(estimates_table[1,])), c(0.1224567, 0.0000000, 0.0000000, 0.4794182), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[3,])), c( 0.0397569, 0.0000000, -0.2895047, 0.4087159), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[5,])), c(-0.004121766, 0.000000000, -0.215131954, 0.036829714), tolerance = 1e-3) - - estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_cont1", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), probs = c(.025, 0.95)) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("(mu) x_cont1", "(mu) x_fac3o[1]", "(mu) x_fac3o[2]", "(mu) x_cont1:x_fac3o[1]", "(mu) x_cont1:x_fac3o[2]")) - expect_equal(unname(unlist(estimates_table[1,])), c(0.1224567, 0.0000000, 0.0000000, 0.4794182), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[3,])), c(-0.004121766, 0.000000000, -0.215131954, 0.036829714), tolerance = 1e-3) - - # ensemble inference - inference_table <- ensemble_inference_table(inference, names(inference)) - expect_equal(colnames(inference_table), c("models", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(inference_table), c("(mu) x_cont1", "(mu) x_fac2t", "(mu) x_fac3t", "(mu) x_fac3o", "(mu) x_cont1:x_fac3o")) - expect_equal(unname(unlist(inference_table[,1])), c(2, 1, 1, 2, 1)) - expect_equal(unname(unlist(inference_table[,2])), c(0.50, 0.25, 0.25, 0.50, 0.25)) - expect_equal(unname(unlist(inference_table[,3])), c(0.37435772, 0.52598137, 0.33962193, 0.13439670, 0.03473579), tolerance = 1e-3) - expect_equal(unname(as.vector(inference_table[,4])), c(0.5983575, 3.3288651, 1.5428523, 0.1552636, 0.1079573), tolerance = 1e-3) - - # ensemble summary - summary_table <- ensemble_summary_table(models, c("mu_x_cont1", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o")) - expect_equal(colnames(summary_table), c("Model", "(mu) x_cont1", "(mu) x_fac3o", "(mu) x_cont1:x_fac3o", "prior_prob", "marglik", "post_prob", "inclusion_BF")) - expect_equal(unname(as.vector(summary_table[,1])), c(1, 2, 3, 4)) - expect_equal(unname(as.vector(summary_table[,2])), c("", "Normal(0, 1)", "", "Normal(0, 1)")) - expect_equal(unname(as.vector(summary_table[,3])), c("", "", "orthonormal contrast: mNormal(0, 1)", "orthonormal contrast: mNormal(0, 1)")) - expect_equal(unname(as.vector(summary_table[,4])), c("", "", "", "orthonormal contrast: mNormal(0, 1)")) - expect_equal(unname(as.vector(summary_table[,5])), c(0.25, 0.25, 0.25, 0.25), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,6])), c(-88.22395, -88.66138, -89.88744, -90.94144), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,7])), c(0.52598137, 0.33962193, 0.09966091, 0.03473579), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,8])), c(3.3288651, 1.5428523, 0.3320779, 0.1079573), tolerance = 1e-3) - - # ensemble diagnostics - diagnostics_table <- ensemble_diagnostics_table(models, c("mu_x_cont1", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o")) - expect_equal(colnames(diagnostics_table), c("Model", "(mu) x_cont1", "(mu) x_fac3o", "(mu) x_cont1:x_fac3o", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")) - - expect_equal(unname(as.vector(diagnostics_table[,1])), c(1, 2, 3, 4)) - expect_equal(unname(as.vector(diagnostics_table[,2])), c("", "Normal(0, 1)", "", "Normal(0, 1)")) - expect_equal(unname(as.vector(diagnostics_table[,3])), c("", "", "orthonormal contrast: mNormal(0, 1)", "orthonormal contrast: mNormal(0, 1)")) - expect_equal(unname(as.vector(diagnostics_table[,4])), c("", "", "", "orthonormal contrast: mNormal(0, 1)")) - expect_equal(unname(as.vector(diagnostics_table[,5])), c(0.003223670, 0.004142589, 0.001676136, 0.001959310), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,6])), c(0.013, 0.017, 0.011, 0.011), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,7])), c(5559, 3526, 8660, 7969), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,8])), c(1.001154, 1.000955, 1.000125, 1.000658), tolerance = 1e-3) - - - ### test additional settings - # transformations of orthonormal contrast to differences from the mean - runjags_summary_t <- suppressMessages(runjags_estimates_table(fit3, transform_factors = TRUE)) - expect_equal(colnames(runjags_summary_t), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary_t), c("(mu) intercept","(mu) x_cont1","(mu) x_fac3o [dif: A]","(mu) x_fac3o [dif: B]","(mu) x_fac3o [dif: C]", "(mu) x_cont1:x_fac3o [dif: A]", "(mu) x_cont1:x_fac3o [dif: B]", "(mu) x_cont1:x_fac3o [dif: C]", "sigma" )) - expect_equal(capture_output_lines(runjags_summary_t, print = TRUE, width = 150), - c(" Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept 0.188 0.121 -0.051 0.188 0.429 0.00099 0.008 14975 1.000", - "(mu) x_cont1 0.324 0.140 0.047 0.324 0.597 0.00112 0.008 15680 1.000", - "(mu) x_fac3o [dif: A] -0.010 0.168 -0.337 -0.011 0.321 0.00134 0.008 15720 1.000", - "(mu) x_fac3o [dif: B] -0.064 0.170 -0.397 -0.064 0.270 0.00139 0.008 14958 1.000", - "(mu) x_fac3o [dif: C] 0.074 0.167 -0.251 0.072 0.404 0.00133 0.008 15737 1.000", - "(mu) x_cont1:x_fac3o [dif: A] -0.283 0.197 -0.668 -0.283 0.105 0.00158 0.008 15659 1.000", - "(mu) x_cont1:x_fac3o [dif: B] 0.164 0.194 -0.221 0.164 0.539 0.00160 0.008 14777 1.000", - "(mu) x_cont1:x_fac3o [dif: C] 0.119 0.202 -0.275 0.118 0.521 0.00161 0.008 15778 1.000", - "sigma 0.925 0.090 0.770 0.918 1.119 0.00101 0.011 7969 1.001" - )) - - - estimates_table_t <- ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_cont1", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), probs = c(.025, 0.95), transform_factors = TRUE) - expect_equal(colnames(estimates_table_t), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table_t), c("(mu) x_cont1","(mu) x_fac3o [dif: A]", "(mu) x_fac3o [dif: B]", "(mu) x_fac3o [dif: C]", "(mu) x_cont1:x_fac3o [dif: A]", "(mu) x_cont1:x_fac3o [dif: B]", "(mu) x_cont1:x_fac3o [dif: C]")) - expect_equal(capture_output_lines(estimates_table_t, print = TRUE, width = 150), - c(" Mean Median 0.025 0.95", - "(mu) x_cont1 0.122 0.000 0.000 0.479", - "(mu) x_fac3o [dif: A] -0.003 0.000 -0.176 0.030", - "(mu) x_fac3o [dif: B] -0.003 0.000 -0.181 0.039", - "(mu) x_fac3o [dif: C] 0.007 0.000 -0.105 0.100", - "(mu) x_cont1:x_fac3o [dif: A] -0.010 0.000 -0.183 0.000", - "(mu) x_cont1:x_fac3o [dif: B] 0.006 0.000 0.000 0.000", - "(mu) x_cont1:x_fac3o [dif: C] 0.005 0.000 0.000 0.000" - )) - # transform estimates - runjags_summary_t2 <- suppressMessages(runjags_estimates_table(fit1, transform_factors = FALSE, transformations = list("mu_x_fac2t" = list(fun = exp)))) - expect_equal(capture_output_lines(runjags_summary_t2, print = TRUE, width = 150), - c(" Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept 0.145 0.200 -0.245 0.144 0.541 0.00338 0.017 3526 1.001", - "(mu) x_cont1 0.327 0.139 0.052 0.327 0.602 0.00111 0.008 15725 1.000", - "(mu) x_fac3t[B] 0.006 0.281 -0.550 0.011 0.550 0.00415 0.015 4596 1.001", - "(mu) x_fac3t[C] 0.118 0.277 -0.433 0.120 0.656 0.00407 0.015 4630 1.001", - "sigma 0.926 0.089 0.774 0.918 1.117 0.00099 0.011 8016 1.000" - )) - - - ### test print functions - expect_equal(capture_output_lines(model_summary, print = TRUE, width = 150), - c(" ", - " Model 4 Parameter prior distributions", - " Prior prob. 0.250 (mu) intercept ~ Normal(0, 5) ", - " log(marglik) -90.94 (mu) x_cont1 ~ Normal(0, 1) ", - " Post. prob. 0.035 (mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1)", - " Inclusion BF 0.108 (mu) x_cont1:x_fac3o ~ orthonormal contrast: mNormal(0, 1)", - " sigma ~ Lognormal(0, 1) " - )) - expect_equal(capture_output_lines(runjags_summary, print = TRUE, width = 150), - c(" Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept 0.188 0.121 -0.051 0.188 0.429 0.00099 0.008 14975 1.000", - "(mu) x_cont1 0.324 0.140 0.047 0.324 0.597 0.00112 0.008 15680 1.000", - "(mu) x_fac3o[1] 0.097 0.207 -0.314 0.096 0.508 0.00166 0.008 15450 1.000", - "(mu) x_fac3o[2] -0.012 0.205 -0.412 -0.013 0.393 0.00164 0.008 15720 1.000", - "(mu) x_cont1:x_fac3o[1] -0.032 0.243 -0.507 -0.033 0.448 0.00196 0.008 15383 1.000", - "(mu) x_cont1:x_fac3o[2] -0.347 0.242 -0.818 -0.347 0.128 0.00193 0.008 15659 1.000", - "sigma 0.925 0.090 0.770 0.918 1.119 0.00101 0.011 7969 1.001" - - )) - expect_equal(capture_output_lines(estimates_table, print = TRUE, width = 150), - c(" Mean Median 0.025 0.95", - "(mu) x_cont1 0.122 0.000 0.000 0.479", - "(mu) x_fac3o[1] 0.007 0.000 -0.145 0.125", - "(mu) x_fac3o[2] -0.004 0.000 -0.215 0.037", - "(mu) x_cont1:x_fac3o[1] -0.001 0.000 0.000 0.000", - "(mu) x_cont1:x_fac3o[2] -0.013 0.000 -0.224 0.000" - - )) - expect_equal(capture_output_lines(inference_table, print = TRUE, width = 150), - c(" Models Prior prob. Post. prob. Inclusion BF", - "(mu) x_cont1 2/4 0.500 0.374 0.598", - "(mu) x_fac2t 1/4 0.250 0.526 3.329", - "(mu) x_fac3t 1/4 0.250 0.340 1.543", - "(mu) x_fac3o 2/4 0.500 0.134 0.155", - "(mu) x_cont1:x_fac3o 1/4 0.250 0.035 0.108" - - )) - expect_equal(capture_output_lines(summary_table, print = TRUE, width = 150), - c(" Model Prior (mu) x_cont1 Prior (mu) x_fac3o Prior (mu) x_cont1:x_fac3o Prior prob. log(marglik) Post. prob. Inclusion BF", - " 1 0.250 -88.22 0.526 3.329", - " 2 Normal(0, 1) 0.250 -88.66 0.340 1.543", - " 3 orthonormal contrast: mNormal(0, 1) 0.250 -89.89 0.100 0.332", - " 4 Normal(0, 1) orthonormal contrast: mNormal(0, 1) orthonormal contrast: mNormal(0, 1) 0.250 -90.94 0.035 0.108" - )) - expect_equal(capture_output_lines(diagnostics_table, print = TRUE, width = 180), - c(" Model Prior (mu) x_cont1 Prior (mu) x_fac3o Prior (mu) x_cont1:x_fac3o max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat)", - " 1 0.00323 0.013 5559 1.001", - " 2 Normal(0, 1) 0.00415 0.017 3526 1.001", - " 3 orthonormal contrast: mNormal(0, 1) 0.00168 0.011 8660 1.000", - " 4 Normal(0, 1) orthonormal contrast: mNormal(0, 1) orthonormal contrast: mNormal(0, 1) 0.00196 0.011 7969 1.001" - )) - -}) - -test_that("Summary tables functions work (indepdent factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac2i = factor(rep(c("A", "B"), 30), levels = c("A", "B")) - ) - data <- list( - y = rnorm(60, ifelse(data_formula$x_fac2i == "A", 0.0, -0.2), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_fac2i - 1) - formula_list1 <- list(mu = ~ x_fac2i - 1) - - formula_prior_list0 <- list( - mu = list( - "x_fac2i" = prior_factor("spike", contrast = "independent", list(0)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "x_fac2i" = prior_factor("normal", contrast = "independent", list(0, 1/4)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1), prior_weights = 1) - ) - models <- models_inference(models) - - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_fac2i"), - is_null_list = list( - "mu_x_fac2i" = c(TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_fac2i"), - is_null_list = list( - "mu_x_fac2i" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[2]]) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ")) - expect_equal(model_summary[,4], c("Parameter prior distributions", "(mu) x_fac2i ~ independent contrast: Normal(0, 0.25)","sigma ~ Lognormal(0, 1)", "", "")) - - # runjags summary - runjags_summary <- models[[2]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("(mu) x_fac2i[A]", "(mu) x_fac2i[B]", "sigma" )) - expect_equal(unname(unlist(runjags_summary[1,])), c(1.734095e-01, 1.340447e-01, -9.293281e-02, 1.747751e-01, 4.347246e-01, 1.067352e-03, 8.000000e-03, 1.577200e+04, 1.000033e+00), tolerance = 1e-3) - - # ensemble estimates - estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_fac2i"), probs = c(.025, 0.95)) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("(mu) x_fac2i[A]", "(mu) x_fac2i[B]")) - expect_equal(unname(unlist(estimates_table[1,])), c(0.10208451, 0.03621004, -0.06041045, 0.35346681), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[2,])), c(-0.09355933, -0.01700284, -0.38746858, 0.02836426), tolerance = 1e-3) - - # ensemble inference - inference_table <- ensemble_inference_table(inference, names(inference)) - expect_equal(colnames(inference_table), c("models", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(inference_table), c("(mu) x_fac2i")) - expect_equal(unname(unlist(inference_table[,1])), 1) - expect_equal(unname(unlist(inference_table[,2])), 0.5) - expect_equal(unname(unlist(inference_table[,3])), 0.5876797, tolerance = 1e-3) - expect_equal(unname(as.vector(inference_table[,4])), 1.425299, tolerance = 1e-3) - - # ensemble summary - summary_table <- ensemble_summary_table(models, c("mu_x_fac2i")) - expect_equal(colnames(summary_table), c("Model", "(mu) x_fac2i", "prior_prob", "marglik", "post_prob", "inclusion_BF")) - expect_equal(unname(as.vector(summary_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(summary_table[,2])), c("","independent contrast: Normal(0, 0.25)")) - expect_equal(unname(as.vector(summary_table[,3])), c(0.5, 0.5), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,4])), c(-79.15494, -78.80056), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,5])), c(0.4123203, 0.5876797), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,6])), c(0.7016071, 1.4252991), tolerance = 1e-3) - - # ensemble diagnostics - diagnostics_table <- ensemble_diagnostics_table(models, c("mu_x_fac2i"), remove_spike_0 = FALSE) - expect_equal(colnames(diagnostics_table), c("Model", "(mu) x_fac2i", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")) - - expect_equal(unname(as.vector(diagnostics_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(diagnostics_table[,2])), c("independent contrast: Spike(0)","independent contrast: Normal(0, 0.25)")) - expect_equal(unname(as.vector(diagnostics_table[,3])), c(0.0008277888, 0.0010673515), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,4])), c(0.010, 0.011), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,5])), c(9564, 8145), tolerance = 1e-3) - -}) - -test_that("Summary tables functions work (meandif factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(2) - - data_formula <- data.frame( - x_fac3 = factor(rep(c("A", "B", "C"), 60), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(180, ifelse(data_formula$x_fac3 == "A", -0.2, ifelse(data_formula$x_fac3 == "B", 0.0, 0.2)), 1), - N = 180 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ 1) - formula_list1 <- list(mu = ~ x_fac3) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3" = prior_factor("mnormal", contrast = "meandif", list(0, 1/5)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1), prior_weights = 1) - ) - models <- models_inference(models) - - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_fac3"), - is_null_list = list( - "mu_x_fac3" = c(TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_fac3"), - is_null_list = list( - "mu_x_fac3" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[2]]) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ")) - expect_equal(model_summary[,4], c("Parameter prior distributions", "(mu) intercept ~ Normal(0, 5)", "(mu) x_fac3 ~ mean difference contrast: mNormal(0, 0.2)","sigma ~ Lognormal(0, 1)", "")) - - # runjags summary - runjags_summary <- models[[2]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("(mu) intercept", "(mu) x_fac3[1]", "(mu) x_fac3[2]", "sigma")) - expect_equal(unname(unlist(runjags_summary[1,])), c(2.616574e-02,8.256672e-02,-1.369357e-01,2.621934e-02,1.851191e-01,6.471943e-04,8.000000e-03,1.627600e+04,9.999001e-01), tolerance = 1e-3) - - # ensemble estimates - estimates_table <- suppressMessages(ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_fac3"), probs = c(.025, 0.95), transform_factors = TRUE)) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("(mu) x_fac3 [dif: A]", "(mu) x_fac3 [dif: B]", "(mu) x_fac3 [dif: C]")) - expect_equal(unname(unlist(estimates_table[1,])), c(-0.2074503, -0.2206674, -0.4204564, 0.0000000), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[2,])), c(0.023169431, 0.008606852, -0.163666847, 0.185934433), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[3,])), c(0.1842808, 0.1938991, 0.0000000, 0.3678031), tolerance = 1e-3) - - # ensemble inference - inference_table <- ensemble_inference_table(inference, names(inference)) - expect_equal(colnames(inference_table), c("models", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(inference_table), c("(mu) x_fac3")) - expect_equal(unname(unlist(inference_table[,1])), 1) - expect_equal(unname(unlist(inference_table[,2])), 0.5) - expect_equal(unname(unlist(inference_table[,3])), 0.8737537, tolerance = 1e-3) - expect_equal(unname(as.vector(inference_table[,4])), 6.921025, tolerance = 1e-3) - - # ensemble summary - summary_table <- ensemble_summary_table(models, c("mu_x_fac3")) - expect_equal(colnames(summary_table), c("Model", "(mu) x_fac3", "prior_prob", "marglik", "post_prob", "inclusion_BF")) - expect_equal(unname(as.vector(summary_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(summary_table[,2])), c("","mean difference contrast: mNormal(0, 0.2)")) - expect_equal(unname(as.vector(summary_table[,3])), c(0.5, 0.5), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,4])), c(-282.5467, -280.6121), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,5])), c(0.1262463, 0.8737537), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,6])), c(0.1444873, 6.9210254), tolerance = 1e-3) - - # ensemble diagnostics - diagnostics_table <- ensemble_diagnostics_table(models, c("mu_x_fac3"), remove_spike_0 = FALSE) - expect_equal(colnames(diagnostics_table), c("Model", "(mu) x_fac3", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")) - expect_equal(unname(as.vector(diagnostics_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(diagnostics_table[,2])), c("", "mean difference contrast: mNormal(0, 0.2)")) - expect_equal(unname(as.vector(diagnostics_table[,3])), c(0.0006707336, 0.0007978420), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,4])), c(0.01, 0.01), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,5])), c(9676, 9871), tolerance = 1e-3) - -}) - -test_that("Summary tables functions work (spike and slab priors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(60), - x_fac2t = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3t = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(60, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_cont1 + x_fac2t + x_fac3o) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior_spike_and_slab( - prior_parameter = prior("normal", list(0, 0.5)), - prior_inclusion = prior("beta", list(1, 1)) - ), - "x_fac2t" = prior_spike_and_slab( - prior_parameter = prior_factor("normal", contrast = "treatment", list(0, 1)), - prior_inclusion = prior("beta", list(1, 1)) - ), - "x_fac3o" = prior_spike_and_slab( - prior_parameter = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), - prior_inclusion = prior("spike", list(.5)) - ) - ) - ) - - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - - # bridge sampling cannot be computer for spike and slab priors - using a dummy value for marglik - marglik0 <- list(logml = 0) - class(marglik0) <- "bridge" - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0), prior_weights = 1) - ) - models <- models_inference(models) - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[1]]) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ", " ")) - expect_equal(model_summary[,4], c("Parameter prior distributions", "(mu) intercept ~ Normal(0, 5)", "(mu) x_cont1 ~ Normal(0, 0.5) * Beta(1, 1)", "(mu) x_fac2t ~ treatment contrast: Normal(0, 1) * Beta(1, 1)", "(mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1) * Spike(0.5)", "sigma ~ Lognormal(0, 1)")) - - model_estimates <- runjags_estimates_table(fit0) - testthat::expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept 0.194 0.132 -0.072 0.195 0.456 0.00132 0.010 10084 1.000", - "(mu) x_cont1 (inclusion) 0.780 NA NA NA NA NA NA NA NA", - "(mu) x_cont1 0.237 0.174 0.000 0.256 0.555 0.00230 0.013 5720 1.000", - "(mu) x_fac2t (inclusion) 0.186 NA NA NA NA NA NA NA NA", - "(mu) x_fac2t[B] 0.006 0.105 -0.233 0.000 0.299 0.00123 0.012 7310 1.002", - "(mu) x_fac3o (inclusion) 0.040 NA NA NA NA NA NA NA NA", - "(mu) x_fac3o[1] 0.003 0.043 0.000 0.000 0.003 0.00034 0.008 15764 1.001", - "(mu) x_fac3o[2] -0.002 0.043 0.000 0.000 0.000 0.00035 0.008 15506 1.001", - "sigma 0.922 0.088 0.772 0.915 1.113 0.00095 0.011 8458 1.000" - )) - - model_estimates <- suppressMessages(runjags_estimates_table(fit0, transform_factors = TRUE, conditional = TRUE)) - testthat::expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI", - "(mu) intercept 0.194 0.132 -0.072 0.195 0.456", - "(mu) x_cont1 (inclusion) 0.780 NA NA NA NA", - "(mu) x_cont1 0.304 0.136 0.033 0.306 0.568", - "(mu) x_fac2t (inclusion) 0.186 NA NA NA NA", - "(mu) x_fac2t[B] 0.033 0.241 -0.435 0.031 0.507", - "(mu) x_fac3o (inclusion) 0.040 NA NA NA NA", - "(mu) x_fac3o [dif: A] -0.036 0.171 -0.359 -0.043 0.316", - "(mu) x_fac3o [dif: B] -0.026 0.173 -0.367 -0.026 0.296", - "(mu) x_fac3o [dif: C] 0.063 0.166 -0.262 0.059 0.395", - "sigma 0.922 0.088 0.772 0.915 1.113" - )) - - model_estimates <- suppressMessages(runjags_estimates_table(fit0, transform_factors = TRUE, conditional = TRUE, remove_inclusion = TRUE)) - testthat::expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI", - "(mu) intercept 0.194 0.132 -0.072 0.195 0.456", - "(mu) x_cont1 0.304 0.136 0.033 0.306 0.568", - "(mu) x_fac2t[B] 0.033 0.241 -0.435 0.031 0.507", - "(mu) x_fac3o [dif: A] -0.036 0.171 -0.359 -0.043 0.316", - "(mu) x_fac3o [dif: B] -0.026 0.173 -0.367 -0.026 0.296", - "(mu) x_fac3o [dif: C] 0.063 0.166 -0.262 0.059 0.395", - "sigma 0.922 0.088 0.772 0.915 1.113" - )) - - model_inference <- runjags_inference_table(fit0) - expect_equal(colnames(model_inference), c("prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(model_inference), c("(mu) x_cont1", "(mu) x_fac2t", "(mu) x_fac3o")) - expect_equal(model_inference[,1], c(0.5, 0.5, 0.5)) - expect_equal(model_inference[,2], c(0.7798125, 0.1864375, 0.0399375), tolerance = 1e-3) - expect_equal(model_inference[,3], c(3.54158388, 0.22916187, 0.04159885), tolerance = 1e-3) - - runjags_inference_empty <- runjags_inference_empty_table() - expect_equivalent(nrow(runjags_inference_empty), 0) - expect_equal(colnames(runjags_inference_empty), colnames(model_inference)) - expect_equal(capture_output_lines(runjags_inference_empty, width = 150)[1], capture_output_lines(model_inference, width = 150)[1]) - -}) - -test_that("Summary tables functions work (stan)",{ - - skip_on_cran() - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - - # prefitted model with RoBTT - if(!file.exists(file.path("../results/fits", "fit_RoBTT.RDS"))) - skip(message = "Only runs locally") - - fit <- readRDS(file = file.path("../results/fits", "fit_RoBTT.RDS")) - - set.seed(1) - - ### checking summary functions - model_estimates <- stan_estimates_table(fit) - expect_equal(colnames(model_estimates), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(model_estimates), c("mu", "sigma2", "pooled_sigma", "sigma_i[1]", "sigma_i[2]", "mu_i[1]", "mu_i[2]" )) - expect_equal(unname(unlist(model_estimates[1,])), c(1.43876353, 0.37708461, 0.81080656, 1.42486330, 2.15911838, 0.06223762, 0.16504949, 36.70892380, 1.01241771), tolerance = 1e-3) - -}) - -test_that("Summary tables functions work (spike factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac3o = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, ifelse(data_formula$x_fac3o == "A", 0.0, ifelse(data_formula$x_fac3o == "B", -0.2, 0.4))), - N = 300 - ) - - - formula_list <- list( - mu = ~ x_fac3o - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("spike", contrast = "meandif", list(0)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) - ) - ) - - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - log_posterior <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - - marglik0 <- JAGS_bridgesampling( - fit = fit0, - log_posterior = log_posterior, - data = data, - prior_list = prior_list, - formula_list = formula_list, - formula_data_list = formula_data_list, - formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit = fit1, - log_posterior = log_posterior, - data = data, - prior_list = prior_list, - formula_list = formula_list, - formula_data_list = formula_data_list, - formula_prior_list = formula_prior_list1) - - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = suppressMessages(runjags_estimates_table(fit0, remove_spike_0 = FALSE, transform_factors = TRUE)), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = suppressMessages(runjags_estimates_table(fit1, remove_spike_0 = FALSE, transform_factors = TRUE)), prior_weights = 1) - ) - models <- models_inference(models) - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_fac3o"), - is_null_list = list( - "mu_x_fac3o" = c(TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_fac3o"), - is_null_list = list( - "mu_x_fac3o" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[1]], remove_spike_0 = FALSE) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ")) - expect_equal(model_summary[,4], c("Parameter prior distributions", "(mu) intercept ~ Normal(0, 5)", "(mu) x_fac3o ~ mean difference contrast: mSpike(0)", "sigma ~ Lognormal(0, 1)", "")) - - # runjags summary - runjags_summary <- models[[1]]$fit_summary - expect_equal(colnames(runjags_summary), c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) - expect_equal(rownames(runjags_summary), c("(mu) intercept", "(mu) x_fac3o [dif: A]", "(mu) x_fac3o [dif: B]", "(mu) x_fac3o [dif: C]", "sigma")) - expect_equal(unname(unlist(runjags_summary[,1])), c(0.09974883, 0.00000000, 0.00000000, 0.00000000, 0.97359248), tolerance = 1e-3) - - # ensemble estimates - estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("mu_x_fac3o"), probs = c(.025, 0.95), transform_factors = TRUE) - expect_equal(colnames(estimates_table), c("Mean", "Median", "0.025", "0.95")) - expect_equal(rownames(estimates_table), c("(mu) x_fac3o [dif: A]", "(mu) x_fac3o [dif: B]", "(mu) x_fac3o [dif: C]")) - expect_equal(unname(unlist(estimates_table[1,])), c(-0.00919489, 0.00000000, -0.15024720, 0.09922589), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[2,])), c(-0.1246629, -0.1329689, -0.3041710, 0.0000000), tolerance = 1e-3) - expect_equal(unname(unlist(estimates_table[3,])), c(0.1338578, 0.1465136, 0.0000000, 0.2895046), tolerance = 1e-3) - - # ensemble inference - inference_table <- ensemble_inference_table(inference, names(inference)) - expect_equal(colnames(inference_table), c("models", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(rownames(inference_table), c("(mu) x_fac3o")) - expect_equal(unname(unlist(inference_table[,1])), 1) - expect_equal(unname(unlist(inference_table[,2])), 0.5) - expect_equal(unname(unlist(inference_table[,3])), 0.751, tolerance = 1e-3) - expect_equal(unname(as.vector(inference_table[,4])), 3.020, tolerance = 1e-3) - - # ensemble summary - summary_table <- ensemble_summary_table(models, c("mu_x_fac3o"), remove_spike_0 = FALSE) - expect_equal(colnames(summary_table), c("Model", "(mu) x_fac3o", "prior_prob", "marglik", "post_prob", "inclusion_BF")) - expect_equal(unname(as.vector(summary_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(summary_table[,2])), c("mean difference contrast: mSpike(0)","mean difference contrast: mNormal(0, 0.25)")) - expect_equal(unname(as.vector(summary_table[,3])), c(0.5, 0.5), tolerance = 1e-4) - expect_equal(unname(as.vector(summary_table[,4])), c(-424.1119, -423.0067), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,5])), c(0.2487827, 0.7512173), tolerance = 1e-3) - expect_equal(unname(as.vector(summary_table[,6])), c(0.3311728, 3.0195717), tolerance = 1e-3) - - # ensemble diagnostics - diagnostics_table <- ensemble_diagnostics_table(models, c("mu_x_fac3o"), remove_spike_0 = FALSE) - expect_equal(colnames(diagnostics_table), c("Model", "(mu) x_fac3o", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")) - expect_equal(unname(as.vector(diagnostics_table[,1])), c(1, 2)) - expect_equal(unname(as.vector(diagnostics_table[,2])), c("mean difference contrast: mSpike(0)", "mean difference contrast: mNormal(0, 0.25)")) - expect_equal(unname(as.vector(diagnostics_table[,3])), c(0.0004365069, 0.0006020573), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,4])), c(0.01, 0.01), tolerance = 1e-3) - expect_equal(unname(as.vector(diagnostics_table[,5])), c(0, 10554), tolerance = 1e-3) - -}) - -test_that("Summary tables functions work (mixture priors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, -0.15 + 0.20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior_mixture( - list( - prior("spike", list(0), prior_weights = 2), - prior("normal", list(-1, 0.5), prior_weights = 1), - prior("normal", list( 1, 0.5), prior_weights = 1) - ), - is_null = c(T, F, F) - ), - "x_cont1" = prior_mixture( - list( - prior("spike", list(0), prior_weights = 1), - prior("normal", list(0, 1), prior_weights = 1) - ), - is_null = c(T, F) - ), - "x_fac3t" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - prior_inclusion = prior("spike", list(0.5))) - ) - ) - attr(formula_prior_list1$mu$x_cont1, "multiply_by") <- "sigma" - prior_list1 <- list( - "sigma" = prior_mixture( - list( - prior("normal", list(0, 1), truncation = list(0, Inf)), - prior("lognormal", list(0, 1)) - ), - components = c("normal", "lognormal") - ), - "bias" = prior_mixture(list( - prior_none(prior_weights = 1), - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/3), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.025, 0.05)), prior_weights = 1/3), - prior_PET("normal", list(0, 1), prior_weights = 1/3) - ), is_null = c(T, F, F, F)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - if("RoBMA" %in% rownames(installed.packages())){ - require("RoBMA") - }else{ - skip() - } - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - - # bridge sampling cannot be computer for spike and slab priors - using a dummy value for marglik - marglik1 <- list(logml = 0) - class(marglik1) <- "bridge" - - # mix posteriors - models <- list( - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1), prior_weights = 1) - ) - models <- models_inference(models) - - ### checking summary functions - # model summary - model_summary <- model_summary_table(models[[1]], short_name = TRUE) - expect_equal(model_summary[,1], c("Model ", "Prior prob. ", "log(marglik) ", "Post. prob. ", "Inclusion BF ", " ")) - expect_equal(model_summary[,4], c( - "Parameter prior distributions", - "(mu) intercept ~ (2/4) * S(0) + (1/4) * N(-1, 0.5) + (1/4) * N(1, 0.5)", - "(mu) x_cont1 ~ (1/2) * S(0) + (1/2) * N(0, 1)", - "(mu) x_fac3t ~ orthonormal contrast: mN(0, 1) * S(0.5)", - "sigma ~ (1/2) * N(0, 1)[0, Inf] + (1/2) * Ln(0, 1)", - "bias ~ (1/2) * None + (0.33/2) * omega[2s: .05] ~ CumD(1, 1) + (0.33/2) * omega[1s: .05, .025] ~ CumD(1, 1, 1) + (0.33/2) * PET ~ N(0, 1)[0, Inf]" - )) - - model_estimates <- runjags_estimates_table(fit1) - expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept (inclusion) 0.596 NA NA NA NA NA NA NA NA", - "(mu) intercept -0.087 0.080 -0.226 -0.098 0.000 0.00246 0.031 1067 1.002", - "(mu) x_cont1 (inclusion) 0.999 NA NA NA NA NA NA NA NA", - "(mu) x_cont1 0.279 0.063 0.154 0.280 0.401 0.00063 0.010 11015 1.000", - "(mu) x_fac3t (inclusion) 0.855 NA NA NA NA NA NA NA NA", - "(mu) x_fac3t[1] 0.252 0.128 0.000 0.277 0.448 0.00467 0.037 939 1.016", - "(mu) x_fac3t[2] -0.012 0.074 -0.167 0.000 0.137 0.00057 0.008 17039 1.001", - "sigma (inclusion: normal) 0.510 NA NA NA NA NA NA NA NA", - "sigma (inclusion: lognormal) 0.490 NA NA NA NA NA NA NA NA", - "sigma 0.803 0.034 0.740 0.802 0.874 0.00039 0.011 7753 1.000", - "bias (inclusion) 0.497 NA NA NA NA NA NA NA NA", - "PET 0.130 0.377 0.000 0.000 1.410 0.00292 0.008 16826 1.000", - "omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA", - "omega[0.025,0.05] 0.865 0.248 0.139 1.000 1.000 0.00196 0.008 16000 1.000", - "omega[0.05,0.975] 0.809 0.316 0.053 1.000 1.000 0.00247 0.008 16361 1.000", - "omega[0.975,1] 0.889 0.267 0.076 1.000 1.000 0.00211 0.008 16128 1.000" - )) - - model_estimates <- suppressMessages(runjags_estimates_table(fit1, transform_factors = TRUE, conditional = TRUE)) - expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI", - "(mu) intercept (inclusion) 0.596 NA NA NA NA", - "(mu) intercept -0.145 0.047 -0.238 -0.146 -0.052", - "(mu) x_cont1 (inclusion) 0.999 NA NA NA NA", - "(mu) x_cont1 0.279 0.062 0.155 0.280 0.401", - "(mu) x_fac3t (inclusion) 0.855 NA NA NA NA", - "(mu) x_fac3t [dif: A] -0.012 0.066 -0.141 -0.012 0.116", - "(mu) x_fac3t [dif: B] -0.203 0.066 -0.333 -0.202 -0.074", - "(mu) x_fac3t [dif: C] 0.214 0.065 0.088 0.214 0.341", - "sigma (inclusion: normal) 0.510 NA NA NA NA", - "sigma (inclusion: lognormal) 0.490 NA NA NA NA", - "sigma[normal] 0.804 0.034 0.740 0.802 0.872", - "sigma[lognormal] 0.803 0.034 0.740 0.802 0.875", - "bias (inclusion) 0.497 NA NA NA NA", - "PET 0.780 0.589 0.031 0.656 2.113", - "omega[0,0.025] 1.000 0.000 1.000 1.000 1.000", - "omega[0.025,0.05] 0.592 0.275 0.048 0.627 0.984", - "omega[0.05,0.975] 0.421 0.279 0.017 0.386 0.953", - "omega[0.975,1] 0.663 0.374 0.027 0.916 1.000" - )) - - model_estimates <- runjags_estimates_table(fit1, transform_factors = TRUE, conditional = TRUE, remove_inclusion = TRUE) - expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI", - "(mu) intercept -0.145 0.047 -0.238 -0.146 -0.052", - "(mu) x_cont1 0.279 0.062 0.155 0.280 0.401", - "(mu) x_fac3t [dif: A] -0.012 0.066 -0.141 -0.012 0.116", - "(mu) x_fac3t [dif: B] -0.203 0.066 -0.333 -0.202 -0.074", - "(mu) x_fac3t [dif: C] 0.214 0.065 0.088 0.214 0.341", - "sigma[normal] 0.804 0.034 0.740 0.802 0.872", - "sigma[lognormal] 0.803 0.034 0.740 0.802 0.875", - "PET 0.780 0.589 0.031 0.656 2.113", - "omega[0,0.025] 1.000 0.000 1.000 1.000 1.000", - "omega[0.025,0.05] 0.592 0.275 0.048 0.627 0.984", - "omega[0.05,0.975] 0.421 0.279 0.017 0.386 0.953", - "omega[0.975,1] 0.663 0.374 0.027 0.916 1.000" - )) - - model_estimates <- runjags_estimates_table(fit1, transformations = list( - "mu_intercept" = list(fun = exp), - "mu_x_cont1" = list(fun = exp), - "sigma" = list(fun = exp), - "PET" = list(fun = exp) - )) - expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept (inclusion) 0.596 NA NA NA NA NA NA NA NA", - "(mu) intercept 0.920 0.073 0.798 0.907 1.000 0.00225 0.031 1061 1.002", - "(mu) x_cont1 (inclusion) 0.999 NA NA NA NA NA NA NA NA", - "(mu) x_cont1 1.324 0.083 1.166 1.323 1.494 0.00081 0.010 11242 1.000", - "(mu) x_fac3t (inclusion) 0.855 NA NA NA NA NA NA NA NA", - "(mu) x_fac3t[1] 0.252 0.128 0.000 0.277 0.448 0.00467 0.037 939 1.016", - "(mu) x_fac3t[2] -0.012 0.074 -0.167 0.000 0.137 0.00057 0.008 17039 1.001", - "sigma (inclusion: normal) 0.510 NA NA NA NA NA NA NA NA", - "sigma (inclusion: lognormal) 0.490 NA NA NA NA NA NA NA NA", - "sigma 2.235 0.077 2.097 2.231 2.395 0.00088 0.011 7722 1.000", - "bias (inclusion) 0.497 NA NA NA NA NA NA NA NA", - "PET 1.288 1.525 1.000 1.000 4.095 0.01205 0.008 16030 1.093", - "omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA", - "omega[0.025,0.05] 0.865 0.248 0.139 1.000 1.000 0.00196 0.008 16000 1.000", - "omega[0.05,0.975] 0.809 0.316 0.053 1.000 1.000 0.00247 0.008 16361 1.000", - "omega[0.975,1] 0.889 0.267 0.076 1.000 1.000 0.00211 0.008 16128 1.000" - )) - - model_estimates <- runjags_estimates_table(fit1, conditional = TRUE, remove_inclusion = TRUE, transformations = list( - "mu_intercept" = list(fun = exp), - "mu_x_cont1" = list(fun = exp), - "sigma" = list(fun = exp), - "PET" = list(fun = exp) - )) - expect_equal(capture_output_lines(print(model_estimates), width = 150), c( - " Mean SD lCI Median uCI", - "(mu) intercept 0.866 0.041 0.788 0.864 0.949", - "(mu) x_cont1 1.325 0.083 1.168 1.323 1.494", - "(mu) x_fac3t[1] 0.295 0.081 0.138 0.295 0.454", - "(mu) x_fac3t[2] -0.014 0.080 -0.173 -0.015 0.142", - "sigma[normal] 2.235 0.077 2.097 2.231 2.392", - "sigma[lognormal] 2.234 0.077 2.097 2.231 2.400", - "PET 2.726 3.384 1.032 1.927 8.272", - "omega[0,0.025] 1.000 0.000 1.000 1.000 1.000", - "omega[0.025,0.05] 0.592 0.275 0.048 0.627 0.984", - "omega[0.05,0.975] 0.421 0.279 0.017 0.386 0.953", - "omega[0.975,1] 0.663 0.374 0.027 0.916 1.000" - )) - - model_inference <- runjags_inference_table(fit1) - expect_equal(capture_output_lines(print(model_inference), width = 150), c( - " Prior prob. Post. prob. Inclusion BF", - "(mu) intercept 0.500 0.596 1.478", - "(mu) x_cont1 0.500 0.999 841.105", - "(mu) x_fac3t 0.500 0.855 5.894", - "sigma [normal] 0.500 0.510 1.041", - "sigma [lognormal] 0.500 0.490 0.961", - "bias 0.500 0.497 0.989" - )) - - model_inference <- update(model_inference, title = "Table 1", footnotes = c("Footnote 1", "Footnote 2"), logBF = TRUE) - expect_equal(capture_output_lines(print(model_inference), width = 150), c( - "Table 1" , - " Prior prob. Post. prob. log(Inclusion BF)", - "(mu) intercept 0.500 0.596 0.391", - "(mu) x_cont1 0.500 0.999 6.735", - "(mu) x_fac3t 0.500 0.855 1.774", - "sigma [normal] 0.500 0.510 0.040", - "sigma [lognormal] 0.500 0.490 -0.040", - "bias 0.500 0.497 -0.011", - "Footnote 1" , - "Footnote 2" )) -}) - -test_that("Summary tables odd cases",{ - - set.seed(1) - - data <- list( - y = rnorm(10), - N = 10 - ) - - prior_list <- list( - "mu" = prior_mixture( - list(prior("spike", list(0))), - is_null = c(FALSE) - ), - "sigma" = prior_mixture( - list(prior("spike", list(1))), - is_null = c(TRUE) - ), - "beta" = prior("normal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu, 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list - ) - - expect_equal(capture_output_lines(print(runjags_estimates_table(fit)), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "mu (inclusion) 1.000 NA NA NA NA NA NA NA NA", - "mu 0.000 0.000 0.000 0.000 0.000 0.00000 NA 0 NA", - "sigma (inclusion) 0.000 NA NA NA NA NA NA NA NA", - "sigma 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA", - "beta -0.014 0.999 -1.985 -0.003 1.930 0.00805 0.008 15412 1.000" - )) - - expect_equal(capture_output_lines(print(runjags_estimates_table(fit, conditional = TRUE)), width = 150), c( - " Mean SD lCI Median uCI", - "mu (inclusion) 1.000 NA NA NA NA", - "mu 0.000 0.000 0.000 0.000 0.000", - "sigma (inclusion) 0.000 NA NA NA NA", - "sigma NaN NA NA NA NA", - "beta -0.014 0.999 -1.985 -0.003 1.930", - "\033[0;31mConditional summary for sigma parameter could not be computed due to no posterior samples.\033[0m" - )) - - expect_equal(capture_output_lines(print(runjags_inference_table(fit)), width = 150), c( - " Prior prob. Post. prob. Inclusion BF", - "mu 1.000 1.000 Inf", - "sigma 0.000 0.000 0.000" - )) - -}) - -test_that("Simplified interpret2 function", { - - set.seed(1) - information <- list( - list( - inference_name = "Effect", - inference_BF_name = "BF10", - inference_BF = 3.5, - estimate_name = "mu", - estimate_samples = rnorm(1000, 0.3, 0.15), - estimate_units = "kg", - estimate_conditional = FALSE - ) - ) - - expect_equal( - interpret2(information, "RoBMA"), - "RoBMA found moderate evidence in favor of the Effect, BF10 = 3.50, with mean model-averaged estimate mu = 0.298 kg, 95% CI [-0.020, 0.601]." - ) - -}) From 83d06cc1088618b92c0ea8822d92027760c1135e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= <38475991+FBartos@users.noreply.github.com> Date: Wed, 10 Dec 2025 11:42:59 +0100 Subject: [PATCH 05/38] update summary tables tests (#54) --- .github/instructions/tests.instructions.md | 32 +- .../instructions/vignettes.instructions.md | 22 +- .../complex_ensemble_diagnostics.txt | 8 + .../complex_ensemble_estimates.txt | 5 + .../complex_ensemble_inference.txt | 4 + .../complex_ensemble_summary.txt | 4 + .../empty_ensemble_diagnostics.txt | 2 + .../empty_ensemble_estimates.txt | 0 .../empty_ensemble_inference.txt | 0 .../fixed_wf_estimates.txt | 7 + .../fixed_wf_inference.txt | 3 + .../interaction_ensemble_estimates.txt | 6 + .../interaction_ensemble_inference.txt | 4 + .../interaction_ensemble_summary.txt | 3 + .../simple_ensemble_diagnostics.txt | 4 + .../simple_ensemble_diagnostics_trimmed.txt | 4 + .../simple_ensemble_estimates.txt | 5 + .../simple_ensemble_inference.txt | 3 + .../simple_ensemble_summary.txt | 4 + .../simple_interpretation.txt | 1 + .../simple_interpretation2.txt | 1 + .../simple_ma_estimates.txt | 3 + .../simple_ma_inference.txt | 3 + .../spike_factors_estimates.txt | 3 + .../spike_factors_inference.txt | 2 + ...ula_interaction_mix_main_model_summary.txt | 6 + ...interaction_mix_main_runjags_estimates.txt | 6 + ..._formula_interaction_mix_model_summary.txt | 7 + .../fit_spike_factors_alt_model_summary.txt | 6 + ...it_spike_factors_alt_runjags_estimates.txt | 5 + .../fit_spike_factors_null_model_summary.txt | 6 + ...t_spike_factors_null_runjags_estimates.txt | 3 + .../fit_summary3_model_summary.txt | 6 + .../fit_summary3_runjags_estimates.txt | 4 + tests/testthat/common-functions.R | 62 ++++ tests/testthat/test-00-model-fits.R | 194 ++++++++-- tests/testthat/test-JAGS-ensemble-tables.R | 342 ++++++++++++++++++ tests/testthat/test-JAGS-summary-tables.R | 92 ++--- 38 files changed, 726 insertions(+), 146 deletions(-) create mode 100644 tests/results/JAGS-ensemble-tables/complex_ensemble_diagnostics.txt create mode 100644 tests/results/JAGS-ensemble-tables/complex_ensemble_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/complex_ensemble_inference.txt create mode 100644 tests/results/JAGS-ensemble-tables/complex_ensemble_summary.txt create mode 100644 tests/results/JAGS-ensemble-tables/empty_ensemble_diagnostics.txt rename tests/results/{JAGS-summary-tables => JAGS-ensemble-tables}/empty_ensemble_estimates.txt (100%) rename tests/results/{JAGS-summary-tables => JAGS-ensemble-tables}/empty_ensemble_inference.txt (100%) create mode 100644 tests/results/JAGS-ensemble-tables/fixed_wf_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/fixed_wf_inference.txt create mode 100644 tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt create mode 100644 tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics_trimmed.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ensemble_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ensemble_inference.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ensemble_summary.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_interpretation.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_interpretation2.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ma_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/simple_ma_inference.txt create mode 100644 tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/spike_factors_inference.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_interaction_mix_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary3_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt create mode 100644 tests/testthat/common-functions.R create mode 100644 tests/testthat/test-JAGS-ensemble-tables.R diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 7c4465c..164099b 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -61,32 +61,10 @@ marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.R ### 5. Helper Functions for Reference Files -**Use a helper function to reduce repetition** when saving/testing reference files: - -```r # Define at the top of test files with reference outputs -test_reference <- function(table, filename, info_msg = NULL, - print_dir = testthat::test_path("..", "results", "print")) { - if (GENERATE_REFERENCE_FILES) { - # Save mode - if (!dir.exists(print_dir)) { - dir.create(print_dir, recursive = TRUE) - } - writeLines(capture_output_lines(table, print = TRUE, width = 150), - file.path(print_dir, filename)) - } else { - # Test mode - ref_file <- file.path(print_dir, filename) - if (file.exists(ref_file)) { - expected_output <- readLines(ref_file, warn = FALSE) - actual_output <- capture_output_lines(table, print = TRUE, width = 150) - expect_equal(actual_output, expected_output, info = info_msg) - } else { - skip(paste("Reference file", filename, "not found.")) - } - } -} -``` +# Load common test helpers that define test_reference_table() and test_reference_text() +REFERENCE_DIR <- testthat::test_path("..", "results", "print") +source(testthat::test_path("common-functions.R")) ### 6. Test File Organization @@ -121,11 +99,11 @@ All tests that use JAGS models (e.g., `test-model-averaging.R`, `test-JAGS-*.R`, - [ ] Check marginal likelihood file existence before loading **Updating summary table tests (MAINTAINER ONLY):** -- [ ] Set `GENERATE_REFERENCE_FILES <- TRUE` in `test-summary-tables.R` +- [ ] Set `GENERATE_REFERENCE_FILES <- TRUE` - [ ] Run tests to generate reference files - [ ] Review diffs carefully before committing - [ ] Reset flag to `FALSE` -- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES`CE_FILES <- TRUE` in `test-summary-tables.R` +- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES <- TRUE` - [ ] Run tests to generate reference files - [ ] Review diffs carefully before committing - [ ] Reset flag to `FALSE` diff --git a/.github/instructions/vignettes.instructions.md b/.github/instructions/vignettes.instructions.md index 8dc4e09..37ad574 100644 --- a/.github/instructions/vignettes.instructions.md +++ b/.github/instructions/vignettes.instructions.md @@ -2,28 +2,14 @@ applyTo: "**/vignettes/*.Rmd" --- -# Vignette Writing Instructions for RoBMA +# Vignette Writing Instructions for BayesTools -This document provides guidance for writing and maintaining vignettes in the RoBMA package. +This document provides guidance for writing and maintaining vignettes in the BayesTools package. ## Overview -RoBMA vignettes are R Markdown documents that demonstrate package functionality with real-world examples. They are pre-computed and cached to avoid CRAN check timeouts, as Bayesian model fitting is computationally intensive. - -## Vignette Structure - -### Current Vignettes -1. **Tutorial.Rmd** - Introduction to RoBMA-PSMA (publication bias adjustment) -2. **ReproducingBMA.Rmd** - Classic Bayesian model-averaged meta-analysis (no publication bias) -3. **MetaRegression.Rmd** - `RoBMA.reg()` with moderators -4. **HierarchicalRoBMA.Rmd** - Multilevel RoBMA -5. **HierarchicalRoBMARegression.Rmd** - Multilevel RoBMA with moderators -6. **HierarchicalBMA.Rmd** - Simpler multilevel models via `study_ids` -7. **MedicineBMA.Rmd** - Informed priors for medical meta-analysis (continuous outcomes) -8. **MedicineBiBMA.Rmd** - Informed priors for binary outcomes (log OR, RR, RD, HR) -9. **CustomEnsembles.Rmd** - Advanced ensemble customization -10. **FastRoBMA.Rmd** - Spike-and-slab algorithm (`algorithm = "ss"`) -11. **ZCurveDiagnostics.Rmd** - Meta-analytic z-curve publication bias diagnostics +BayesTools vignettes are R Markdown documents that demonstrate package functionality with real-world examples. They are pre-computed and cached to avoid CRAN check timeouts, as Bayesian model fitting is computationally intensive. + ## Standard YAML Header diff --git a/tests/results/JAGS-ensemble-tables/complex_ensemble_diagnostics.txt b/tests/results/JAGS-ensemble-tables/complex_ensemble_diagnostics.txt new file mode 100644 index 0000000..1f29c1a --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/complex_ensemble_diagnostics.txt @@ -0,0 +1,8 @@ + Model Prior (mu) x_cont1 Prior (mu) x_fac2t Prior (mu) x_fac3o max[error(MCMC)] max[error(MCMC)/SD] min(ESS) + 1 Normal(0, 1) 0.00317 0.039 674 + 2 Normal(0, 1) treatment contrast: Normal(0, 1) 0.00950 0.052 371 + 3 Normal(0, 1) orthonormal contrast: mNormal(0, 1) 0.00604 0.044 505 + max(R-hat) + 1.016 + 1.005 + 1.008 diff --git a/tests/results/JAGS-ensemble-tables/complex_ensemble_estimates.txt b/tests/results/JAGS-ensemble-tables/complex_ensemble_estimates.txt new file mode 100644 index 0000000..fd01ce0 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/complex_ensemble_estimates.txt @@ -0,0 +1,5 @@ + Mean Median 0.025 0.95 +(mu) x_cont1 0.392 0.395 0.179 0.573 +(mu) x_fac2t[B] 0.004 0.000 -0.153 0.099 +(mu) x_fac3o[1] 0.010 0.000 0.000 0.000 +(mu) x_fac3o[2] 0.006 0.000 0.000 0.000 diff --git a/tests/results/JAGS-ensemble-tables/complex_ensemble_inference.txt b/tests/results/JAGS-ensemble-tables/complex_ensemble_inference.txt new file mode 100644 index 0000000..541ab2f --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/complex_ensemble_inference.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +(mu) x_cont1 3/3 1.000 1.000 Inf +(mu) x_fac2t 1/3 0.333 0.153 0.361 +(mu) x_fac3o 1/3 0.333 0.054 0.115 diff --git a/tests/results/JAGS-ensemble-tables/complex_ensemble_summary.txt b/tests/results/JAGS-ensemble-tables/complex_ensemble_summary.txt new file mode 100644 index 0000000..cfae579 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/complex_ensemble_summary.txt @@ -0,0 +1,4 @@ + Model Prior (mu) x_cont1 Prior (mu) x_fac2t Prior (mu) x_fac3o Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) 0.333 -146.01 0.793 7.649 + 2 Normal(0, 1) treatment contrast: Normal(0, 1) 0.333 -147.65 0.153 0.361 + 3 Normal(0, 1) orthonormal contrast: mNormal(0, 1) 0.333 -148.68 0.054 0.115 diff --git a/tests/results/JAGS-ensemble-tables/empty_ensemble_diagnostics.txt b/tests/results/JAGS-ensemble-tables/empty_ensemble_diagnostics.txt new file mode 100644 index 0000000..7332672 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/empty_ensemble_diagnostics.txt @@ -0,0 +1,2 @@ +[1] Model max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt b/tests/results/JAGS-ensemble-tables/empty_ensemble_estimates.txt similarity index 100% rename from tests/results/JAGS-summary-tables/empty_ensemble_estimates.txt rename to tests/results/JAGS-ensemble-tables/empty_ensemble_estimates.txt diff --git a/tests/results/JAGS-summary-tables/empty_ensemble_inference.txt b/tests/results/JAGS-ensemble-tables/empty_ensemble_inference.txt similarity index 100% rename from tests/results/JAGS-summary-tables/empty_ensemble_inference.txt rename to tests/results/JAGS-ensemble-tables/empty_ensemble_inference.txt diff --git a/tests/results/JAGS-ensemble-tables/fixed_wf_estimates.txt b/tests/results/JAGS-ensemble-tables/fixed_wf_estimates.txt new file mode 100644 index 0000000..076bb96 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/fixed_wf_estimates.txt @@ -0,0 +1,7 @@ + Mean Median 0.025 0.95 +m 0.149 0.149 -0.219 0.455 +omega[0,0.05] 0.788 1.000 0.300 1.000 +omega[0.05,0.1] 0.563 0.497 0.082 1.000 +omega[0.1,0.5] 0.775 0.936 0.082 1.000 +omega[0.5,0.9] 0.677 0.836 0.033 1.000 +omega[0.9,1] 0.465 0.300 0.033 1.000 diff --git a/tests/results/JAGS-ensemble-tables/fixed_wf_inference.txt b/tests/results/JAGS-ensemble-tables/fixed_wf_inference.txt new file mode 100644 index 0000000..3759268 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/fixed_wf_inference.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Inclusion BF +m 4/4 1.000 1.000 Inf +omega 3/4 0.750 0.859 2.028 diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt new file mode 100644 index 0000000..357ec9a --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt @@ -0,0 +1,6 @@ + Mean Median 0.025 0.95 +(mu) x_cont1 0.449 0.448 0.207 0.643 +(mu) x_fac3o[1] -0.003 -0.002 -0.378 0.320 +(mu) x_fac3o[2] -0.109 -0.107 -0.489 0.197 +(mu) x_cont1:x_fac3o[1] -0.015 0.000 -0.296 0.000 +(mu) x_cont1:x_fac3o[2] -0.004 0.000 -0.137 0.000 diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt new file mode 100644 index 0000000..a0227dd --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +(mu) x_cont1 2/2 1.000 1.000 Inf +(mu) x_fac3o 2/2 1.000 1.000 Inf +(mu) x_cont1:x_fac3o 1/2 0.500 0.071 0.076 diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt new file mode 100644 index 0000000..b984601 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt @@ -0,0 +1,3 @@ + Model Prior (mu) x_cont1 Prior (mu) x_fac3o Prior (mu) x_cont1:x_fac3o Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -158.89 0.929 13.112 + 2 Normal(0, 1) orthonormal contrast: mNormal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -161.46 0.071 0.076 diff --git a/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics.txt b/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics.txt new file mode 100644 index 0000000..2c34499 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics.txt @@ -0,0 +1,4 @@ + Model Prior m Prior omega max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 Normal(0, 1) 0.01019 0.048 434 NA + 2 Normal(0, 0.5) omega[one-sided: .05] ~ CumDirichlet(1, 1) 0.01348 0.047 461 NA + 3 Normal(0, 0.3) omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) 0.01061 0.045 500 NA diff --git a/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics_trimmed.txt b/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics_trimmed.txt new file mode 100644 index 0000000..d74066a --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ensemble_diagnostics_trimmed.txt @@ -0,0 +1,4 @@ + Model max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 0.01019 0.048 434 NA + 2 0.01348 0.047 461 NA + 3 0.01061 0.045 500 NA diff --git a/tests/results/JAGS-ensemble-tables/simple_ensemble_estimates.txt b/tests/results/JAGS-ensemble-tables/simple_ensemble_estimates.txt new file mode 100644 index 0000000..8d734cb --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ensemble_estimates.txt @@ -0,0 +1,5 @@ + Mean Median 0.025 0.95 +m 0.153 0.153 -0.220 0.461 +omega[0,0.05] 1.000 1.000 1.000 1.000 +omega[0.05,0.5] 0.674 0.739 0.061 1.000 +omega[0.5,1] 0.535 0.497 0.023 1.000 diff --git a/tests/results/JAGS-ensemble-tables/simple_ensemble_inference.txt b/tests/results/JAGS-ensemble-tables/simple_ensemble_inference.txt new file mode 100644 index 0000000..0ab5fa6 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ensemble_inference.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Inclusion BF +m 3/3 1.000 1.000 Inf +omega 2/3 0.667 0.797 1.968 diff --git a/tests/results/JAGS-ensemble-tables/simple_ensemble_summary.txt b/tests/results/JAGS-ensemble-tables/simple_ensemble_summary.txt new file mode 100644 index 0000000..faa7e9b --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ensemble_summary.txt @@ -0,0 +1,4 @@ + Model Prior m Prior omega Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) 0.333 -1.11 0.203 0.508 + 2 Normal(0, 0.5) omega[one-sided: .05] ~ CumDirichlet(1, 1) 0.333 -0.54 0.356 1.107 + 3 Normal(0, 0.3) omega[one-sided: .5, .05] ~ CumDirichlet(1, 1, 1) 0.333 -0.33 0.441 1.578 diff --git a/tests/results/JAGS-ensemble-tables/simple_interpretation.txt b/tests/results/JAGS-ensemble-tables/simple_interpretation.txt new file mode 100644 index 0000000..85e726b --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_interpretation.txt @@ -0,0 +1 @@ +Test found strong evidence in favor of the effect, BF_10 = Inf, with mean model-averaged estimate y = 0.153, 95% CI [-0.220, 0.525]. diff --git a/tests/results/JAGS-ensemble-tables/simple_interpretation2.txt b/tests/results/JAGS-ensemble-tables/simple_interpretation2.txt new file mode 100644 index 0000000..e4c080d --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_interpretation2.txt @@ -0,0 +1 @@ +Test2 found moderate evidence against the effect, BF_10 = 0.200, with mean conditional estimate y = 0.153 mm, 95% CI [-0.220, 0.525]. Test2 found weak evidence in favor of the bias, BF_pb = 1.97. diff --git a/tests/results/JAGS-ensemble-tables/simple_ma_estimates.txt b/tests/results/JAGS-ensemble-tables/simple_ma_estimates.txt new file mode 100644 index 0000000..82fde6b --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ma_estimates.txt @@ -0,0 +1,3 @@ + Mean Median 0.025 0.95 +m 0.004 0.000 0.000 0.024 +s 0.424 0.422 0.353 0.503 diff --git a/tests/results/JAGS-ensemble-tables/simple_ma_inference.txt b/tests/results/JAGS-ensemble-tables/simple_ma_inference.txt new file mode 100644 index 0000000..cf2b1d8 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/simple_ma_inference.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Inclusion BF +m 1/2 0.500 0.079 0.085 +s 2/2 1.000 1.000 Inf diff --git a/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt b/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt new file mode 100644 index 0000000..11e12e0 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt @@ -0,0 +1,3 @@ + Mean Median 0.025 0.95 +(mu) x_fac3md[1] -0.027 0.000 -0.257 0.000 +(mu) x_fac3md[2] 0.007 0.000 -0.122 0.127 diff --git a/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt b/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt new file mode 100644 index 0000000..1eaa23c --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt @@ -0,0 +1,2 @@ + Models Prior prob. Post. prob. Inclusion BF +(mu) x_fac3md 1/2 0.500 0.252 0.337 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_model_summary.txt new file mode 100644 index 0000000..16528ae --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -158.89 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1) + Inclusion BF Inf sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt new file mode 100644 index 0000000..4f803e0 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.025 0.110 -0.199 0.025 0.228 0.00338 0.031 1071 1.001 +(mu) x_cont1 0.448 0.124 0.207 0.449 0.689 0.00392 0.032 1000 1.000 +(mu) x_fac3o[1] -0.007 0.185 -0.378 -0.006 0.362 0.00584 0.032 1000 1.005 +(mu) x_fac3o[2] -0.112 0.189 -0.489 -0.108 0.251 0.00549 0.029 1225 0.999 +sigma 1.085 0.082 0.941 1.077 1.264 0.00378 0.046 476 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_model_summary.txt new file mode 100644 index 0000000..4ab4d0b --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_model_summary.txt @@ -0,0 +1,7 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -161.46 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_fac3o ~ orthonormal contrast: mNormal(0, 1) + Inclusion BF Inf (mu) x_cont1:x_fac3o ~ orthonormal contrast: mNormal(0, 1) + sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt new file mode 100644 index 0000000..d3f942a --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -138.42 (mu) x_fac3md ~ mean difference contrast: mNormal(0, 0.25) + Post. prob. 1.000 sigma ~ Lognormal(0, 1) + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt new file mode 100644 index 0000000..ccd089b --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.102 0.092 -0.068 0.101 0.284 0.00314 0.034 912 1.000 +(mu) x_fac3md[1] -0.106 0.112 -0.331 -0.102 0.104 0.00356 0.032 1000 1.000 +(mu) x_fac3md[2] 0.029 0.112 -0.197 0.036 0.237 0.00356 0.032 1000 1.000 +sigma 0.915 0.069 0.797 0.909 1.066 0.00312 0.045 489 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt new file mode 100644 index 0000000..6d17f8d --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -137.33 sigma ~ Lognormal(0, 1) + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt new file mode 100644 index 0000000..7718867 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.110 0.090 -0.068 0.111 0.288 0.00286 0.032 1000 1.002 +sigma 0.905 0.069 0.785 0.899 1.049 0.00291 0.042 560 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_summary3_model_summary.txt b/tests/results/JAGS-summary-tables/fit_summary3_model_summary.txt new file mode 100644 index 0000000..456b27d --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary3_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 m ~ Normal(0, 0.3) + log(marglik) -0.34 omega[two-sided: .2] = (1, 0.3) + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt new file mode 100644 index 0000000..c489ca4 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.132 0.173 -0.219 0.132 0.482 0.00772 0.045 500 NA +omega[0,0.2] 0.300 0.000 0.300 0.300 0.300 NA NA NA NA +omega[0.2,1] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R new file mode 100644 index 0000000..4e1dec8 --- /dev/null +++ b/tests/testthat/common-functions.R @@ -0,0 +1,62 @@ +# ============================================================================ # +# CONFIGURATION: Set to TRUE to regenerate reference files, FALSE to run tests +# ============================================================================ # +if (!exists("GENERATE_REFERENCE_FILES")) { + GENERATE_REFERENCE_FILES <- FALSE +} + +# Get the directory where prefitted models are stored +temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") +if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { + temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") +} + +# Skip tests on CRAN as they require pre-fitted models +skip_on_cran() + +# ============================================================================ # +# HELPER FUNCTIONS +# ============================================================================ # + +# Process reference file: save if GENERATE_REFERENCE_FILES=TRUE, test otherwise +test_reference_table <- function(table, filename, info_msg = NULL, + print_dir = REFERENCE_DIR) { + if (GENERATE_REFERENCE_FILES) { + # Save mode + if (!dir.exists(print_dir)) { + dir.create(print_dir, recursive = TRUE) + } + writeLines(capture_output_lines(table, print = TRUE, width = 150), + file.path(print_dir, filename)) + } else { + # Test mode + ref_file <- file.path(print_dir, filename) + if (file.exists(ref_file)) { + expected_output <- readLines(ref_file, warn = FALSE) + actual_output <- capture_output_lines(table, print = TRUE, width = 150) + expect_equal(actual_output, expected_output, info = info_msg) + } else { + skip(paste("Reference file", filename, "not found.")) + } + } +} + +test_reference_text <- function(text, filename, info_msg = NULL, + print_dir = REFERENCE_DIR) { + if (GENERATE_REFERENCE_FILES) { + # Save mode + if (!dir.exists(print_dir)) { + dir.create(print_dir, recursive = TRUE) + } + writeLines(text, file.path(print_dir, filename)) + } else { + # Test mode + ref_file <- file.path(print_dir, filename) + if (file.exists(ref_file)) { + expected_output <- readLines(ref_file, warn = FALSE) + expect_equal(text, expected_output, info = info_msg) + } else { + skip(paste("Reference file", filename, "not found.")) + } + } +} diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 15c78aa..7302caf 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -60,9 +60,9 @@ save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_pr ) } -# ============================================================================== +# ============================================================================ # # SECTION 1: SIMPLE PRIOR DISTRIBUTIONS -# ============================================================================== +# ============================================================================ # test_that("Simple prior models fit correctly", { skip_if_not_installed("rjags") @@ -188,9 +188,9 @@ test_that("Simple prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 1B: MODELS FOR SUMMARY TABLES TESTING -# ============================================================================== +# ============================================================================ # test_that("Summary tables models fit correctly", { skip_if_not_installed("rjags") @@ -275,15 +275,36 @@ test_that("Summary tables models fit correctly", { model_registry[["fit_summary2"]] <<- result$registry_entry fit_summary2 <- result$fit + # Model 4: Normal prior with fixed weightfunction + priors_summary3 <- list( + m = prior("normal", list(0, .3)), + omega = prior_weightfunction("two.sided.fixed", list(0.20, c(.3, 1))) + ) + + fit_summary3 <- JAGS_fit(model_syntax_summary, data_summary, priors_summary3, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) + + marglik_summary3 <- JAGS_bridgesampling(fit_summary3, + log_posterior = log_posterior_summary, + data = data_summary, prior_list = priors_summary3) + + result <- save_fit(fit_summary3, "fit_summary3", + marglik = marglik_summary3, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with fixed weightfunction") + model_registry[["fit_summary3"]] <<- result$registry_entry + fit_summary3 <- result$fit + expect_true(file.exists(file.path(temp_fits_dir, "fit_summary0.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_summary1.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_summary2.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_summary3.RDS"))) }) -# ============================================================================== +# ============================================================================ # # SECTION 2: VECTOR PRIOR DISTRIBUTIONS -# ============================================================================== +# ============================================================================ # test_that("Vector prior models fit correctly", { skip_if_not_installed("rjags") @@ -339,9 +360,10 @@ test_that("Vector prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # + # SECTION 3: FACTOR PRIOR DISTRIBUTIONS -# ============================================================================== +# ============================================================================ # test_that("Factor prior models fit correctly", { skip_if_not_installed("rjags") @@ -417,9 +439,9 @@ test_that("Factor prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 4: WEIGHTFUNCTION PRIORS -# ============================================================================== +# ============================================================================ # test_that("Weightfunction prior models fit correctly", { skip_if_not_installed("rjags") @@ -491,9 +513,9 @@ test_that("Weightfunction prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 5: SPIKE-AND-SLAB PRIORS -# ============================================================================== +# ============================================================================ # test_that("Spike-and-slab prior models fit correctly", { skip_if_not_installed("rjags") @@ -542,9 +564,9 @@ test_that("Spike-and-slab prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 6: MIXTURE PRIORS -# ============================================================================== +# ============================================================================ # test_that("Mixture prior models fit correctly", { skip_if_not_installed("rjags") @@ -618,9 +640,9 @@ test_that("Mixture prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 7: FORMULA-BASED MODELS (SIMPLE REGRESSION) -# ============================================================================== +# ============================================================================ # test_that("Simple formula-based regression models fit correctly", { skip_if_not_installed("rjags") @@ -747,9 +769,9 @@ test_that("Simple formula-based regression models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 8: FORMULA-BASED MODELS (INTERACTIONS) -# ============================================================================== +# ============================================================================ # test_that("Formula-based interaction models fit correctly", { skip_if_not_installed("rjags") @@ -815,12 +837,54 @@ test_that("Formula-based interaction models fit correctly", { formula_list = formula_list_mix_int, formula_data_list = formula_data_list_mix_int, formula_prior_list = formula_prior_list_mix_int, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + # Compute marginal likelihood for model averaging + log_posterior_formula <- function(parameters, data){ + sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) + } + marglik_formula_interaction_mix <- JAGS_bridgesampling( + fit_formula_interaction_mix, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list, + formula_list = formula_list_mix_int, formula_data_list = formula_data_list_mix_int, + formula_prior_list = formula_prior_list_mix_int) + result <- save_fit(fit_formula_interaction_mix, "fit_formula_interaction_mix", + marglik = marglik_formula_interaction_mix, formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, note = "Continuous-factor interaction with 3-level orthonormal factor") model_registry[["fit_formula_interaction_mix"]] <<- result$registry_entry fit_formula_interaction_mix <- result$fit + # Continuous-factor interaction (Main effects only) + formula_list_mix_main <- list(mu = ~ x_cont1 + x_fac3o) + formula_data_list_mix_main <- list(mu = data_formula) + formula_prior_list_mix_main <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + ) + ) + + fit_formula_interaction_mix_main <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_mix_main, formula_data_list = formula_data_list_mix_main, + formula_prior_list = formula_prior_list_mix_main, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + marglik_formula_interaction_mix_main <- JAGS_bridgesampling( + fit_formula_interaction_mix_main, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list, + formula_list = formula_list_mix_main, formula_data_list = formula_data_list_mix_main, + formula_prior_list = formula_prior_list_mix_main) + + result <- save_fit(fit_formula_interaction_mix_main, "fit_formula_interaction_mix_main", + marglik = marglik_formula_interaction_mix_main, + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Continuous-factor main effects only (for interaction test)") + model_registry[["fit_formula_interaction_mix_main"]] <<- result$registry_entry + fit_formula_interaction_mix_main <- result$fit + # Factor-factor interaction formula_list_fac_int <- list(mu = ~ x_fac2t * x_fac3o) formula_data_list_fac_int <- list(mu = data_formula) @@ -887,9 +951,9 @@ test_that("Formula-based interaction models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 9: FORMULA-BASED MODELS (MULTIPLE FORMULAS) -# ============================================================================== +# ============================================================================ # test_that("Multi-formula models fit correctly", { skip_if_not_installed("rjags") @@ -952,9 +1016,9 @@ test_that("Multi-formula models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 10: RANDOM EFFECTS MODELS -# ============================================================================== +# ============================================================================ # test_that("Random effects models fit correctly", { skip_if_not_installed("rjags") @@ -1054,9 +1118,9 @@ test_that("Random effects models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 11: SPIKE FACTOR PRIORS -# ============================================================================== +# ============================================================================ # test_that("Spike factor prior models fit correctly", { skip_if_not_installed("rjags") @@ -1104,13 +1168,79 @@ test_that("Spike factor prior models fit correctly", { model_registry[["fit_spike_factors"]] <<- result$registry_entry fit_spike_factors <- result$fit + # Spike vs Normal factor (meandif contrast) + # ------------------------------------------------------- + formula_list_sf <- list(mu = ~ x_fac3md) + formula_data_list_sf <- list(mu = data_formula) + + # Log posterior for formula models + log_posterior_formula <- function(parameters, data){ + sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) + } + + # Null model (Spike) + formula_prior_list_sf_null <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) + ) + ) + + fit_spike_factors_null <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, + formula_prior_list = formula_prior_list_sf_null, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + marglik_spike_factors_null <- JAGS_bridgesampling( + fit_spike_factors_null, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list, + formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, + formula_prior_list = formula_prior_list_sf_null) + + result <- save_fit(fit_spike_factors_null, "fit_spike_factors_null", + marglik = marglik_spike_factors_null, + formulas = TRUE, factor_priors = TRUE, + note = "Spike factor prior (meandif)") + model_registry[["fit_spike_factors_null"]] <<- result$registry_entry + fit_spike_factors_null <- result$fit + + # Alternative model (Normal) + formula_prior_list_sf_alt <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) + ) + ) + + fit_spike_factors_alt <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, + formula_prior_list = formula_prior_list_sf_alt, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + + marglik_spike_factors_alt <- JAGS_bridgesampling( + fit_spike_factors_alt, log_posterior = log_posterior_formula, data = data, + prior_list = prior_list, + formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, + formula_prior_list = formula_prior_list_sf_alt) + + result <- save_fit(fit_spike_factors_alt, "fit_spike_factors_alt", + marglik = marglik_spike_factors_alt, + formulas = TRUE, factor_priors = TRUE, + note = "Normal factor prior (meandif)") + model_registry[["fit_spike_factors_alt"]] <<- result$registry_entry + fit_spike_factors_alt <- result$fit + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors_null.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors_alt.RDS"))) }) -# ============================================================================== +# ============================================================================ # # SECTION 12: JOINT MODELS (FORMULA + SPIKE-AND-SLAB + MIXTURE) -# ============================================================================== +# ============================================================================ # test_that("Joint complex models fit correctly", { skip_if_not_installed("rjags") @@ -1189,9 +1319,9 @@ test_that("Joint complex models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 13: EXPRESSION PRIORS -# ============================================================================== +# ============================================================================ # test_that("Expression prior models fit correctly", { skip_if_not_installed("rjags") @@ -1255,9 +1385,9 @@ test_that("Expression prior models fit correctly", { }) -# ============================================================================== +# ============================================================================ # # SECTION 14: ADVANCED JAGS_FIT FEATURES -# ============================================================================== +# ============================================================================ # test_that("Advanced JAGS_fit features work correctly", { skip_if_not_installed("rjags") @@ -1388,9 +1518,9 @@ test_that("Advanced JAGS_fit features work correctly", { }) -# ============================================================================== +# ============================================================================ # # SAVE MODEL REGISTRY -# ============================================================================== +# ============================================================================ # # Convert the model registry list to a data frame for easy inspection and querying test_that("Model registry is created and saved", { diff --git a/tests/testthat/test-JAGS-ensemble-tables.R b/tests/testthat/test-JAGS-ensemble-tables.R new file mode 100644 index 0000000..6645330 --- /dev/null +++ b/tests/testthat/test-JAGS-ensemble-tables.R @@ -0,0 +1,342 @@ +context("Summary tables functions") + +REFERENCE_DIR <- testthat::test_path("..", "results", "JAGS-ensemble-tables") +source(testthat::test_path("common-functions.R")) + +# ============================================================================ # +# SECTION 1: Test Empty Tables +# ============================================================================ # +test_that("Empty summary tables work correctly", { + + ensemble_estimates_empty <- ensemble_estimates_empty_table() + ensemble_inference_empty <- ensemble_inference_empty_table() + ensemble_diagnostics_empty <- ensemble_diagnostics_empty_table() + + expect_equivalent(nrow(ensemble_estimates_empty), 0) + expect_equivalent(nrow(ensemble_inference_empty), 0) + expect_equivalent(nrow(ensemble_diagnostics_empty), 0) + + # Test that empty tables have correct structure + expect_s3_class(ensemble_estimates_empty, "BayesTools_table") + expect_s3_class(ensemble_inference_empty, "BayesTools_table") + expect_s3_class(ensemble_diagnostics_empty, "BayesTools_table") + + test_reference_table(ensemble_estimates_empty, "empty_ensemble_estimates.txt", "Empty ensemble_estimates table mismatch") + test_reference_table(ensemble_inference_empty, "empty_ensemble_inference.txt", "Empty ensemble_inference table mismatch") + test_reference_table(ensemble_diagnostics_empty, "empty_ensemble_diagnostics.txt", "Empty ensemble_diagnostics table mismatch") +}) + +# ============================================================================ # +# SECTION 2: Test Advanced Features (Transformations, Formula Handling, etc.) +# ============================================================================ # +test_that("Summary table advanced features work correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # 1. Simple models (m, omega) + # -------------------------------------------------------------- # + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) + marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)), + list(fit = fit_summary2, marglik = marglik_summary2, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary2)) + ) + models <- models_inference(models) + + # Create inference and mixed posteriors + inference <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = c(F,F,F), "omega" = c(T,F,F)), conditional = FALSE) + mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = c(F,F,F), "omega" = c(T,F,F)), seed = 1) + + # Test tables + estimates_table <- ensemble_estimates_table(mixed_posteriors, parameters = c("m", "omega"), probs = c(.025, 0.95)) + inference_table <- ensemble_inference_table(inference, names(inference)) + summary_table <- ensemble_summary_table(models, c("m", "omega")) + diagnostics_table <- ensemble_diagnostics_table(models, c("m", "omega")) + + # Check structure + expect_s3_class(estimates_table, "BayesTools_table") + expect_s3_class(inference_table, "BayesTools_table") + expect_s3_class(summary_table, "BayesTools_table") + expect_s3_class(diagnostics_table, "BayesTools_table") + + # Check content with reference files + test_reference_table(estimates_table, "simple_ensemble_estimates.txt") + test_reference_table(inference_table, "simple_ensemble_inference.txt") + test_reference_table(summary_table, "simple_ensemble_summary.txt") + test_reference_table(diagnostics_table, "simple_ensemble_diagnostics.txt") + + # Test remove_column on diagnostics table + diagnostics_table.trimmed <- remove_column(diagnostics_table, 2) + diagnostics_table.trimmed <- remove_column(diagnostics_table.trimmed, 2) + test_reference_table(diagnostics_table.trimmed, "simple_ensemble_diagnostics_trimmed.txt") + + # Test that trimmed diagnostics table matches empty table structure + ensemble_diagnostics_empty <- ensemble_diagnostics_empty_table() + expect_equal(colnames(ensemble_diagnostics_empty), colnames(diagnostics_table.trimmed)) + expect_equal(capture_output_lines(ensemble_diagnostics_empty, width = 150)[1], capture_output_lines(diagnostics_table.trimmed, width = 150)[1]) + + # Test interpret + interpretation <- interpret(inference, mixed_posteriors, list( + list( + inference = "m", + samples = "m", + inference_name = "effect", + inference_BF_name = "BF_10", + samples_name = "y", + samples_units = NULL + ) + ), "Test") + + test_reference_text(interpretation, "simple_interpretation.txt") + + # Test interpret 2 (modified inference) + inference[["m"]][["BF"]] <- 1/5 + interpretation2 <- interpret(inference, mixed_posteriors, list( + list( + inference = "m", + samples = "m", + inference_name = "effect", + inference_BF_name = "BF_10", + samples_name = "y", + samples_units = "mm", + samples_conditional = TRUE + ), + list( + inference = "omega", + inference_name = "bias", + inference_BF_name = "BF_pb" + ) + ), "Test2") + + test_reference_text(interpretation2, "simple_interpretation2.txt") + + + # 2. Complex models (Formula) + # -------------------------------------------------------------- # + fit_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple.RDS")) + marglik_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple_marglik.RDS")) + + fit_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment.RDS")) + marglik_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment_marglik.RDS")) + + fit_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS")) + marglik_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal_marglik.RDS")) + + models_complex <- list( + list(fit = fit_formula_simple, marglik = marglik_formula_simple, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_simple)), + list(fit = fit_formula_treatment, marglik = marglik_formula_treatment, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_treatment)), + list(fit = fit_formula_orthonormal, marglik = marglik_formula_orthonormal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_orthonormal)) + ) + models_complex <- models_inference(models_complex) + + parameters_complex <- c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o") + is_null_list_complex <- list( + "mu_x_cont1" = c(FALSE, FALSE, FALSE), + "mu_x_fac2t" = c(TRUE, FALSE, TRUE), + "mu_x_fac3o" = c(TRUE, TRUE, FALSE) + ) + + inference_complex <- ensemble_inference( + model_list = models_complex, + parameters = parameters_complex, + is_null_list = is_null_list_complex, + conditional = FALSE + ) + + mixed_posteriors_complex <- mix_posteriors( + model_list = models_complex, + parameters = parameters_complex, + is_null_list = is_null_list_complex, + seed = 1, n_samples = 10000 + ) + + # Tables + estimates_table_complex <- ensemble_estimates_table(mixed_posteriors_complex, parameters = parameters_complex, probs = c(.025, 0.95)) + inference_table_complex <- ensemble_inference_table(inference_complex, names(inference_complex)) + summary_table_complex <- ensemble_summary_table(models_complex, parameters_complex) + diagnostics_table_complex <- ensemble_diagnostics_table(models_complex, parameters_complex) + + test_reference_table(estimates_table_complex, "complex_ensemble_estimates.txt") + test_reference_table(inference_table_complex, "complex_ensemble_inference.txt") + test_reference_table(summary_table_complex, "complex_ensemble_summary.txt") + test_reference_table(diagnostics_table_complex, "complex_ensemble_diagnostics.txt") + + # 3. Simple Spike vs Normal (Model Averaging) + # -------------------------------------------------------------- # + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + models_simple_ma <- list( + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_spike)), + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)) + ) + models_simple_ma <- models_inference(models_simple_ma) + + inference_simple_ma <- ensemble_inference( + model_list = models_simple_ma, + parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), # m is spike in model 1 (null), s is never null + conditional = FALSE + ) + + mixed_posteriors_simple_ma <- mix_posteriors( + model_list = models_simple_ma, + parameters = c("m", "s"), + is_null_list = list("m" = 1, "s" = 0), + seed = 1 + ) + + estimates_simple_ma <- ensemble_estimates_table(mixed_posteriors_simple_ma, parameters = c("m", "s")) + inference_simple_ma_table <- ensemble_inference_table(inference_simple_ma, names(inference_simple_ma)) + + test_reference_table(estimates_simple_ma, "simple_ma_estimates.txt") + test_reference_table(inference_simple_ma_table, "simple_ma_inference.txt") + + + # 4. Fixed Weightfunctions + # -------------------------------------------------------------- # + # Re-using summary models 0-2 and adding a fixed weightfunction model + fit_summary3 <- readRDS(file.path(temp_fits_dir, "fit_summary3.RDS")) + marglik_summary3 <- readRDS(file.path(temp_fits_dir, "fit_summary3_marglik.RDS")) + + models_fixed_wf <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)), + list(fit = fit_summary2, marglik = marglik_summary2, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary2)), + list(fit = fit_summary3, marglik = marglik_summary3, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary3)) + ) + models_fixed_wf <- models_inference(models_fixed_wf) + + inference_fixed_wf <- ensemble_inference( + model_list = models_fixed_wf, + parameters = c("m", "omega"), + is_null_list = list("m" = 0, "omega" = 1), + conditional = FALSE + ) + + mixed_posteriors_fixed_wf <- mix_posteriors( + model_list = models_fixed_wf, + parameters = c("m", "omega"), + is_null_list = list("m" = 0, "omega" = 1), + seed = 1 + ) + + estimates_fixed_wf <- ensemble_estimates_table(mixed_posteriors_fixed_wf, parameters = c("m", "omega")) + inference_fixed_wf_table <- ensemble_inference_table(inference_fixed_wf, names(inference_fixed_wf)) + + test_reference_table(estimates_fixed_wf, "fixed_wf_estimates.txt") + test_reference_table(inference_fixed_wf_table, "fixed_wf_inference.txt") + + # 5. Interactions + # -------------------------------------------------------------- # + fit_formula_interaction_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS")) + marglik_formula_interaction_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_marglik.RDS")) + + fit_formula_interaction_mix_main <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_main.RDS")) + marglik_formula_interaction_mix_main <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_main_marglik.RDS")) + + models_interaction <- list( + list(fit = fit_formula_interaction_mix_main, marglik = marglik_formula_interaction_mix_main, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_interaction_mix_main)), + list(fit = fit_formula_interaction_mix, marglik = marglik_formula_interaction_mix, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_interaction_mix)) + ) + models_interaction <- models_inference(models_interaction) + + parameters_int <- c("mu_x_cont1", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o") + is_null_list_int <- list( + "mu_x_cont1" = c(FALSE, FALSE), + "mu_x_fac3o" = c(FALSE, FALSE), + "mu_x_cont1:x_fac3o" = c(TRUE, FALSE) + ) + + inference_interaction <- ensemble_inference( + model_list = models_interaction, + parameters = parameters_int, + is_null_list = is_null_list_int, + conditional = FALSE + ) + + mixed_posteriors_interaction <- mix_posteriors( + model_list = models_interaction, + parameters = parameters_int, + is_null_list = is_null_list_int, + seed = 1 + ) + + estimates_interaction <- ensemble_estimates_table(mixed_posteriors_interaction, parameters = parameters_int) + inference_interaction_table <- ensemble_inference_table(inference_interaction, names(inference_interaction)) + summary_interaction_table <- ensemble_summary_table(models_interaction, parameters_int) + + test_reference_table(estimates_interaction, "interaction_ensemble_estimates.txt") + test_reference_table(inference_interaction_table, "interaction_ensemble_inference.txt") + test_reference_table(summary_interaction_table, "interaction_ensemble_summary.txt") + + # 6. Spike Factors + # -------------------------------------------------------------- # + fit_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_null.RDS")) + marglik_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_null_marglik.RDS")) + + fit_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_alt.RDS")) + marglik_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_alt_marglik.RDS")) + + models_spike_factors <- list( + list(fit = fit_spike_factors_null, marglik = marglik_spike_factors_null, prior_weights = 1, fit_summary = runjags_estimates_table(fit_spike_factors_null)), + list(fit = fit_spike_factors_alt, marglik = marglik_spike_factors_alt, prior_weights = 1, fit_summary = runjags_estimates_table(fit_spike_factors_alt)) + ) + models_spike_factors <- models_inference(models_spike_factors) + + inference_spike_factors <- ensemble_inference( + model_list = models_spike_factors, + parameters = c("mu_x_fac3md"), + is_null_list = list("mu_x_fac3md" = c(TRUE, FALSE)), + conditional = FALSE + ) + + mixed_posteriors_spike_factors <- mix_posteriors( + model_list = models_spike_factors, + parameters = c("mu_x_fac3md"), + is_null_list = list("mu_x_fac3md" = c(TRUE, FALSE)), + seed = 1 + ) + + estimates_spike_factors <- ensemble_estimates_table(mixed_posteriors_spike_factors, parameters = c("mu_x_fac3md")) + inference_spike_factors_table <- ensemble_inference_table(inference_spike_factors, names(inference_spike_factors)) + + test_reference_table(estimates_spike_factors, "spike_factors_estimates.txt") + test_reference_table(inference_spike_factors_table, "spike_factors_inference.txt") + +}) + + +test_that("Simplified interpret2 function", { + + set.seed(1) + information <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF10", + inference_BF = 3.5, + estimate_name = "mu", + estimate_samples = rnorm(1000, 0.3, 0.15), + estimate_units = "kg", + estimate_conditional = FALSE + ) + ) + + expect_equal( + interpret2(information, "RoBMA"), + "RoBMA found moderate evidence in favor of the Effect, BF10 = 3.50, with mean model-averaged estimate mu = 0.298 kg, 95% CI [-0.020, 0.601]." + ) + +}) diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 3e863c9..f4476a9 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -1,72 +1,26 @@ context("Summary tables functions") -# ============================================================================== -# CONFIGURATION: Set to TRUE to regenerate reference files, FALSE to run tests -# ============================================================================== -GENERATE_REFERENCE_FILES <- FALSE - -# Get the directory where prefitted models are stored -temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") -if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { - temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") -} - -# Skip tests on CRAN as they require pre-fitted models -skip_on_cran() - -# ============================================================================== -# HELPER FUNCTIONS -# ============================================================================== - -# Process reference file: save if GENERATE_REFERENCE_FILES=TRUE, test otherwise -test_reference <- function(table, filename, info_msg = NULL, - print_dir = testthat::test_path("..", "results", "JAGS-summary-tables")) { - if (GENERATE_REFERENCE_FILES) { - # Save mode - if (!dir.exists(print_dir)) { - dir.create(print_dir, recursive = TRUE) - } - writeLines(capture_output_lines(table, print = TRUE, width = 150), - file.path(print_dir, filename)) - } else { - # Test mode - ref_file <- file.path(print_dir, filename) - if (file.exists(ref_file)) { - expected_output <- readLines(ref_file, warn = FALSE) - actual_output <- capture_output_lines(table, print = TRUE, width = 150) - expect_equal(actual_output, expected_output, info = info_msg) - } else { - skip(paste("Reference file", filename, "not found.")) - } - } -} +REFERENCE_DIR <- testthat::test_path("..", "results", "JAGS-summary-tables") +source(testthat::test_path("common-functions.R")) -# ============================================================================== +# ============================================================================ # # SECTION 1: Test Empty Tables -# ============================================================================== +# ============================================================================ # test_that("Empty summary tables work correctly", { runjags_summary_empty <- runjags_estimates_empty_table() - ensemble_estimates_empty <- ensemble_estimates_empty_table() - ensemble_inference_empty <- ensemble_inference_empty_table() expect_equivalent(nrow(runjags_summary_empty), 0) - expect_equivalent(nrow(ensemble_estimates_empty), 0) - expect_equivalent(nrow(ensemble_inference_empty), 0) # Test that empty tables have correct structure expect_s3_class(runjags_summary_empty, "BayesTools_table") - expect_s3_class(ensemble_estimates_empty, "BayesTools_table") - expect_s3_class(ensemble_inference_empty, "BayesTools_table") - test_reference(runjags_summary_empty, "empty_runjags_estimates.txt", "Empty runjags_estimates table mismatch") - test_reference(ensemble_estimates_empty, "empty_ensemble_estimates.txt", "Empty ensemble_estimates table mismatch") - test_reference(ensemble_inference_empty, "empty_ensemble_inference.txt", "Empty ensemble_inference table mismatch") + test_reference_table(runjags_summary_empty, "empty_runjags_estimates.txt", "Empty runjags_estimates table mismatch") }) -# ============================================================================== +# ============================================================================ # # SECTION 2: Test Advanced Features (Transformations, Formula Handling, etc.) -# ============================================================================== +# ============================================================================ # test_that("Summary table advanced features work correctly", { skip_if_not_installed("rjags") @@ -146,24 +100,24 @@ test_that("Summary table advanced features work correctly", { # Test that remove_inclusion reduces the number of rows expect_true(nrow(runjags_summary_remove_inclusion) <= nrow(runjags_summary_spike)) - test_reference(runjags_summary_transform, "advanced_transform.txt", "Transform table mismatch") - test_reference(runjags_summary_prefix_true, "advanced_formula_prefix_true.txt", "Formula prefix true table mismatch") - test_reference(runjags_summary_prefix_false, "advanced_formula_prefix_false.txt", "Formula prefix false table mismatch") - test_reference(runjags_summary_conditional, "advanced_conditional.txt", "Conditional table mismatch") - test_reference(runjags_summary_unconditional, "advanced_unconditional.txt", "Unconditional table mismatch") - test_reference(runjags_summary_factor, "advanced_factor_treatment.txt", "Factor treatment table mismatch") - test_reference(runjags_summary_spike, "advanced_spike_slab_estimates.txt", "Spike slab estimates table mismatch") - test_reference(runjags_inference_spike, "advanced_spike_slab_inference.txt", "Spike slab inference table mismatch") - test_reference(runjags_summary_orthonormal, "advanced_orthonormal_transform.txt", "Orthonormal transform table mismatch") - test_reference(runjags_summary_custom_transform, "advanced_custom_transform.txt", "Custom transform table mismatch") - test_reference(runjags_summary_remove_inclusion, "advanced_remove_inclusion.txt", "Remove inclusion table mismatch") - test_reference(runjags_summary_custom_probs, "advanced_custom_probs.txt", "Custom probs table mismatch") + test_reference_table(runjags_summary_transform, "advanced_transform.txt", "Transform table mismatch") + test_reference_table(runjags_summary_prefix_true, "advanced_formula_prefix_true.txt", "Formula prefix true table mismatch") + test_reference_table(runjags_summary_prefix_false, "advanced_formula_prefix_false.txt", "Formula prefix false table mismatch") + test_reference_table(runjags_summary_conditional, "advanced_conditional.txt", "Conditional table mismatch") + test_reference_table(runjags_summary_unconditional, "advanced_unconditional.txt", "Unconditional table mismatch") + test_reference_table(runjags_summary_factor, "advanced_factor_treatment.txt", "Factor treatment table mismatch") + test_reference_table(runjags_summary_spike, "advanced_spike_slab_estimates.txt", "Spike slab estimates table mismatch") + test_reference_table(runjags_inference_spike, "advanced_spike_slab_inference.txt", "Spike slab inference table mismatch") + test_reference_table(runjags_summary_orthonormal, "advanced_orthonormal_transform.txt", "Orthonormal transform table mismatch") + test_reference_table(runjags_summary_custom_transform, "advanced_custom_transform.txt", "Custom transform table mismatch") + test_reference_table(runjags_summary_remove_inclusion, "advanced_remove_inclusion.txt", "Remove inclusion table mismatch") + test_reference_table(runjags_summary_custom_probs, "advanced_custom_probs.txt", "Custom probs table mismatch") }) -# ============================================================================== +# ============================================================================ # # SECTION 3: Test Summary Tables for All Saved Models -# ============================================================================== +# ============================================================================ # test_that("Summary tables for all saved models", { skip_if_not_installed("rjags") @@ -198,13 +152,13 @@ test_that("Summary tables for all saved models", { ) model_list <- models_inference(model_list) model_summary <- model_summary_table(model_list[[1]]) - test_reference(model_summary, paste0(model_name, "_model_summary.txt"), + test_reference_table(model_summary, paste0(model_name, "_model_summary.txt"), paste0("Model summary mismatch for ", model_name)) } # Process runjags estimates table runjags_summary <- runjags_estimates_table(fit) - test_reference(runjags_summary, paste0(model_name, "_runjags_estimates.txt"), + test_reference_table(runjags_summary, paste0(model_name, "_runjags_estimates.txt"), paste0("Runjags estimates mismatch for ", model_name)) } From e70b5d1a2d3a0dfe228310bb792c0e5c89e18bf3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= <38475991+FBartos@users.noreply.github.com> Date: Wed, 10 Dec 2025 15:10:41 +0100 Subject: [PATCH 06/38] Refactor plot tests (#55) * add more plots and tables * add `as_mixed_posteriors` tests for plots * Update test-JAGS-ensemble-tables.R * rename plot file * update test results * clean up formula and other files * clean marginal tests * update tests() * title naming --- .github/instructions/tests.instructions.md | 26 +- .../as_mixed_posteriors_complex_estimates.txt | 12 + .../as_mixed_posteriors_simple_estimates.txt | 7 + .../spike_factors_estimates.txt | 6 +- .../spike_factors_inference.txt | 2 +- .../marginal_estimates_table_model_avg.txt | 37 + .../marginal_estimates_table_spike_slab.txt | 37 + .../fit_complex_mixed_runjags_estimates.txt | 19 + .../fit_marginal_0_model_summary.txt | 6 + .../fit_marginal_0_runjags_estimates.txt | 4 + .../fit_marginal_1_model_summary.txt | 8 + .../fit_marginal_1_runjags_estimates.txt | 9 + .../fit_marginal_ss_runjags_estimates.txt | 13 + .../fit_missing_model_summary.txt | 6 + .../fit_missing_runjags_estimates.txt | 2 + .../fit_orthonormal_0_model_summary.txt | 6 + .../fit_orthonormal_0_runjags_estimates.txt | 3 + .../fit_orthonormal_1_model_summary.txt | 6 + .../fit_orthonormal_1_runjags_estimates.txt | 5 + .../fit_peese_model_summary.txt | 6 + .../fit_peese_runjags_estimates.txt | 2 + .../fit_pet_model_summary.txt | 6 + .../fit_pet_runjags_estimates.txt | 2 + ...simple_formula_mixed_runjags_estimates.txt | 7 + .../fit_wf_missing_model_summary.txt | 6 + .../fit_wf_missing_runjags_estimates.txt | 2 + .../fit_wf_onesided_model_summary.txt | 6 + .../fit_wf_onesided_runjags_estimates.txt | 3 + .../fit_wf_twosided_model_summary.txt | 6 + .../fit_wf_twosided_runjags_estimates.txt | 3 + .../diagnostics-ggplot-autocorrelation-1.svg | 149 + ...diagnostics-ggplot-autocorrelation-2-1.svg | 150 + ...diagnostics-ggplot-autocorrelation-2-2.svg | 150 + ...diagnostics-ggplot-autocorrelation-2-3.svg | 150 + ...diagnostics-ggplot-autocorrelation-3-1.svg | 126 + .../diagnostics-ggplot-density-1.svg | 93 + .../diagnostics-ggplot-density-2-1.svg | 90 + .../diagnostics-ggplot-density-2-2.svg | 94 + .../diagnostics-ggplot-density-2-3.svg | 94 + .../diagnostics-ggplot-density-3-1.svg | 96 + .../diagnostics-ggplot-trace-1.svg | 93 + .../diagnostics-ggplot-trace-2-1.svg | 90 + .../diagnostics-ggplot-trace-2-2.svg | 90 + .../diagnostics-ggplot-trace-2-3.svg | 90 + .../diagnostics-ggplot-trace-3-1.svg | 88 + .../diagnostics-plot-autocorrelation-1.svg | 123 + .../diagnostics-plot-autocorrelation-2.svg | 123 + .../diagnostics-plot-autocorrelation-3.svg | 122 + .../diagnostics-plot-autocorrelation-4.svg | 244 + .../diagnostics-plot-autocorrelation-5.svg | 357 + .../diagnostics-plot-autocorrelation-6.svg | 98 + .../diagnostics-plot-autocorrelation-7.svg | 107 + .../diagnostics-plot-autocorrelation-8.svg | 135 + .../diagnostics-plot-density-1.svg | 59 + .../diagnostics-plot-density-2.svg | 61 + .../diagnostics-plot-density-3.svg | 60 + .../diagnostics-plot-density-4.svg | 120 + .../diagnostics-plot-density-5.svg | 167 + .../diagnostics-plot-density-6.svg | 60 + .../diagnostics-plot-density-7.svg | 75 + .../diagnostics-plot-density-8.svg | 75 + .../diagnostics-plot-mixture-1.svg | 94 + .../diagnostics-plot-mixture-2.svg | 126 + .../diagnostics-plot-mixture-3.svg | 94 + .../diagnostics-plot-mixture-4.svg | 87 + .../diagnostics-plot-mixture-5.svg | 119 + .../diagnostics-plot-mixture-6.svg | 85 + .../diagnostics-plot-spike-and-slab-1.svg | 65 + .../diagnostics-plot-spike-and-slab-2.svg | 97 + .../diagnostics-plot-spike-and-slab-3.svg | 63 + .../diagnostics-plot-trace-1.svg | 57 + .../diagnostics-plot-trace-2.svg | 63 + .../diagnostics-plot-trace-3.svg | 64 + .../diagnostics-plot-trace-4.svg | 122 + .../diagnostics-plot-trace-5.svg | 167 + .../diagnostics-plot-trace-6.svg | 60 + .../diagnostics-plot-trace-7.svg | 73 + .../diagnostics-plot-trace-8.svg | 75 + .../diagnostics3-ggplot-density-1-1.svg | 98 + .../diagnostics3-ggplot-density-1-2.svg | 90 + .../diagnostics3-ggplot-density-2-1.svg | 82 + .../diagnostics3-ggplot-density-2-2.svg | 94 + .../diagnostics3-ggplot-density-2-3.svg | 82 + .../diagnostics3-plot-autocorrelation-1.svg | 135 + .../diagnostics3-plot-autocorrelation-2.svg | 357 + .../diagnostics3-plot-density-1.svg | 75 + .../diagnostics3-plot-density-2.svg | 112 + .../diagnostics3-plot-density-3.svg | 151 + .../diagnostics3-plot-trace-1.svg | 75 + .../diagnostics3-plot-trace-2.svg | 165 + ...diagnostics4-ggplot-density-fit-simple.svg | 64 + .../diagnostics-ggplot-autocorrelation-1.svg | 211 - ...diagnostics-ggplot-autocorrelation-2-1.svg | 212 - ...diagnostics-ggplot-autocorrelation-2-2.svg | 212 - ...diagnostics-ggplot-autocorrelation-2-3.svg | 212 - ...diagnostics-ggplot-autocorrelation-3-1.svg | 219 - ...diagnostics-ggplot-autocorrelation-3-2.svg | 219 - .../diagnostics-ggplot-density-1.svg | 83 - .../diagnostics-ggplot-density-2-1.svg | 88 - .../diagnostics-ggplot-density-2-2.svg | 84 - .../diagnostics-ggplot-density-2-3.svg | 92 - .../diagnostics-ggplot-density-3-1.svg | 91 - .../diagnostics-ggplot-density-3-2.svg | 91 - .../diagnostics-ggplot-trace-1.svg | 83 - .../diagnostics-ggplot-trace-2-1.svg | 84 - .../diagnostics-ggplot-trace-2-2.svg | 80 - .../diagnostics-ggplot-trace-2-3.svg | 88 - .../diagnostics-ggplot-trace-3-1.svg | 91 - .../diagnostics-ggplot-trace-3-2.svg | 91 - .../diagnostics-plot-autocorrelation-1.svg | 185 - .../diagnostics-plot-autocorrelation-2.svg | 185 - .../diagnostics-plot-autocorrelation-3.svg | 184 - .../diagnostics-plot-autocorrelation-4.svg | 368 - .../diagnostics-plot-autocorrelation-5.svg | 543 - .../diagnostics-plot-autocorrelation-6.svg | 186 - .../diagnostics-plot-autocorrelation-7.svg | 382 - .../diagnostics-plot-autocorrelation-8.svg | 368 - .../diagnostics-plot-density-1.svg | 65 - .../diagnostics-plot-density-2.svg | 57 - .../diagnostics-plot-density-3.svg | 64 - .../diagnostics-plot-density-4.svg | 128 - .../diagnostics-plot-density-5.svg | 161 - .../diagnostics-plot-density-6.svg | 58 - .../diagnostics-plot-density-7.svg | 130 - .../diagnostics-plot-density-8.svg | 114 - .../diagnostics-plot-mixture-1.svg | 80 - .../diagnostics-plot-mixture-2.svg | 206 - .../diagnostics-plot-mixture-3.svg | 80 - .../diagnostics-plot-mixture-4.svg | 92 - .../diagnostics-plot-mixture-5.svg | 212 - .../diagnostics-plot-mixture-6.svg | 88 - .../diagnostics-plot-spike-and-slab-1.svg | 64 - .../diagnostics-plot-spike-and-slab-2.svg | 190 - .../diagnostics-plot-spike-and-slab-3.svg | 92 - .../diagnostics-plot-trace-1.svg | 63 - .../diagnostics-plot-trace-2.svg | 59 - .../diagnostics-plot-trace-3.svg | 60 - .../diagnostics-plot-trace-4.svg | 116 - .../diagnostics-plot-trace-5.svg | 161 - .../diagnostics-plot-trace-6.svg | 60 - .../diagnostics-plot-trace-7.svg | 134 - .../diagnostics-plot-trace-8.svg | 114 - .../diagnostics3-ggplot-density-1-1.svg | 88 - .../diagnostics3-ggplot-density-1-2.svg | 88 - .../diagnostics3-ggplot-density-2-1.svg | 84 - .../diagnostics3-ggplot-density-2-2.svg | 84 - .../diagnostics3-ggplot-density-2-3.svg | 84 - .../diagnostics3-plot-autocorrelation-1.svg | 368 - .../diagnostics3-plot-autocorrelation-2.svg | 543 - .../diagnostics3-plot-density-1.svg | 112 - .../diagnostics3-plot-density-2.svg | 114 - .../diagnostics3-plot-density-3.svg | 163 - .../diagnostics3-plot-trace-1.svg | 112 - .../diagnostics3-plot-trace-2.svg | 163 - .../model-averaging-plot-posterior-o-1.svg | 0 .../model-averaging-plot-posterior-o-2.svg | 0 .../model-averaging-plot-posterior-o-3.svg | 0 .../model-averaging-plot-posterior-o-4.svg | 0 ...el-averaging-plot-posterior-petpeese-1.svg | 4 +- ...el-averaging-plot-posterior-petpeese-2.svg | 4 +- ...el-averaging-plot-posterior-petpeese-5.svg | 64 + ...el-averaging-plot-posterior-petpeese-6.svg | 60 + ...el-averaging-plot-posterior-petpeese-7.svg | 0 ...el-averaging-plot-posterior-petpeese-8.svg | 64 + ...el-averaging-plot-posterior-petpeese-9.svg | 8 +- ...odel-averaging-plot-posterior-simple-1.svg | 75 + ...odel-averaging-plot-posterior-simple-2.svg | 100 + ...odel-averaging-plot-posterior-simple-3.svg | 58 + ...odel-averaging-plot-posterior-simple-4.svg | 89 + ...odel-averaging-plot-posterior-simple-5.svg | 58 + ...odel-averaging-plot-posterior-simple-6.svg | 74 + ...odel-averaging-plot-posterior-simple-7.svg | 0 ...odel-averaging-plot-posterior-simple-8.svg | 54 + .../model-averaging-plot-posterior-wf-1.svg | 2 +- .../model-averaging-plot-posterior-wf-10.svg | 4 +- .../model-averaging-plot-posterior-wf-2.svg | 2 +- .../model-averaging-plot-posterior-wf-3.svg | 2 +- .../model-averaging-plot-posterior-wf-4.svg | 2 +- .../model-averaging-plot-posterior-wf-6.svg | 2 +- .../model-averaging-plot-posterior-wf-7.svg | 0 .../model-averaging-plot-posterior-wf-8.svg | 2 +- .../model-averaging-plot-posterior-wf-9.svg | 0 ...del-averaging-plot-prior-independent-1.svg | 0 ...del-averaging-plot-prior-independent-2.svg | 0 ...del-averaging-plot-prior-independent-3.svg | 0 ...del-averaging-plot-prior-independent-4.svg | 0 .../model-averaging-plot-prior-meandif-1.svg | 0 .../model-averaging-plot-prior-meandif-2.svg | 0 .../model-averaging-plot-prior-meandif-3.svg | 0 .../model-averaging-plot-prior-meandif-4.svg | 0 .../model-averaging-plot-prior-meandif-5.svg | 0 .../model-averaging-plot-prior-meandif-6.svg | 0 ...del-averaging-plot-prior-orthonormal-1.svg | 0 ...del-averaging-plot-prior-orthonormal-2.svg | 0 ...del-averaging-plot-prior-orthonormal-3.svg | 0 ...del-averaging-plot-prior-orthonormal-4.svg | 0 ...del-averaging-plot-prior-orthonormal-5.svg | 0 ...del-averaging-plot-prior-orthonormal-6.svg | 0 .../model-averaging-plot-prior-petpeese-1.svg | 62 + ...model-averaging-plot-prior-petpeese-10.svg | 0 ...model-averaging-plot-prior-petpeese-11.svg | 8 +- ...model-averaging-plot-prior-petpeese-12.svg | 0 .../model-averaging-plot-prior-petpeese-2.svg | 4 +- .../model-averaging-plot-prior-petpeese-3.svg | 0 .../model-averaging-plot-prior-petpeese-4.svg | 0 .../model-averaging-plot-prior-petpeese-5.svg | 60 + .../model-averaging-plot-prior-petpeese-6.svg | 0 .../model-averaging-plot-prior-petpeese-7.svg | 60 + .../model-averaging-plot-prior-petpeese-8.svg | 0 .../model-averaging-plot-prior-petpeese-9.svg | 22 +- .../model-averaging-plot-prior-simple-1.svg | 0 .../model-averaging-plot-prior-simple-10.svg | 0 .../model-averaging-plot-prior-simple-11.svg | 0 .../model-averaging-plot-prior-simple-12.svg | 0 .../model-averaging-plot-prior-simple-13.svg | 0 .../model-averaging-plot-prior-simple-2.svg | 0 .../model-averaging-plot-prior-simple-3.svg | 0 .../model-averaging-plot-prior-simple-4.svg | 0 .../model-averaging-plot-prior-simple-5.svg | 0 .../model-averaging-plot-prior-simple-6.svg | 0 .../model-averaging-plot-prior-simple-7.svg | 0 .../model-averaging-plot-prior-simple-8.svg | 0 .../model-averaging-plot-prior-simple-9.svg | 0 ...model-averaging-plot-prior-treatment-1.svg | 0 ...model-averaging-plot-prior-treatment-2.svg | 0 ...model-averaging-plot-prior-treatment-3.svg | 0 ...model-averaging-plot-prior-treatment-4.svg | 0 ...model-averaging-plot-prior-treatment-5.svg | 0 ...model-averaging-plot-prior-treatment-6.svg | 0 .../model-averaging-plot-prior-wf-1.svg | 4 +- .../model-averaging-plot-prior-wf-10.svg | 0 .../model-averaging-plot-prior-wf-11.svg | 8 +- .../model-averaging-plot-prior-wf-12.svg | 0 .../model-averaging-plot-prior-wf-2.svg | 4 +- .../model-averaging-plot-prior-wf-3.svg | 0 .../model-averaging-plot-prior-wf-4.svg | 0 .../model-averaging-plot-prior-wf-5.svg | 4 +- .../model-averaging-plot-prior-wf-6.svg | 0 .../model-averaging-plot-prior-wf-7.svg | 8 +- .../model-averaging-plot-prior-wf-8.svg | 0 .../model-averaging-plot-prior-wf-9.svg | 4 +- ...l-averaging-plot-ss-posterior-bias-pet.svg | 76 + ...raging-plot-ss-posterior-intercept-con.svg | 54 + ...-averaging-plot-ss-posterior-intercept.svg | 76 + ...averaging-plot-ss-posterior-omega-con.svg} | 764 +- ...el-averaging-plot-ss-posterior-pet-con.svg | 310 + ...odel-averaging-plot-ss-posterior-sigma.svg | 62 + ...g-plot-ss-posterior-weightfunction-con.svg | 8 +- ...aging-plot-ss-posterior-weightfunction.svg | 8 +- ...veraging-plot-ss-posterior-x-cont1-con.svg | 58 + ...el-averaging-plot-ss-posterior-x-cont1.svg | 4 +- ...veraging-plot-ss-posterior-x-fac2t-con.svg | 55 + ...el-averaging-plot-ss-posterior-x-fac2t.svg | 77 + ...veraging-plot-ss-posterior-x-fac3t-con.svg | 62 + ...el-averaging-plot-ss-posterior-x-fac3t.svg | 80 + ...ing-simple-plot-ss-posterior-intercept.svg | 54 + ...eraging-simple-plot-ss-posterior-sigma.svg | 62 + ...aging-simple-plot-ss-posterior-x-cont1.svg | 58 + ...aging-simple-plot-ss-posterior-x-fac2t.svg | 55 + ...aging-simple-plot-ss-posterior-x-fac3t.svg | 62 + .../_snaps/JAGS-fit/jags-fit-formula-1.svg | 284 - .../_snaps/JAGS-fit/jags-fit-formula-2.svg | 396 - .../JAGS-fit/jags-fit-formula-mixture-1.svg | 297 - .../JAGS-fit/jags-fit-formula-mixture-2.svg | 362 - .../jags-fit-formula-spike-and-slab-1.svg | 196 - .../jags-fit-formula-spike-and-slab-2.svg | 378 - .../_snaps/JAGS-fit/jags-fit-posterior.svg | 246 - .../_snaps/JAGS-fit/jags-model-prior-1.svg | 104 - .../_snaps/JAGS-fit/jags-model-prior-10.svg | 98 - .../_snaps/JAGS-fit/jags-model-prior-11.svg | 62 - .../_snaps/JAGS-fit/jags-model-prior-12.svg | 101 - .../_snaps/JAGS-fit/jags-model-prior-13.svg | 102 - .../_snaps/JAGS-fit/jags-model-prior-14.svg | 56 - .../_snaps/JAGS-fit/jags-model-prior-2.svg | 102 - .../_snaps/JAGS-fit/jags-model-prior-3.svg | 116 - .../_snaps/JAGS-fit/jags-model-prior-4.svg | 90 - .../_snaps/JAGS-fit/jags-model-prior-5.svg | 109 - .../_snaps/JAGS-fit/jags-model-prior-6.svg | 121 - .../_snaps/JAGS-fit/jags-model-prior-7.svg | 95 - .../_snaps/JAGS-fit/jags-model-prior-8.svg | 129 - .../_snaps/JAGS-fit/jags-model-prior-9.svg | 105 - .../_snaps/JAGS-fit/jags-model-prior-e1.svg | 94 - .../_snaps/JAGS-fit/jags-model-prior-e2.svg | 101 - .../_snaps/JAGS-fit/jags-model-prior-e3.svg | 123 - .../JAGS-fit/jags-model-prior-factor-1.svg | 10152 --------------- .../JAGS-fit/jags-model-prior-factor-10.svg | 124 - .../JAGS-fit/jags-model-prior-factor-2.svg | 81 - .../JAGS-fit/jags-model-prior-factor-3.svg | 10158 --------------- .../JAGS-fit/jags-model-prior-factor-4.svg | 80 - .../JAGS-fit/jags-model-prior-factor-5.svg | 288 - .../JAGS-fit/jags-model-prior-factor-6.svg | 187 - .../JAGS-fit/jags-model-prior-factor-7.svg | 63 - .../JAGS-fit/jags-model-prior-factor-8.svg | 170 - .../JAGS-fit/jags-model-prior-factor-9.svg | 124 - .../JAGS-fit/jags-model-prior-mixture-1.svg | 201 - .../JAGS-fit/jags-model-prior-mixture-2.svg | 181 - .../JAGS-fit/jags-model-prior-mixture-3.svg | 169 - .../JAGS-fit/jags-model-prior-mixture-4.svg | 711 -- .../jags-model-prior-spike-and-slab-1.svg | 107 - .../jags-model-prior-spike-and-slab-2.svg | 382 - .../JAGS-fit/jags-model-prior-vector-1.svg | 10152 --------------- .../JAGS-fit/jags-model-prior-vector-2.svg | 10022 --------------- .../JAGS-fit/jags-model-prior-vector-3.svg | 10160 ---------------- .../JAGS-fit/jags-model-weightfunction-1.svg | 168 - .../JAGS-fit/jags-model-weightfunction-2.svg | 245 - .../JAGS-fit/jags-model-weightfunction-3.svg | 286 - .../JAGS-fit/jags-model-weightfunction-4.svg | 168 - .../JAGS-fit/jags-model-weightfunction-5.svg | 114 - .../JAGS-fit/jags-model-weightfunction-6.svg | 160 - .../_snaps/JAGS-formula/jags-formula-lm-1.svg | 202 - .../JAGS-formula/jags-formula-lm-10.svg | 386 - .../JAGS-formula/jags-formula-lm-11.svg | 203 - .../JAGS-formula/jags-formula-lm-12.svg | 215 - .../JAGS-formula/jags-formula-lm-13.svg | 164 - .../JAGS-formula/jags-formula-lm-14.svg | 173 - .../JAGS-formula/jags-formula-lm-1s.svg | 204 - .../_snaps/JAGS-formula/jags-formula-lm-2.svg | 202 - .../_snaps/JAGS-formula/jags-formula-lm-3.svg | 207 - .../_snaps/JAGS-formula/jags-formula-lm-4.svg | 208 - .../_snaps/JAGS-formula/jags-formula-lm-5.svg | 205 - .../_snaps/JAGS-formula/jags-formula-lm-6.svg | 213 - .../_snaps/JAGS-formula/jags-formula-lm-7.svg | 383 - .../_snaps/JAGS-formula/jags-formula-lm-8.svg | 379 - .../_snaps/JAGS-formula/jags-formula-lm-9.svg | 414 - .../ggplot-marginal-mu-x-cont1.svg | 105 + .../ggplot-marginal-mu-x-fac2t-1.svg | 89 + .../ggplot-marginal-mu-x-fac2t-2.svg | 90 + .../ggplot-marginal-mu-x-fac2t-3.svg | 103 + .../ggplot-marginal-mu-x-fac2t-4.svg | 91 + .../ggplot-marginal-mu-x-fac3md.svg | 97 + .../ggplot-marginal-ss-mu-x-cont1.svg | 109 + .../ggplot-marginal-ss-mu-x-fac2t-1.svg | 93 + .../ggplot-marginal-ss-mu-x-fac2t-2.svg | 94 + .../ggplot-marginal-ss-mu-x-fac2t-3.svg | 103 + .../ggplot-marginal-ss-mu-x-fac2t-4.svg | 99 + .../ggplot-marginal-ss-mu-x-fac3md.svg | 105 + .../marginal-form-con-exp.svg | 217 + .../marginal-form-con-p-exp.svg | 403 + .../marginal-form-con-p.svg | 452 +- .../marginal-form-con.svg | 200 + .../marginal-form-fac-md-at.svg | 398 + .../marginal-form-fac-md-p.svg | 184 +- .../marginal-form-fac-md.svg | 239 + .../marginal-form-fac-mdi-p.svg | 1046 +- .../marginal-form-fac-mdi.svg | 620 + .../marginal-form-fac-t-p.svg | 144 +- .../marginal-form-fac-t.svg | 146 + .../marginal-form-int-p.svg | 69 + .../marginal-form-int.svg | 72 + .../marginal-inference-cont-p.svg | 392 + .../marginal-inference-cont.svg | 227 + .../marginal-inference-fac-md-p.svg} | 190 +- .../marginal-inference-fac-md.svg | 239 + .../marginal-inference-ss-cont-p.svg | 392 + .../marginal-inference-ss-cont.svg | 227 + .../marginal-inference-ss-fac-md-p.svg} | 186 +- .../marginal-inference-ss-fac-md.svg | 225 + .../marginal-prior-ind.svg | 0 .../marginal-prior-trt.svg | 0 .../marginal-prior-weightfunction.svg | 0 .../marginal-simple-con-p.svg | 80 + .../marginal-simple-con.svg | 70 + .../marginal-simple-fac-p.svg} | 54 +- .../marginal-simple-fac.svg | 138 + .../marginal-ss-cond-fac.svg | 390 +- .../marginal-ss-form-con-exp.svg | 207 + .../marginal-ss-form-con-p-exp.svg | 407 + .../marginal-ss-form-con-p.svg | 408 +- .../marginal-ss-form-con.svg | 213 +- .../marginal-ss-form-fac-md-at.svg | 454 +- .../marginal-ss-form-fac-md-p.svg | 182 +- .../marginal-ss-form-fac-md.svg | 270 +- .../marginal-ss-form-fac-mdi-p.svg | 1036 +- .../marginal-ss-form-fac-mdi.svg | 740 +- .../marginal-ss-form-fac-t-p.svg | 138 +- .../marginal-ss-form-fac-t.svg | 166 +- .../marginal-ss-form-int-p.svg | 72 + .../marginal-ss-form-int.svg | 80 +- .../marginal-ss-simple-con-p.svg | 88 + .../marginal-ss-simple-con.svg | 60 + .../marginal-ss-simple-fac-p.svg} | 79 +- .../marginal-ss-simple-fac.svg | 93 +- .../plot-marginal-int.svg | 83 + .../plot-marginal-mu-x-cont1.svg | 72 + .../plot-marginal-mu-x-fac2t-1.svg | 56 + .../plot-marginal-mu-x-fac2t-2.svg | 57 + .../plot-marginal-mu-x-fac2t-3.svg | 66 + .../plot-marginal-mu-x-fac2t-4.svg | 64 + .../plot-marginal-mu-x-fac2t-5.svg | 66 + .../plot-marginal-mu-x-fac3md.svg | 68 + .../plot-marginal-ss-int.svg | 87 + .../plot-marginal-ss-mu-x-cont1.svg | 74 + .../plot-marginal-ss-mu-x-fac2t-1.svg | 58 + .../plot-marginal-ss-mu-x-fac2t-2.svg | 59 + .../plot-marginal-ss-mu-x-fac2t-3.svg | 70 + .../plot-marginal-ss-mu-x-fac2t-4.svg | 68 + .../plot-marginal-ss-mu-x-fac2t-5.svg | 68 + .../plot-marginal-ss-mu-x-fac3md.svg | 72 + .../jags-model-averaging-1.svg | 138 - .../jags-model-averaging-2.svg | 267 - .../jags-model-averaging-3.svg | 382 - ...jags-model-averaging-weightfunctions-1.svg | 384 - ...jags-model-averaging-weightfunctions-2.svg | 650 - .../ggplot-marginal-mu-x-cont1.svg | 105 - .../ggplot-marginal-mu-x-fac2t-1.svg | 89 - .../ggplot-marginal-mu-x-fac2t-2.svg | 90 - .../ggplot-marginal-mu-x-fac2t-3.svg | 99 - .../ggplot-marginal-mu-x-fac2t-4.svg | 91 - .../ggplot-marginal-mu-x-fac3md.svg | 97 - .../ggplot-marginal-ss-mu-x-cont1.svg | 109 - .../ggplot-marginal-ss-mu-x-fac2t-1.svg | 89 - .../ggplot-marginal-ss-mu-x-fac2t-2.svg | 90 - .../ggplot-marginal-ss-mu-x-fac2t-3.svg | 107 - .../ggplot-marginal-ss-mu-x-fac2t-4.svg | 99 - .../ggplot-marginal-ss-mu-x-fac3md.svg | 105 - .../marginal-form-con-exp.svg | 213 - .../marginal-form-con-p-exp.svg | 411 - .../marginal-form-con.svg | 208 - .../marginal-form-fac-md-at.svg | 369 - .../marginal-form-fac-md.svg | 213 - .../marginal-form-fac-mdi.svg | 579 - .../marginal-form-fac-t.svg | 150 - .../marginal-form-int-p.svg | 73 - .../marginal-form-int.svg | 76 - .../marginal-inference-cont-p.svg | 392 - .../marginal-inference-cont.svg | 233 - .../marginal-inference-fac-md.svg | 213 - .../marginal-inference-ss-cont-p.svg | 392 - .../marginal-inference-ss-cont.svg | 235 - .../marginal-inference-ss-fac-md.svg | 233 - .../marginal-simple-con-p.svg | 88 - .../marginal-simple-con.svg | 73 - .../marginal-simple-fac.svg | 148 - .../marginal-ss-form-con-exp.svg | 209 - .../marginal-ss-form-con-p-exp.svg | 407 - .../marginal-ss-form-int-p.svg | 69 - .../marginal-ss-simple-con-p.svg | 88 - .../marginal-ss-simple-con.svg | 79 - .../plot-marginal-int.svg | 83 - .../plot-marginal-mu-x-cont1.svg | 72 - .../plot-marginal-mu-x-fac2t-1.svg | 60 - .../plot-marginal-mu-x-fac2t-2.svg | 61 - .../plot-marginal-mu-x-fac2t-3.svg | 68 - .../plot-marginal-mu-x-fac2t-4.svg | 66 - .../plot-marginal-mu-x-fac2t-5.svg | 66 - .../plot-marginal-mu-x-fac3md.svg | 76 - .../plot-marginal-ss-int.svg | 87 - .../plot-marginal-ss-mu-x-cont1.svg | 74 - .../plot-marginal-ss-mu-x-fac2t-1.svg | 58 - .../plot-marginal-ss-mu-x-fac2t-2.svg | 59 - .../plot-marginal-ss-mu-x-fac2t-3.svg | 68 - .../plot-marginal-ss-mu-x-fac2t-4.svg | 68 - .../plot-marginal-ss-mu-x-fac2t-5.svg | 68 - .../plot-marginal-ss-mu-x-fac3md.svg | 74 - .../model-averaging-ggplot-posterior-i-1.svg | 101 - .../model-averaging-ggplot-posterior-i-2.svg | 106 - .../model-averaging-ggplot-posterior-md-1.svg | 107 - .../model-averaging-ggplot-posterior-md-2.svg | 107 - .../model-averaging-ggplot-posterior-md-3.svg | 107 - .../model-averaging-ggplot-posterior-md-4.svg | 97 - .../model-averaging-ggplot-posterior-md-5.svg | 120 - .../model-averaging-ggplot-posterior-o-1.svg | 113 - .../model-averaging-ggplot-posterior-o-2.svg | 113 - .../model-averaging-ggplot-posterior-o-3.svg | 113 - .../model-averaging-ggplot-posterior-o-4.svg | 103 - .../model-averaging-ggplot-posterior-o-5.svg | 120 - .../model-averaging-ggplot-posterior-t-1.svg | 111 - .../model-averaging-ggplot-posterior-t-2.svg | 111 - .../model-averaging-ggplot-posterior-t-3.svg | 111 - .../model-averaging-ggplot-posterior-t-4.svg | 107 - .../model-averaging-ggplot-posterior-t-5.svg | 108 - .../model-averaging-plot-models-1.svg | 79 - .../model-averaging-plot-models-10.svg | 91 - .../model-averaging-plot-models-2.svg | 79 - .../model-averaging-plot-models-3.svg | 79 - .../model-averaging-plot-models-4.svg | 81 - .../model-averaging-plot-models-5.svg | 65 - .../model-averaging-plot-models-6.svg | 65 - .../model-averaging-plot-models-7.svg | 94 - .../model-averaging-plot-models-8.svg | 92 - .../model-averaging-plot-models-9.svg | 87 - .../model-averaging-plot-models-formula-1.svg | 89 - ...model-averaging-plot-models-formula-10.svg | 103 - ...model-averaging-plot-models-formula-11.svg | 117 - ...model-averaging-plot-models-formula-12.svg | 117 - ...model-averaging-plot-models-formula-13.svg | 117 - .../model-averaging-plot-models-formula-2.svg | 84 - .../model-averaging-plot-models-formula-3.svg | 87 - .../model-averaging-plot-models-formula-4.svg | 162 - .../model-averaging-plot-models-formula-5.svg | 166 - .../model-averaging-plot-models-formula-6.svg | 226 - .../model-averaging-plot-models-formula-7.svg | 258 - .../model-averaging-plot-models-formula-8.svg | 225 - .../model-averaging-plot-models-formula-9.svg | 240 - ...odel-averaging-plot-models-formula-s-1.svg | 205 - ...odel-averaging-plot-models-formula-s-2.svg | 216 - .../model-averaging-plot-posterior-i-1.svg | 62 - .../model-averaging-plot-posterior-i-2.svg | 62 - .../model-averaging-plot-posterior-i-3.svg | 75 - .../model-averaging-plot-posterior-md-1.svg | 75 - .../model-averaging-plot-posterior-md-2.svg | 75 - .../model-averaging-plot-posterior-md-3.svg | 75 - .../model-averaging-plot-posterior-md-4.svg | 69 - .../model-averaging-plot-posterior-md-5.svg | 84 - .../model-averaging-plot-posterior-o-5.svg | 84 - ...el-averaging-plot-posterior-petpeese-5.svg | 64 - ...el-averaging-plot-posterior-petpeese-6.svg | 60 - ...el-averaging-plot-posterior-petpeese-8.svg | 64 - ...odel-averaging-plot-posterior-simple-1.svg | 75 - ...odel-averaging-plot-posterior-simple-2.svg | 98 - ...odel-averaging-plot-posterior-simple-3.svg | 52 - ...odel-averaging-plot-posterior-simple-4.svg | 77 - ...odel-averaging-plot-posterior-simple-5.svg | 58 - ...odel-averaging-plot-posterior-simple-6.svg | 74 - ...odel-averaging-plot-posterior-simple-8.svg | 54 - .../model-averaging-plot-posterior-t-1.svg | 75 - .../model-averaging-plot-posterior-t-2.svg | 75 - .../model-averaging-plot-posterior-t-3.svg | 75 - .../model-averaging-plot-posterior-t-4.svg | 73 - .../model-averaging-plot-posterior-t-5.svg | 76 - .../model-averaging-plot-prior-petpeese-1.svg | 62 - .../model-averaging-plot-prior-petpeese-5.svg | 62 - .../model-averaging-plot-prior-petpeese-7.svg | 60 - ...eraging-plot-ss-posterior-bias-pet.new.svg | 76 - ...l-averaging-plot-ss-posterior-bias-pet.svg | 78 - ...ng-plot-ss-posterior-intercept-con.new.svg | 54 - ...raging-plot-ss-posterior-intercept-con.svg | 54 - ...raging-plot-ss-posterior-intercept.new.svg | 74 - ...-averaging-plot-ss-posterior-intercept.svg | 74 - ...-averaging-plot-ss-posterior-omega-con.svg | 730 -- ...veraging-plot-ss-posterior-pet-con.new.svg | 384 - ...el-averaging-plot-ss-posterior-pet-con.svg | 260 - ...-averaging-plot-ss-posterior-sigma.new.svg | 62 - ...odel-averaging-plot-ss-posterior-sigma.svg | 60 - ...ot-ss-posterior-weightfunction-con.new.svg | 59 - ...g-plot-ss-posterior-weightfunction.new.svg | 59 - ...ging-plot-ss-posterior-x-cont1-con.new.svg | 58 - ...veraging-plot-ss-posterior-x-cont1-con.svg | 58 - ...veraging-plot-ss-posterior-x-cont1.new.svg | 78 - ...ging-plot-ss-posterior-x-fac2t-con.new.svg | 55 - ...veraging-plot-ss-posterior-x-fac2t-con.svg | 55 - ...veraging-plot-ss-posterior-x-fac2t.new.svg | 75 - ...el-averaging-plot-ss-posterior-x-fac2t.svg | 75 - ...ging-plot-ss-posterior-x-fac3t-con.new.svg | 62 - ...veraging-plot-ss-posterior-x-fac3t-con.svg | 62 - ...veraging-plot-ss-posterior-x-fac3t.new.svg | 80 - ...el-averaging-plot-ss-posterior-x-fac3t.svg | 80 - ...simple-plot-ss-posterior-intercept.new.svg | 54 - ...ing-simple-plot-ss-posterior-intercept.svg | 54 - ...eraging-simple-plot-ss-posterior-sigma.svg | 62 - ...g-simple-plot-ss-posterior-x-cont1.new.svg | 58 - ...aging-simple-plot-ss-posterior-x-cont1.svg | 58 - ...aging-simple-plot-ss-posterior-x-fac2t.svg | 55 - ...g-simple-plot-ss-posterior-x-fac3t.new.svg | 62 - ...aging-simple-plot-ss-posterior-x-fac3t.svg | 62 - .../model-averaging-formulas.new.svg | 256 - .../model-averaging-formulas.svg | 256 - .../model-averaging-simple-priors.new.svg | 269 - .../model-averaging-simple-priors.svg | 269 - tests/testthat/test-00-model-fits.R | 792 +- tests/testthat/test-JAGS-diagnostic-plots.R | 260 + tests/testthat/test-JAGS-diagnostics.R | 458 - ...ing-plots.R => test-JAGS-ensemble-plots.R} | 1176 +- tests/testthat/test-JAGS-ensemble-tables.R | 58 +- tests/testthat/test-JAGS-fit.R | 1490 --- tests/testthat/test-JAGS-formula.R | 734 +- ...s.R => test-JAGS-marginal-distributions.R} | 189 +- tests/testthat/test-JAGS-marglik.R | 360 +- tests/testthat/test-JAGS-model-averaging.R | 498 - ...ion.R => test-JAGS-posterior-extraction.R} | 0 tests/testthat/test-JAGS-summary-tables.R | 4 +- tests/testthat/test-model-averaging.R | 218 - 572 files changed, 21330 insertions(+), 100972 deletions(-) create mode 100644 tests/results/JAGS-ensemble-tables/as_mixed_posteriors_complex_estimates.txt create mode 100644 tests/results/JAGS-ensemble-tables/as_mixed_posteriors_simple_estimates.txt create mode 100644 tests/results/JAGS-marginal-distributions/marginal_estimates_table_model_avg.txt create mode 100644 tests/results/JAGS-marginal-distributions/marginal_estimates_table_spike_slab.txt create mode 100644 tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_marginal_0_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_marginal_1_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_missing_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_orthonormal_0_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_orthonormal_1_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_peese_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_pet_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_missing_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_onesided_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_twosided_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-3-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-3-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-3-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-4.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-5.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-6.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-7.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-8.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-4.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-5.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-6.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-7.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-8.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-4.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-5.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-6.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-7.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-8.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-3.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-1.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-2.svg create mode 100644 tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics4-ggplot-density-fit-simple.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-2.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-o-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-o-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-o-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-o-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-petpeese-1.svg (87%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-petpeese-2.svg (64%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-5.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-6.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-petpeese-7.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-8.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-petpeese-9.svg (66%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-2.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-3.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-4.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-5.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-6.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-simple-7.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-8.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-1.svg (97%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-10.svg (95%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-2.svg (98%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-3.svg (97%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-4.svg (98%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-6.svg (97%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-7.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-8.svg (97%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-posterior-wf-9.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-independent-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-independent-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-independent-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-independent-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-5.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-meandif-6.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-5.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-orthonormal-6.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-10.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-11.svg (55%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-12.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-2.svg (82%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-4.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-6.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-8.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-petpeese-9.svg (58%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-10.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-11.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-12.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-13.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-5.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-6.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-7.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-8.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-simple-9.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-1.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-5.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-treatment-6.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-1.svg (93%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-10.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-11.svg (89%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-12.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-2.svg (96%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-4.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-5.svg (93%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-6.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-7.svg (88%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-8.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-prior-wf-9.svg (92%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept.svg rename tests/testthat/_snaps/{model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg => JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg} (59%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-sigma.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-ss-posterior-weightfunction-con.svg (87%) rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-ss-posterior-weightfunction.svg (90%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg rename tests/testthat/_snaps/{model-averaging-plots => JAGS-ensemble-plots}/model-averaging-plot-ss-posterior-x-cont1.svg (59%) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-intercept.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-sigma.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-fit-posterior.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-10.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-11.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-12.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-13.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-14.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-9.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-e1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-e2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-e3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-10.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-9.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-10.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-11.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-12.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-13.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-14.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1s.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-4.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-5.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-6.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-7.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-8.svg delete mode 100644 tests/testthat/_snaps/JAGS-formula/jags-formula-lm-9.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-cont1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac3md.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-exp.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p-exp.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-form-con-p.svg (61%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-at.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-form-fac-md-p.svg (85%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-form-fac-mdi-p.svg (72%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-form-fac-t-p.svg (83%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int-p.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont-p.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont.svg rename tests/testthat/_snaps/{marginal-distributions/marginal-inference-ss-fac-md-p.svg => JAGS-marginal-distributions/marginal-inference-fac-md-p.svg} (53%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont.svg rename tests/testthat/_snaps/{marginal-distributions/marginal-inference-fac-md-p.svg => JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg} (53%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-prior-ind.svg (100%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-prior-trt.svg (100%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-prior-weightfunction.svg (100%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con-p.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con.svg rename tests/testthat/_snaps/{marginal-distributions/marginal-ss-simple-fac-p.svg => JAGS-marginal-distributions/marginal-simple-fac-p.svg} (77%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-cond-fac.svg (51%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-exp.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-con-p.svg (65%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-con.svg (56%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-md-at.svg (51%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-md-p.svg (85%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-md.svg (52%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-mdi-p.svg (72%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-mdi.svg (53%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-t-p.svg (83%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-fac-t.svg (54%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-form-int.svg (54%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con.svg rename tests/testthat/_snaps/{marginal-distributions/marginal-simple-fac-p.svg => JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg} (69%) rename tests/testthat/_snaps/{marginal-distributions => JAGS-marginal-distributions}/marginal-ss-simple-fac.svg (62%) create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-int.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-cont1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-2.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-3.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-4.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-5.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac3md.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg delete mode 100644 tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-2.svg delete mode 100644 tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-3.svg delete mode 100644 tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-1.svg delete mode 100644 tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-2.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-cont1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac3md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-con-exp.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-con-p-exp.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-con.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-at.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-int-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-form-int.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-cont-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-cont.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-simple-con-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-simple-con.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-simple-fac.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-exp.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p-exp.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con-p.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-int.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-cont1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-2.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-3.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-4.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-5.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac3md.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-int.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-cont1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg delete mode 100644 tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-10.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-6.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-7.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-8.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-9.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-10.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-11.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-12.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-13.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-6.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-7.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-8.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-9.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-6.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-8.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-6.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-8.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-3.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-4.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-5.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-7.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-sigma.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg delete mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg delete mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg delete mode 100644 tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg create mode 100644 tests/testthat/test-JAGS-diagnostic-plots.R delete mode 100644 tests/testthat/test-JAGS-diagnostics.R rename tests/testthat/{test-model-averaging-plots.R => test-JAGS-ensemble-plots.R} (51%) delete mode 100644 tests/testthat/test-JAGS-fit.R rename tests/testthat/{test-marginal-distributions.R => test-JAGS-marginal-distributions.R} (78%) delete mode 100644 tests/testthat/test-JAGS-model-averaging.R rename tests/testthat/{test-posterior-extraction.R => test-JAGS-posterior-extraction.R} (100%) delete mode 100644 tests/testthat/test-model-averaging.R diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 164099b..754548e 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -1,6 +1,5 @@ --- applyTo: "**/tests/testthat/*.R" -description: Guidelines for organizing and maintaining tests in BayesTools, including model fitting, model averaging, and summary table tests. Ensures consistency and avoids duplication. --- # BayesTools Test Organization Guidelines @@ -26,11 +25,17 @@ Tests in BayesTools follow a structured organization where model fitting is cent - **Only load** pre-computed marginal likelihoods using `readRDS()` - Test the functionality they are designed for (e.g., model averaging, plotting, etc.) -### 2. Avoid Duplication +### 2. STRICTLY Avoid Duplication -**Before adding a new model to `test-00-model-fits.R`, check if a similar model already exists.** +**Before adding a new model to `test-00-model-fits.R`, you MUST exhaustively check if an existing model can be used.** -Models are duplicates if they have the same model structure, prior types, and data structure. Use one model per prior type. +- **Do not create a new model just to test a specific function** (e.g., a plot or summary). Use an existing model that has the necessary components (e.g., if you need a model with a factor prior, use `fit_factor_independent` or `fit_formula_interaction_fac`). +- **Models are duplicates** if they have the same model structure, prior types, and data structure. +- **Reuse Strategy**: + 1. Read `test-00-model-fits.R` to see available models. + 2. Identify a model that has the features you need (e.g., "I need a model with a spike-and-slab prior"). + 3. Use that model in your test. + 4. **Only** if no such model exists, add a new one to `test-00-model-fits.R`. ### 3. Model Naming Convention @@ -63,7 +68,7 @@ marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.R # Define at the top of test files with reference outputs # Load common test helpers that define test_reference_table() and test_reference_text() -REFERENCE_DIR <- testthat::test_path("..", "results", "print") +REFERENCE_DIR <<- testthat::test_path("..", "results", "print") source(testthat::test_path("common-functions.R")) ### 6. Test File Organization @@ -88,6 +93,15 @@ All tests that use JAGS models (e.g., `test-model-averaging.R`, `test-JAGS-*.R`, - Changing to `TRUE` regenerates all reference files (tables, figures, etc.) and should only be done by the maintainer - **Outputs**: Reference files (`.txt`, `.svg`, `.png`, etc.) stored in `tests/results/` subdirectories +## AI Agent Protocol + +When asked to write or refactor tests: + +1. **Scan `test-00-model-fits.R` FIRST.** Understand the inventory of available models. +2. **Map requirements to existing models.** If the user needs a test for "diagnostic plots for factor priors", find an existing model with factor priors (e.g., `fit_formula_interaction_fac`). +3. **Refuse to create new models** unless the test requires a specific mathematical structure not present in the entire suite. +4. **Never** add a model to `test-00-model-fits.R` without explicitly explaining why none of the existing 15+ models suffice. + ## Maintenance Checklist **Adding a new model:** @@ -143,4 +157,4 @@ model_names <- c(..., "fit_new") - **"Pre-fitted models not available"**: Run `devtools::test(filter = "00-model-fits")` - **Summary table mismatch**: Contact maintainer; **do not** modify `GENERATE_REFERENCE_FILES` - **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture -- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture \ No newline at end of file +- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture diff --git a/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_complex_estimates.txt b/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_complex_estimates.txt new file mode 100644 index 0000000..6dbd96b --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_complex_estimates.txt @@ -0,0 +1,12 @@ + Mean Median 0.025 0.95 +(mu) intercept -0.103 -0.118 -0.222 0.000 +(mu) x_cont1 0.273 0.273 0.150 0.375 +(mu) x_fac2t[1] 0.009 0.000 0.000 0.079 +(mu) x_fac3t[1] 0.218 0.261 0.000 0.407 +(mu) x_fac3t[2] -0.010 0.000 -0.147 0.101 +sigma 0.803 0.803 0.736 0.859 +omega[0,0.025] 1.000 1.000 1.000 1.000 +omega[0.025,0.05] 0.871 1.000 0.100 1.000 +omega[0.05,0.975] 0.815 1.000 0.047 1.000 +omega[0.975,1] 0.895 1.000 0.091 1.000 +PET 0.105 0.000 0.000 0.812 diff --git a/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_simple_estimates.txt b/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_simple_estimates.txt new file mode 100644 index 0000000..d3ce3a6 --- /dev/null +++ b/tests/results/JAGS-ensemble-tables/as_mixed_posteriors_simple_estimates.txt @@ -0,0 +1,7 @@ + Mean Median 0.025 0.95 +(mu) intercept -0.151 -0.150 -0.235 -0.078 +(mu) x_cont1 0.285 0.289 0.166 0.397 +(mu) x_fac2t[1] 0.064 0.066 -0.071 0.177 +(mu) x_fac3t[1] 0.236 0.240 0.102 0.350 +(mu) x_fac3t[2] -0.014 -0.016 -0.127 0.095 +sigma 0.796 0.796 0.739 0.850 diff --git a/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt b/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt index 11e12e0..835a8f5 100644 --- a/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt +++ b/tests/results/JAGS-ensemble-tables/spike_factors_estimates.txt @@ -1,3 +1,3 @@ - Mean Median 0.025 0.95 -(mu) x_fac3md[1] -0.027 0.000 -0.257 0.000 -(mu) x_fac3md[2] 0.007 0.000 -0.122 0.127 + Mean Median 0.025 0.95 +(mu) x_fac3md[1] 0.001 0.000 0.000 0.000 +(mu) x_fac3md[2] 0.004 0.000 0.000 0.000 diff --git a/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt b/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt index 1eaa23c..dc65de0 100644 --- a/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt +++ b/tests/results/JAGS-ensemble-tables/spike_factors_inference.txt @@ -1,2 +1,2 @@ Models Prior prob. Post. prob. Inclusion BF -(mu) x_fac3md 1/2 0.500 0.252 0.337 +(mu) x_fac3md 1/2 0.500 0.027 0.027 diff --git a/tests/results/JAGS-marginal-distributions/marginal_estimates_table_model_avg.txt b/tests/results/JAGS-marginal-distributions/marginal_estimates_table_model_avg.txt new file mode 100644 index 0000000..a34abf2 --- /dev/null +++ b/tests/results/JAGS-marginal-distributions/marginal_estimates_table_model_avg.txt @@ -0,0 +1,37 @@ + Mean Median 0.025 0.95 Inclusion BF +(mu) intercept 0.614 0.614 0.515 0.688 Inf +(mu) x_cont1[-1SD] 0.430 0.430 0.296 0.537 Inf +(mu) x_cont1[0SD] 0.614 0.614 0.515 0.688 Inf +(mu) x_cont1[1SD] 0.798 0.799 0.676 0.896 Inf +(mu) x_fac2t[A] 0.611 0.613 0.500 0.699 Inf +(mu) x_fac2t[B] 0.621 0.618 0.519 0.708 Inf +(mu) x_fac3md[A] 0.765 0.768 0.600 0.896 Inf +(mu) x_fac3md[B] 0.517 0.519 0.365 0.639 Inf +(mu) x_fac3md[C] 0.550 0.548 0.404 0.673 Inf +(mu) x_cont1:x_fac3md[-1SD, A] 0.550 0.553 0.326 0.743 Inf +(mu) x_cont1:x_fac3md[0SD, A] 0.765 0.768 0.600 0.896 Inf +(mu) x_cont1:x_fac3md[1SD, A] 0.980 0.982 0.770 1.143 Inf +(mu) x_cont1:x_fac3md[-1SD, B] 0.371 0.373 0.136 0.553 Inf +(mu) x_cont1:x_fac3md[0SD, B] 0.517 0.519 0.365 0.639 Inf +(mu) x_cont1:x_fac3md[1SD, B] 0.664 0.666 0.453 0.826 Inf +(mu) x_cont1:x_fac3md[-1SD, C] 0.374 0.373 0.183 0.535 Inf +(mu) x_cont1:x_fac3md[0SD, C] 0.550 0.548 0.404 0.673 Inf +(mu) x_cont1:x_fac3md[1SD, C] 0.727 0.727 0.529 0.901 Inf +mu_intercept: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[-1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[0SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac2t[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac2t[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. diff --git a/tests/results/JAGS-marginal-distributions/marginal_estimates_table_spike_slab.txt b/tests/results/JAGS-marginal-distributions/marginal_estimates_table_spike_slab.txt new file mode 100644 index 0000000..ad5ce21 --- /dev/null +++ b/tests/results/JAGS-marginal-distributions/marginal_estimates_table_spike_slab.txt @@ -0,0 +1,37 @@ + Mean Median 0.025 0.95 Inclusion BF +(mu) intercept 0.618 0.618 0.545 0.678 Inf +(mu) x_cont1[-1SD] 0.436 0.434 0.323 0.535 Inf +(mu) x_cont1[0SD] 0.618 0.618 0.545 0.678 Inf +(mu) x_cont1[1SD] 0.799 0.799 0.696 0.885 Inf +(mu) x_fac2t[A] 0.618 0.618 0.545 0.678 Inf +(mu) x_fac2t[B] 0.618 0.618 0.546 0.680 Inf +(mu) x_fac3md[A] 0.781 0.780 0.656 0.891 Inf +(mu) x_fac3md[B] 0.519 0.519 0.390 0.621 Inf +(mu) x_fac3md[C] 0.553 0.553 0.425 0.659 Inf +(mu) x_cont1:x_fac3md[-1SD, A] 0.593 0.594 0.406 0.744 Inf +(mu) x_cont1:x_fac3md[0SD, A] 0.776 0.778 0.632 0.890 Inf +(mu) x_cont1:x_fac3md[1SD, A] 0.959 0.964 0.812 1.075 Inf +(mu) x_cont1:x_fac3md[-1SD, B] 0.345 0.342 0.178 0.487 Inf +(mu) x_cont1:x_fac3md[0SD, B] 0.522 0.521 0.391 0.625 Inf +(mu) x_cont1:x_fac3md[1SD, B] 0.698 0.701 0.543 0.822 Inf +(mu) x_cont1:x_fac3md[-1SD, C] 0.375 0.374 0.215 0.503 Inf +(mu) x_cont1:x_fac3md[0SD, C] 0.555 0.555 0.426 0.662 Inf +(mu) x_cont1:x_fac3md[1SD, C] 0.735 0.736 0.577 0.865 Inf +mu_intercept: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[-1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[0SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1[1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac2t[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac2t[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_fac3md[C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[-1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[0SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. +mu_x_cont1__xXx__x_fac3md[1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated. diff --git a/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt new file mode 100644 index 0000000..203ca27 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt @@ -0,0 +1,19 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA NA NA NA NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_marginal_0_model_summary.txt b/tests/results/JAGS-summary-tables/fit_marginal_0_model_summary.txt new file mode 100644 index 0000000..90f83f5 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_marginal_0_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 1) + log(marglik) -144.46 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 sigma ~ Cauchy(0, 1)[0, 5] + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt new file mode 100644 index 0000000..c0fad92 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.616 0.037 0.543 0.615 0.689 0.00117 0.032 1000 1.001 +(mu) x_cont1 0.367 0.083 0.205 0.366 0.531 0.00262 0.032 1000 1.002 +sigma 0.517 0.029 0.465 0.515 0.582 0.00114 0.039 646 1.010 diff --git a/tests/results/JAGS-summary-tables/fit_marginal_1_model_summary.txt b/tests/results/JAGS-summary-tables/fit_marginal_1_model_summary.txt new file mode 100644 index 0000000..4c8186c --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_marginal_1_model_summary.txt @@ -0,0 +1,8 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 1) + log(marglik) -148.06 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_fac2t ~ treatment contrast: Normal(0, 1) + Inclusion BF Inf (mu) x_fac3md ~ mean difference contrast: mNormal(0, 0.25) + (mu) x_cont1:x_fac3md ~ mean difference contrast: mNormal(0, 0.25) + sigma ~ Cauchy(0, 1)[0, 5] diff --git a/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt new file mode 100644 index 0000000..1f3742e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt @@ -0,0 +1,9 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.612 0.055 0.500 0.614 0.724 0.00291 0.053 382 1.000 +(mu) x_cont1 0.354 0.086 0.185 0.354 0.515 0.00298 0.035 824 1.000 +(mu) x_fac2t[B] 0.009 0.077 -0.134 0.006 0.170 0.00422 0.055 341 1.001 +(mu) x_fac3md[1] 0.019 0.053 -0.087 0.020 0.124 0.00150 0.028 1423 1.003 +(mu) x_fac3md[2] 0.154 0.054 0.047 0.155 0.258 0.00180 0.033 916 1.006 +(mu) x_cont1:x_fac3md[1] 0.018 0.058 -0.094 0.018 0.136 0.00192 0.033 928 0.999 +(mu) x_cont1:x_fac3md[2] 0.036 0.058 -0.081 0.037 0.150 0.00197 0.034 871 1.001 +sigma 0.509 0.028 0.458 0.508 0.566 0.00136 0.049 442 1.022 diff --git a/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt new file mode 100644 index 0000000..fb47423 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt @@ -0,0 +1,13 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.618 0.038 0.545 0.618 0.690 0.00132 0.035 853 0.999 +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.358 0.084 0.197 0.357 0.518 0.00282 0.034 897 1.003 +(mu) x_fac2t (inclusion) 0.056 NA NA NA NA NA NA NA NA +(mu) x_fac2t[B] 0.000 0.018 -0.009 0.000 0.009 0.00086 0.048 469 1.003 +(mu) x_fac3md (inclusion) 0.827 NA NA NA NA NA NA NA NA +(mu) x_fac3md[1] 0.016 0.050 -0.083 0.004 0.129 0.00161 0.032 958 1.002 +(mu) x_fac3md[2] 0.135 0.078 0.000 0.150 0.262 0.00520 0.067 225 1.004 +(mu) x_cont1:x_fac3md (inclusion) 0.075 NA NA NA NA NA NA NA NA +(mu) x_cont1:x_fac3md[1] 0.002 0.016 0.000 0.000 0.039 0.00048 0.031 1092 1.046 +(mu) x_cont1:x_fac3md[2] 0.003 0.018 0.000 0.000 0.062 0.00056 0.031 1107 1.027 +sigma 0.509 0.028 0.459 0.507 0.564 0.00119 0.043 535 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_missing_model_summary.txt b/tests/results/JAGS-summary-tables/fit_missing_model_summary.txt new file mode 100644 index 0000000..ca05355 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_missing_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 mu ~ Normal(0.2, 0.2) + log(marglik) 0.00 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt new file mode 100644 index 0000000..21bd192 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.201 0.198 -0.181 0.200 0.591 0.00442 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_0_model_summary.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_0_model_summary.txt new file mode 100644 index 0000000..47f747e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_0_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -165.93 sigma ~ Lognormal(0, 1) + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt new file mode 100644 index 0000000..d52d75a --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.510 0.084 0.345 0.510 0.675 0.00067 0.008 15675 1.000 +sigma 0.922 0.060 0.812 0.919 1.049 0.00060 0.010 10076 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_1_model_summary.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_1_model_summary.txt new file mode 100644 index 0000000..06b973e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_1_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -163.22 (mu) x_fac3o ~ orthonormal contrast: mNormal(0, 0.5) + Post. prob. 1.000 sigma ~ Lognormal(0, 1) + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt new file mode 100644 index 0000000..6259c80 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.512 0.081 0.352 0.512 0.667 0.00063 0.008 16217 1.000 +(mu) x_fac3o[1] 0.445 0.135 0.181 0.445 0.709 0.00107 0.008 15913 1.000 +(mu) x_fac3o[2] 0.024 0.136 -0.247 0.027 0.289 0.00109 0.008 15629 1.000 +sigma 0.885 0.058 0.781 0.882 1.005 0.00058 0.010 9955 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_peese_model_summary.txt b/tests/results/JAGS-summary-tables/fit_peese_model_summary.txt new file mode 100644 index 0000000..224e4d6 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_peese_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 PEESE ~ Normal(0, 0.8)[0, Inf] + log(marglik) -0.01 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt new file mode 100644 index 0000000..28d7416 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +PEESE 0.644 0.489 0.025 0.545 1.774 0.01094 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_pet_model_summary.txt b/tests/results/JAGS-summary-tables/fit_pet_model_summary.txt new file mode 100644 index 0000000..d519338 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_pet_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 PET ~ Normal(0, 0.2)[0, Inf] + log(marglik) -0.01 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt new file mode 100644 index 0000000..1691276 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +PET 0.157 0.120 0.005 0.130 0.444 0.00269 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt new file mode 100644 index 0000000..e6c714c --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt @@ -0,0 +1,7 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.151 0.044 -0.235 -0.150 -0.065 0.00198 0.045 500 NA +(mu) x_cont1 0.285 0.064 0.166 0.289 0.412 0.00285 0.045 500 NA +(mu) x_fac2t 0.064 0.066 -0.071 0.066 0.194 0.00297 0.045 500 NA +(mu) x_fac3t[1] 0.236 0.069 0.102 0.240 0.375 0.00306 0.045 500 NA +(mu) x_fac3t[2] -0.014 0.064 -0.127 -0.016 0.117 0.00287 0.045 500 NA +sigma 0.796 0.032 0.739 0.796 0.861 0.00175 0.055 331 NA diff --git a/tests/results/JAGS-summary-tables/fit_wf_missing_model_summary.txt b/tests/results/JAGS-summary-tables/fit_wf_missing_model_summary.txt new file mode 100644 index 0000000..77027a3 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_missing_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 mu ~ Normal(0, 0.8) + log(marglik) 0.00 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt new file mode 100644 index 0000000..ed26799 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.005 0.790 -1.525 0.002 1.564 0.01767 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_wf_onesided_model_summary.txt b/tests/results/JAGS-summary-tables/fit_wf_onesided_model_summary.txt new file mode 100644 index 0000000..cc8bca9 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_onesided_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 omega[one-sided: .025] ~ CumDirichlet(1, 1) + log(marglik) -0.02 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt new file mode 100644 index 0000000..873897a --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,1] 0.509 0.289 0.028 0.517 0.978 0.00647 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_wf_twosided_model_summary.txt b/tests/results/JAGS-summary-tables/fit_wf_twosided_model_summary.txt new file mode 100644 index 0000000..014001b --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_twosided_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 omega[two-sided: .05] ~ CumDirichlet(1, 1) + log(marglik) 0.00 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt new file mode 100644 index 0000000..31d8a6c --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.503 0.285 0.032 0.508 0.979 0.00638 0.022 2000 NA diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-1.svg new file mode 100644 index 0000000..f32fd26 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-1.svg @@ -0,0 +1,149 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 +Lag +Autocorrelation(x_cont1) +Normal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-1.svg new file mode 100644 index 0000000..019229d --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-1.svg @@ -0,0 +1,150 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 +Lag +Autocorrelation((mu) x_fac3o [dif: A]) +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-2.svg new file mode 100644 index 0000000..d9dcc4a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-2.svg @@ -0,0 +1,150 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 +Lag +Autocorrelation((mu) x_fac3o [dif: B]) +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-3.svg new file mode 100644 index 0000000..fac47c2 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-2-3.svg @@ -0,0 +1,150 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 +Lag +Autocorrelation((mu) x_fac3o [dif: C]) +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-3-1.svg new file mode 100644 index 0000000..0c43230 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-autocorrelation-3-1.svg @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 +Lag +Autocorrelation(omega[0.025,1]) +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-1.svg new file mode 100644 index 0000000..cbec9bb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-1.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + + + + + + + +1.0 +1.2 +1.4 +1.6 +1.8 +2.0 +2.2 +2.4 +x_cont1 +Density +Normal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-1.svg new file mode 100644 index 0000000..fdf4af8 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-1.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + + + + + + +-0.8 +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +(mu) x_fac3o [dif: A] +Density +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-2.svg new file mode 100644 index 0000000..c024f7a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-2.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +(mu) x_fac3o [dif: B] +Density +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-3.svg new file mode 100644 index 0000000..d943473 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-2-3.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +(mu) x_fac3o [dif: C] +Density +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-3-1.svg new file mode 100644 index 0000000..02b878c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-density-3-1.svg @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +omega[0.025,1] +Density +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-1.svg new file mode 100644 index 0000000..44a74fb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-1.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.0 +1.2 +1.4 +1.6 +1.8 +2.0 +2.2 +2.4 + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 +Iteration +x_cont1 +Normal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-1.svg new file mode 100644 index 0000000..6399f77 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-1.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.8 +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 +Iteration +(mu) x_fac3o [dif: A] +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-2.svg new file mode 100644 index 0000000..a6f59d7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-2.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 +Iteration +(mu) x_fac3o [dif: B] +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-3.svg new file mode 100644 index 0000000..e08e6ea --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-2-3.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 +Iteration +(mu) x_fac3o [dif: C] +orthonormal contrast: +mNormal +(0, 1) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-3-1.svg new file mode 100644 index 0000000..d8575c9 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-ggplot-trace-3-1.svg @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + +0 +500 +1000 +1500 +2000 +Iteration +omega[0.025,1] +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-1.svg new file mode 100644 index 0000000..4e9d13c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-1.svg @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Normal +(0, 1) +Lag +Autocorrelation(x_cont1) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-2.svg new file mode 100644 index 0000000..514eea4 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-2.svg @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Normal +(0, 1) +Lag +Autocorrelation(x_cont1) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-3.svg new file mode 100644 index 0000000..1417b48 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-3.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Treatment +Values +Smth + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-4.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-4.svg new file mode 100644 index 0000000..f10ed26 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-4.svg @@ -0,0 +1,244 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation((mu) x_fac3o[1]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation((mu) x_fac3o[2]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-5.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-5.svg new file mode 100644 index 0000000..a737877 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-5.svg @@ -0,0 +1,357 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation(x_fac3o [dif: A]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation(x_fac3o [dif: B]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation(x_fac3o [dif: C]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-6.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-6.svg new file mode 100644 index 0000000..11bbf3c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-6.svg @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +PET ~ +Normal +(0, 0.2) +[ +0 +, +∞ +] +Lag +Autocorrelation(PET) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-7.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-7.svg new file mode 100644 index 0000000..72b1fbb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-7.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) +Lag +Autocorrelation(omega[0.025,1]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-8.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-8.svg new file mode 100644 index 0000000..3a748e5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-autocorrelation-8.svg @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +Lag +Autocorrelation(p1[3]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-1.svg new file mode 100644 index 0000000..d57020b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-1.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + +0.2 +0.4 +0.6 +0.8 + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +Normal +(0, 1) +x_cont1 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-2.svg new file mode 100644 index 0000000..3221c00 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-2.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + +1.2 +1.4 +1.6 +1.8 +2.0 +2.2 +2.4 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Normal +(0, 1) +x_cont1 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-3.svg new file mode 100644 index 0000000..30f9e1f --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-3.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 + + + + + +0.0 +0.5 +1.0 +1.5 +Treatment +Values +Smth + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-4.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-4.svg new file mode 100644 index 0000000..18b05a8 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-4.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +(mu) x_fac3o[1] +Density + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.8 +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +(mu) x_fac3o[2] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-5.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-5.svg new file mode 100644 index 0000000..e4a4ded --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-5.svg @@ -0,0 +1,167 @@ + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +x_fac3o [dif: A] +Density + + + + + + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +x_fac3o [dif: B] +Density + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +x_fac3o [dif: C] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-6.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-6.svg new file mode 100644 index 0000000..89023f5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-6.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 + + + + + + +0 +1 +2 +3 +4 +PET ~ +Normal +(0, 0.2) +[ +0 +, +∞ +] +PET +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-7.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-7.svg new file mode 100644 index 0000000..770cd94 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-7.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) +omega[0.025,1] +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-8.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-8.svg new file mode 100644 index 0000000..0aeac23 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-density-8.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +p1[3] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg new file mode 100644 index 0000000..195fd63 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + +-0.25 +-0.20 +-0.15 +-0.10 +-0.05 +0.00 + + + + + + + +0 +1 +2 +3 +4 +5 +( +2 +/ +4 +) + +* + +Spike +(0) + ++ + +( +1 +/ +4 +) + +* + +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) +(mu) intercept +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg new file mode 100644 index 0000000..e2840ec --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +( +2 +/ +4 +) + +* + +Spike +(0) + ++ + +( +1 +/ +4 +) + +* + +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) +Lag +Autocorrelation((mu) intercept) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg new file mode 100644 index 0000000..b95fd26 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + +-0.25 +-0.20 +-0.15 +-0.10 +-0.05 +0.00 +( +2 +/ +4 +) + +* + +Spike +(0) + ++ + +( +1 +/ +4 +) + +* + +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) +Iteration +(mu) intercept + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg new file mode 100644 index 0000000..c945200 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + + + +0 +2 +4 +6 +8 +10 +12 +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mNormal +(0, 1) +(mu) x_fac3t[2] +Density + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg new file mode 100644 index 0000000..5a076b1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg @@ -0,0 +1,119 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mNormal +(0, 1) +Lag +Autocorrelation((mu) x_fac3t[2]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg new file mode 100644 index 0000000..ccf6425 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mNormal +(0, 1) +Iteration +(mu) x_fac3t[2] + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-1.svg new file mode 100644 index 0000000..d48957a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-1.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Normal +(0, 1) + +* + +Spike +(0.5) +(mu) x_cont1 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-2.svg new file mode 100644 index 0000000..36f625e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-2.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Normal +(0, 1) + +* + +Spike +(0.5) +Lag +Autocorrelation((mu) x_cont1) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-3.svg new file mode 100644 index 0000000..a878841 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-spike-and-slab-3.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 +Normal +(0, 1) + +* + +Spike +(0.5) +Iteration +(mu) x_cont1 + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-1.svg new file mode 100644 index 0000000..5d5c393 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-1.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + +0.2 +0.4 +0.6 +0.8 +Normal +(0, 1) +Iteration +x_cont1 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-2.svg new file mode 100644 index 0000000..d26d29a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-2.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + +1.2 +1.4 +1.6 +1.8 +2.0 +2.2 +2.4 +Normal +(0, 1) +Iteration +x_cont1 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-3.svg new file mode 100644 index 0000000..c0c6365 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-3.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 +Treatment +Values +Smth + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-4.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-4.svg new file mode 100644 index 0000000..765797c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-4.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Iteration +x_fac3o[1] + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + +-0.8 +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Iteration +x_fac3o[2] + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-5.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-5.svg new file mode 100644 index 0000000..e3bfbdf --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-5.svg @@ -0,0 +1,167 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Iteration +(mu) x_fac3o [dif: A] + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Iteration +(mu) x_fac3o [dif: B] + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +orthonormal contrast: +mNormal +(0, 1) +Iteration +(mu) x_fac3o [dif: C] + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-6.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-6.svg new file mode 100644 index 0000000..f52d80c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-6.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + +0 +500 +1000 +1500 +2000 + + + + + +0.0 +0.2 +0.4 +0.6 +PET ~ +Normal +(0, 0.2) +[ +0 +, +∞ +] +Iteration +PET + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-7.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-7.svg new file mode 100644 index 0000000..07527d1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-7.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + +0 +500 +1000 +1500 +2000 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +ω +one-sided: +.025 + +~ + +CumDirichlet +( +1, 1 +) +Iteration +omega[0.025,1] + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-8.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-8.svg new file mode 100644 index 0000000..23769fc --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-trace-8.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +Iteration +p1[3] + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-1.svg new file mode 100644 index 0000000..c7b2142 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-1.svg @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 +p1[1] +Density +independent contrast: +Gamma +(2, 3) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-2.svg new file mode 100644 index 0000000..d51ef13 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-1-2.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +p1[2] +Density +independent contrast: +Gamma +(2, 3) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-1.svg new file mode 100644 index 0000000..5f26244 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-1.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + +-0.1 +0.0 +0.1 +0.2 +0.3 +0.4 +(mu) x_fac3md [dif: A] +Density +mean difference contrast: +mNormal +(0, 0.25) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-2.svg new file mode 100644 index 0000000..125d539 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-2.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + +-0.30 +-0.25 +-0.20 +-0.15 +-0.10 +-0.05 +0.00 +0.05 +0.10 +(mu) x_fac3md [dif: B] +Density +mean difference contrast: +mNormal +(0, 0.25) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-3.svg new file mode 100644 index 0000000..73f06db --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-ggplot-density-2-3.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + +-0.3 +-0.2 +-0.1 +0.0 +0.1 +0.2 +(mu) x_fac3md [dif: C] +Density +mean difference contrast: +mNormal +(0, 0.25) + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-1.svg new file mode 100644 index 0000000..3a748e5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-1.svg @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +Lag +Autocorrelation(p1[3]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-2.svg new file mode 100644 index 0000000..f30778a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-autocorrelation-2.svg @@ -0,0 +1,357 @@ + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Lag +Autocorrelation(x_fac3md [dif: A]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Lag +Autocorrelation(x_fac3md [dif: B]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Lag +Autocorrelation(x_fac3md [dif: C]) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-1.svg new file mode 100644 index 0000000..0aeac23 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-1.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +p1[3] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-2.svg new file mode 100644 index 0000000..ae011a6 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-2.svg @@ -0,0 +1,112 @@ + + + + + + + + + + + + + + + + + + + + + +-0.15 +-0.05 +0.05 +0.10 +0.15 +0.20 + + + + + + +0 +2 +4 +6 +8 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +(mu) x_fac3md[1] +Density + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 + + + + + +0 +2 +4 +6 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +(mu) x_fac3md[2] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-3.svg new file mode 100644 index 0000000..05284c5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-density-3.svg @@ -0,0 +1,151 @@ + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 + + + + + +0 +2 +4 +6 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +x_fac3md [dif: A] +Density + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.25 +-0.15 +-0.05 +0.00 +0.05 + + + + + +0 +2 +4 +6 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +x_fac3md [dif: B] +Density + + + + + + + + + + + + + + + + + + +-0.2 +-0.1 +0.0 +0.1 + + + + + +0 +2 +4 +6 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +x_fac3md [dif: C] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-1.svg new file mode 100644 index 0000000..23769fc --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-1.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + +independent contrast: +Gamma +(2, 3) +Iteration +p1[3] + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-2.svg new file mode 100644 index 0000000..dd381da --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics3-plot-trace-2.svg @@ -0,0 +1,165 @@ + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + +0.0 +0.1 +0.2 +0.3 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Iteration +x_fac3md [dif: A] + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + + + + +-0.25 +-0.20 +-0.15 +-0.10 +-0.05 +0.00 +0.05 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Iteration +x_fac3md [dif: B] + + + + + + + + + + + + + + + + + + + + +0 +100 +200 +300 +400 +500 + + + + + +-0.2 +-0.1 +0.0 +0.1 + + + + + + + +mean difference contrast: +mNormal +(0, 0.25) +Iteration +x_fac3md [dif: C] + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics4-ggplot-density-fit-simple.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics4-ggplot-density-fit-simple.svg new file mode 100644 index 0000000..d61a666 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics4-ggplot-density-fit-simple.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Normal +(0, 1) + +* + +Beta +(1, 1) +mu +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-1.svg deleted file mode 100644 index b43c599..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-1.svg +++ /dev/null @@ -1,211 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation(x_cont1) -Normal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-1.svg deleted file mode 100644 index 468cb24..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-1.svg +++ /dev/null @@ -1,212 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation((mu) x_fac3o [dif: A]) -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-2.svg deleted file mode 100644 index 5fcbbf5..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-2.svg +++ /dev/null @@ -1,212 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation((mu) x_fac3o [dif: B]) -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-3.svg deleted file mode 100644 index 30a525a..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-2-3.svg +++ /dev/null @@ -1,212 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation((mu) x_fac3o [dif: C]) -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-1.svg deleted file mode 100644 index 054f7cb..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-1.svg +++ /dev/null @@ -1,219 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation(omega[0.05,0.1]) -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-2.svg deleted file mode 100644 index 2496684..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-autocorrelation-3-2.svg +++ /dev/null @@ -1,219 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 -Lag -Autocorrelation(omega[0.1,1]) -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-1.svg deleted file mode 100644 index ed99d45..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-1.svg +++ /dev/null @@ -1,83 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - -1.0 -1.2 -1.4 -1.6 -1.8 -2.0 -x_cont1 -Density -Normal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-1.svg deleted file mode 100644 index 59eeadc..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-1.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -(mu) x_fac3o [dif: A] -Density -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-2.svg deleted file mode 100644 index 25c915c..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-2.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -(mu) x_fac3o [dif: B] -Density -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-3.svg deleted file mode 100644 index c2278f9..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-2-3.svg +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -(mu) x_fac3o [dif: C] -Density -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-1.svg deleted file mode 100644 index 3b4bf1e..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-1.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -omega[0.05,0.1] -Density -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-2.svg deleted file mode 100644 index a20f760..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-density-3-2.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -omega[0.1,1] -Density -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-1.svg deleted file mode 100644 index 8315ee0..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-1.svg +++ /dev/null @@ -1,83 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1.0 -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -x_cont1 -Normal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-1.svg deleted file mode 100644 index 7322f8b..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-1.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -(mu) x_fac3o [dif: A] -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-2.svg deleted file mode 100644 index 89f180e..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-2.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -(mu) x_fac3o [dif: B] -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-3.svg deleted file mode 100644 index 91f5823..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-2-3.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -(mu) x_fac3o [dif: C] -orthonormal contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-1.svg deleted file mode 100644 index 36ddcfc..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-1.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -omega[0.05,0.1] -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-2.svg deleted file mode 100644 index 9845d71..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-ggplot-trace-3-2.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 -Iteration -omega[0.1,1] -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-1.svg deleted file mode 100644 index b7ee022..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-1.svg +++ /dev/null @@ -1,185 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Normal -(0, 1) -Lag -Autocorrelation(x_cont1) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-2.svg deleted file mode 100644 index 6fba6e3..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-2.svg +++ /dev/null @@ -1,185 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Normal -(0, 1) -Lag -Autocorrelation(x_cont1) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-3.svg deleted file mode 100644 index 4eac1a5..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-3.svg +++ /dev/null @@ -1,184 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Treatment -Values -Smth - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-4.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-4.svg deleted file mode 100644 index 4825e58..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-4.svg +++ /dev/null @@ -1,368 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Lag -Autocorrelation((mu) x_fac3o[1]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Lag -Autocorrelation((mu) x_fac3o[2]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-5.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-5.svg deleted file mode 100644 index 79a1bb7..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-5.svg +++ /dev/null @@ -1,543 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3o [dif: A]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3o [dif: B]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3o [dif: C]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-6.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-6.svg deleted file mode 100644 index 5fd2ca3..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-6.svg +++ /dev/null @@ -1,186 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -PET ~ -Gamma -(2, 2) -Lag -Autocorrelation(PET) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-7.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-7.svg deleted file mode 100644 index ef0c76e..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-7.svg +++ /dev/null @@ -1,382 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -Lag -Autocorrelation(omega[0.05,0.1]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -Lag -Autocorrelation(omega[0.1,1]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-8.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-8.svg deleted file mode 100644 index 267b5ab..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-autocorrelation-8.svg +++ /dev/null @@ -1,368 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -independent contrast: -Normal -(0, 0.5) -Lag -Autocorrelation(fac2i[1]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -independent contrast: -Normal -(0, 0.5) -Lag -Autocorrelation(fac2i[2]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-1.svg deleted file mode 100644 index 544a964..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-1.svg +++ /dev/null @@ -1,65 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - -0 -1 -2 -3 -4 -5 -Normal -(0, 1) -x_cont1 -Density - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-2.svg deleted file mode 100644 index c4c675f..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-2.svg +++ /dev/null @@ -1,57 +0,0 @@ - - - - - - - - - - - - - - - - - - -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - -0 -1 -2 -3 -Normal -(0, 1) -x_cont1 -Density - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-3.svg deleted file mode 100644 index eff7701..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-3.svg +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -Treatment -Values -Smth - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-4.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-4.svg deleted file mode 100644 index de4b5b2..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-4.svg +++ /dev/null @@ -1,128 +0,0 @@ - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -(mu) x_fac3o[1] -Density - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -(mu) x_fac3o[2] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-5.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-5.svg deleted file mode 100644 index c74b6fc..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-5.svg +++ /dev/null @@ -1,161 +0,0 @@ - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -x_fac3o [dif: A] -Density - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -x_fac3o [dif: B] -Density - - - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -x_fac3o [dif: C] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-6.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-6.svg deleted file mode 100644 index afae160..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-6.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 - - - - - -0.0 -0.2 -0.4 -0.6 -PET ~ -Gamma -(2, 2) -PET -Density - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-7.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-7.svg deleted file mode 100644 index 457a58e..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-7.svg +++ /dev/null @@ -1,130 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -omega[0.05,0.1] -Density - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -omega[0.1,1] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-8.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-8.svg deleted file mode 100644 index a0c015c..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-density-8.svg +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - --2 --1 -0 -1 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -independent contrast: -Normal -(0, 0.5) -fac2i[1] -Density - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -independent contrast: -Normal -(0, 0.5) -fac2i[2] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-1.svg deleted file mode 100644 index 54edd18..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-1.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - -0 -2 -4 -6 -8 -( -1 -/ -2 -) - -* - -Normal -(0, 1) - -+ - -( -1 -/ -2 -) - -* - -Spike -(0) -(mu) x_cont -Density - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-2.svg deleted file mode 100644 index db528a5..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-2.svg +++ /dev/null @@ -1,206 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -( -1 -/ -2 -) - -* - -Normal -(0, 1) - -+ - -( -1 -/ -2 -) - -* - -Spike -(0) -Lag -Autocorrelation((mu) x_cont) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-3.svg deleted file mode 100644 index 3ef7de3..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-3.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -( -1 -/ -2 -) - -* - -Normal -(0, 1) - -+ - -( -1 -/ -2 -) - -* - -Spike -(0) -Iteration -(mu) x_cont - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-4.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-4.svg deleted file mode 100644 index 4c3c915..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-4.svg +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -( -1 -/ -2 -) - -* - -mean difference contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -mean difference contrast: -mNormal -(0, 0.3) -(mu) x_fac3t[2] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-5.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-5.svg deleted file mode 100644 index 18b6238..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-5.svg +++ /dev/null @@ -1,212 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -( -1 -/ -2 -) - -* - -mean difference contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -mean difference contrast: -mNormal -(0, 0.3) -Lag -Autocorrelation((mu) x_fac3t[2]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-6.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-6.svg deleted file mode 100644 index 45c097d..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-mixture-6.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -( -1 -/ -2 -) - -* - -mean difference contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -mean difference contrast: -mNormal -(0, 0.3) -Iteration -(mu) x_fac3t[2] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-1.svg deleted file mode 100644 index c965da0..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-1.svg +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - -0 -2 -4 -6 -8 -Normal -(0, 1) - -* - -Beta -(1, 1) -(mu) x_cont -Density - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-2.svg deleted file mode 100644 index 0409b8e..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-2.svg +++ /dev/null @@ -1,190 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Normal -(0, 1) - -* - -Beta -(1, 1) -Lag -Autocorrelation((mu) x_cont) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-3.svg deleted file mode 100644 index 436898a..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-spike-and-slab-3.svg +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -Normal -(0, 1) - -* - -Beta -(1, 1) -Iteration -(mu) x_cont - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-1.svg deleted file mode 100644 index 7293d88..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-1.svg +++ /dev/null @@ -1,63 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - - -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -Normal -(0, 1) -Iteration -x_cont1 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-2.svg deleted file mode 100644 index e25af2d..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-2.svg +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - -1.2 -1.4 -1.6 -1.8 -2.0 -Normal -(0, 1) -Iteration -x_cont1 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-3.svg deleted file mode 100644 index 06156a7..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-3.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -Treatment -Values -Smth - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-4.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-4.svg deleted file mode 100644 index b0b3ea7..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-4.svg +++ /dev/null @@ -1,116 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Iteration -x_fac3o[1] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Iteration -x_fac3o[2] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-5.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-5.svg deleted file mode 100644 index 13e18b2..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-5.svg +++ /dev/null @@ -1,161 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Iteration -(mu) x_fac3o [dif: A] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --0.4 --0.2 -0.0 -0.2 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Iteration -(mu) x_fac3o [dif: B] - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -Iteration -(mu) x_fac3o [dif: C] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-6.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-6.svg deleted file mode 100644 index c2a0c7f..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-6.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - -0 -1 -2 -3 -4 -PET ~ -Gamma -(2, 2) -Iteration -PET - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-7.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-7.svg deleted file mode 100644 index fe50dd9..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-7.svg +++ /dev/null @@ -1,134 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -Iteration -omega[0.05,0.1] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -ω -one-sided: -.1, .05 - -~ - -CumDirichlet -( -1, 1, 1 -) -Iteration -omega[0.1,1] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-8.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-8.svg deleted file mode 100644 index c84c4ab..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics-plot-trace-8.svg +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --2 --1 -0 -1 - - - - - - - -independent contrast: -Normal -(0, 0.5) -Iteration -fac2i[1] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - --2 --1 -0 -1 -2 - - - - - - - -independent contrast: -Normal -(0, 0.5) -Iteration -fac2i[2] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-1.svg deleted file mode 100644 index 01b55ec..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-1.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -(mu) x_fac2i[A] -Density -independent contrast: -Normal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-2.svg deleted file mode 100644 index 638aebe..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-1-2.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -(mu) x_fac2i[B] -Density -independent contrast: -Normal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-1.svg deleted file mode 100644 index 855e7fd..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-1.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -(mu) x_fac3md [dif: A] -Density -mean difference contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-2.svg deleted file mode 100644 index b087577..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-2.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -(mu) x_fac3md [dif: B] -Density -mean difference contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-3.svg deleted file mode 100644 index cb0c946..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-ggplot-density-2-3.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -(mu) x_fac3md [dif: C] -Density -mean difference contrast: -mNormal -(0, 1) - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-1.svg deleted file mode 100644 index 235d4a2..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-1.svg +++ /dev/null @@ -1,368 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -independent contrast: -Normal -(0, 1) -Lag -Autocorrelation((mu) x_fac2i[A]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -independent contrast: -Normal -(0, 1) -Lag -Autocorrelation((mu) x_fac2i[B]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-2.svg deleted file mode 100644 index 1531c90..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-autocorrelation-2.svg +++ /dev/null @@ -1,543 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3md [dif: A]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3md [dif: B]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 -20 -25 -30 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Lag -Autocorrelation(x_fac3md [dif: C]) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-1.svg deleted file mode 100644 index 9a73e7b..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-1.svg +++ /dev/null @@ -1,112 +0,0 @@ - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -independent contrast: -Normal -(0, 1) -(mu) x_fac2i[A] -Density - - - - - - - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -independent contrast: -Normal -(0, 1) -(mu) x_fac2i[B] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-2.svg deleted file mode 100644 index f120531..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-2.svg +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -(mu) x_fac3md[1] -Density - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -(mu) x_fac3md[2] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-3.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-3.svg deleted file mode 100644 index e3afae4..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-density-3.svg +++ /dev/null @@ -1,163 +0,0 @@ - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -x_fac3md [dif: A] -Density - - - - - - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -x_fac3md [dif: B] -Density - - - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -x_fac3md [dif: C] -Density - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-1.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-1.svg deleted file mode 100644 index 3f8d54a..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-1.svg +++ /dev/null @@ -1,112 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - - -independent contrast: -Normal -(0, 1) -Iteration -(mu) x_fac2i[A] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - - -independent contrast: -Normal -(0, 1) -Iteration -(mu) x_fac2i[B] - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-2.svg b/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-2.svg deleted file mode 100644 index ea2c684..0000000 --- a/tests/testthat/_snaps/JAGS-diagnostics/diagnostics3-plot-trace-2.svg +++ /dev/null @@ -1,163 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - --0.4 --0.2 -0.0 -0.2 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Iteration -x_fac3md [dif: A] - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Iteration -x_fac3md [dif: B] - - - - - - - - - - - - - - - - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -mean difference contrast: -mNormal -(0, 1) -Iteration -x_fac3md [dif: C] - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-1.svg similarity index 87% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-1.svg index b8e1442..f79478b 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-1.svg @@ -54,8 +54,8 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-2.svg similarity index 64% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-2.svg index 647b681..feef73a 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-2.svg @@ -49,8 +49,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-5.svg new file mode 100644 index 0000000..79d60d6 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-5.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 +0.10 +0.12 +PET-PEESE (1/2x) +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-6.svg new file mode 100644 index 0000000..89cb0e1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-6.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-7.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-7.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-7.svg diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-8.svg new file mode 100644 index 0000000..a0d6c2a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-8.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 +0.10 +0.12 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-9.svg similarity index 66% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-9.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-9.svg index a82d6a8..d4402dd 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-9.svg @@ -56,9 +56,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-1.svg new file mode 100644 index 0000000..b817ddc --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-1.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + +μ +Density + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-2.svg new file mode 100644 index 0000000..e9b4c43 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-2.svg @@ -0,0 +1,100 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 +0.3 +Density +Probability + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-3.svg new file mode 100644 index 0000000..9f08339 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-3.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-4.svg new file mode 100644 index 0000000..afd9cec --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-4.svg @@ -0,0 +1,89 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Density + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-5.svg new file mode 100644 index 0000000..0ec1397 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-5.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + +1.0 +1.2 +1.4 +1.6 +1.8 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-6.svg new file mode 100644 index 0000000..fa46800 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-6.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-7.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-7.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-7.svg diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-8.svg new file mode 100644 index 0000000..57fae89 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-simple-8.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + +5 +10 +15 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-1.svg similarity index 97% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-1.svg index f0a6058..b655557 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-1.svg @@ -50,7 +50,7 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-10.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-10.svg similarity index 95% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-10.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-10.svg index 158dfb2..212ae66 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-10.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-10.svg @@ -51,7 +51,7 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-2.svg similarity index 98% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-2.svg index d7b5e67..66ab4b1 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-2.svg @@ -50,7 +50,7 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-3.svg similarity index 97% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-3.svg index c4989f4..9b884a7 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-3.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-3.svg @@ -52,7 +52,7 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-4.svg similarity index 98% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-4.svg index afae748..20280c6 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-4.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-4.svg @@ -46,7 +46,7 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-6.svg similarity index 97% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-6.svg index 8e33b8f..3df19ae 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-6.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-6.svg @@ -52,6 +52,6 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-7.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-7.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-7.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-8.svg similarity index 97% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-8.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-8.svg index a7cc90c..fc268e9 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-8.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-8.svg @@ -54,6 +54,6 @@ - + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-9.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-wf-9.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-wf-9.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-independent-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-independent-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-5.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-5.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-5.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-meandif-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-meandif-6.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-5.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-5.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-5.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-orthonormal-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-orthonormal-6.svg diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg new file mode 100644 index 0000000..4c16580 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-10.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-10.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-10.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-10.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg similarity index 55% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-11.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg index 24abcec..7ed62ca 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-11.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg @@ -54,9 +54,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-12.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-12.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-12.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-12.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg similarity index 82% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg index edc5d47..2d78ed7 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg @@ -49,8 +49,8 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-4.svg diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg new file mode 100644 index 0000000..5891bbd --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-6.svg diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg new file mode 100644 index 0000000..1e2739b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-8.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-8.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-8.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg similarity index 58% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-9.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg index b813203..b4eaea2 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg @@ -31,17 +31,17 @@ 0.6 0.8 1.0 - + - - - - + + + + 0.0 -0.5 -1.0 -1.5 -2.0 +0.5 +1.0 +1.5 +2.0 main xlab ylab @@ -52,7 +52,7 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-10.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-10.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-10.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-10.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-11.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-11.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-11.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-12.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-12.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-12.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-12.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-13.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-13.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-13.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-13.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-5.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-5.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-5.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-6.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-7.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-7.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-7.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-8.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-8.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-8.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-9.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-simple-9.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-simple-9.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-1.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-1.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-5.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-5.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-5.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-treatment-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-treatment-6.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg similarity index 93% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg index 132afac..24c01eb 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-10.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-10.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-10.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-10.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg similarity index 89% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-11.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg index 6a17b71..b39f79c 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-11.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg @@ -49,9 +49,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-12.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-12.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-12.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-12.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg similarity index 96% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-2.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg index e95b9c5..7549e37 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg @@ -49,8 +49,8 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-3.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-3.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-4.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-4.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-4.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-4.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg similarity index 93% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-5.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg index 4b62c3f..5e0787c 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-5.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-6.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-6.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-6.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-6.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg similarity index 88% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-7.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg index 1b4075d..6843601 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-7.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg @@ -53,9 +53,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-8.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-8.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-8.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-8.svg diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg similarity index 92% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-9.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg index c1f226c..0903d40 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-wf-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg @@ -50,7 +50,7 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg new file mode 100644 index 0000000..bc53fe8 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept-con.svg new file mode 100644 index 0000000..3233094 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept-con.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept.svg new file mode 100644 index 0000000..888187a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-intercept.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg similarity index 59% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg index 9d8b13a..3630e59 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.new.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg @@ -43,15 +43,19 @@ 0.6 0.8 1.0 - + - - - + + + + + 0 -5000 -10000 -15000 +100 +200 +300 +400 +500 @@ -92,69 +96,71 @@ 0.6 0.8 1.0 - + - - - - - + + + + + + + 0 -2000 -4000 -6000 -8000 +50 +100 +200 +300 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -188,69 +194,71 @@ 0.6 0.8 1.0 - + - - - - - + + + + + + + 0 -2000 -4000 -6000 -8000 +50 +100 +200 +300 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -284,17 +292,17 @@ 0.6 0.8 1.0 - + - - - - + + + + 0 -2000 -4000 -6000 -8000 +50 +100 +150 +200 @@ -330,68 +338,68 @@ 0.6 0.8 1.0 - + - - - - - + + + + 0 -500 -1000 -2000 +20 +40 +60 +80 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -425,70 +433,68 @@ 0.6 0.8 1.0 - + - - - - - + + + + 0 -500 -1000 -1500 -2000 -2500 +20 +40 +60 +80 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -522,19 +528,15 @@ 0.6 0.8 1.0 - + - - - - - + + + 0 -1000 -2000 -3000 -4000 -5000 +50 +100 +150 @@ -570,67 +572,75 @@ 0.6 0.8 1.0 - + - - - + + + + + + + 0 -50 -100 -150 +1 +2 +3 +4 +5 +6 +7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + @@ -663,66 +673,68 @@ 0.6 0.8 1.0 - + - - - + + + + 0 -50 -100 -150 +2 +4 +6 +8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg new file mode 100644 index 0000000..d5fea4c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg @@ -0,0 +1,310 @@ + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + +0 +100 +200 +300 +400 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PET +PET +Frequency + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-sigma.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-sigma.svg new file mode 100644 index 0000000..25d582e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-sigma.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + +0 +2 +4 +6 +8 +10 +12 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg similarity index 87% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg index a15f000..8a22f8b 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg @@ -51,9 +51,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg similarity index 90% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg index e980dd6..19398e7 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg @@ -51,9 +51,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg new file mode 100644 index 0000000..5efebd3 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1.svg similarity index 59% rename from tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.svg rename to tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1.svg index 42ec34f..2748a00 100644 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-cont1.svg @@ -71,8 +71,6 @@ - - - + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg new file mode 100644 index 0000000..ae9ada7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + +-1 +0 +1 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + + + + A + B + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t.svg new file mode 100644 index 0000000..a86ccf2 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac2t.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + +Density + + + + +-1 +0 +1 + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + + + A + B + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg new file mode 100644 index 0000000..f34bdf7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t.svg new file mode 100644 index 0000000..f42f0ff --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-x-fac3t.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + +Density + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-intercept.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-intercept.svg new file mode 100644 index 0000000..0cf4232 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-intercept.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +-2.0 +-1.5 +-1.0 +-0.5 +0.0 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-sigma.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-sigma.svg new file mode 100644 index 0000000..33a3c84 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-sigma.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + +0 +2 +4 +6 +8 +10 +12 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg new file mode 100644 index 0000000..bab1f8e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg new file mode 100644 index 0000000..8521c55 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + +-1 +0 +1 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + + + + A + B + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg new file mode 100644 index 0000000..559a2cd --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-1.svg deleted file mode 100644 index 5995baf..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-1.svg +++ /dev/null @@ -1,284 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -posterior1[, "mu_intercept"] -Density - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 -posterior1[, "mu_x_cont1"] -Density - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3t -posterior1[, "mu_x_fac3t[1]"] -Density - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3t -posterior1[, "mu_x_fac3t[2]"] -Density - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-2.svg deleted file mode 100644 index bf105d8..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-2.svg +++ /dev/null @@ -1,396 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -posterior2[, "mu_intercept"] -Density - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 -posterior2[, "mu_x_cont1"] -Density - - - - - - - - - - - -0.25 -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3t -posterior2[, "mu_x_fac3t[1]"] -Density - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3t -posterior2[, "mu_x_fac3t[2]"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma_intercept -exp(posterior2[, "sigma_intercept"]) -Density - - - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma_x_fac2t -exp(posterior2[, "sigma_intercept"] + posterior2[, "sigma_x_fac2t"]) -Density - - - - - - - - - -0.8 -0.9 -1.0 -1.1 -1.2 -1.3 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-1.svg deleted file mode 100644 index ae212c0..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-1.svg +++ /dev/null @@ -1,297 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 - - -Intercept indicator - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - -1 -2 - - -x_cont1 indicator - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - -1 -2 - - -sigma indicator - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - -mu_intercept -posterior1[, "mu_intercept"] -Density - - - - - - - --0.3 --0.2 --0.1 -0.0 - - - - - - -0 -5 -10 -15 -20 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 -posterior1[, "mu_x_cont1"] -Density - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma -posterior1[, "sigma"] -Density - - - - - - - - - -0.70 -0.75 -0.80 -0.85 -0.90 -0.95 - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-2.svg deleted file mode 100644 index 6551090..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-mixture-2.svg +++ /dev/null @@ -1,362 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_fac3t[A] -temp_samples[, 1] -Density - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[B] -temp_samples[, 2] -Density - - - - - - - - - - --0.5 --0.4 --0.3 --0.2 --0.1 -0.0 -0.1 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[C] -temp_samples[, 3] -Density - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[A] -temp_samples_variable[, 1] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[B] -temp_samples_variable[, 2] -Density - - - - - - - - --2 --1 -0 -1 -2 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[C] -temp_samples_variable[, 3] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-1.svg deleted file mode 100644 index 3284ec0..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-1.svg +++ /dev/null @@ -1,196 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_cont1 -posterior1[, "mu_x_cont1"] -Density - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1_variable -posterior1[, "mu_x_cont1_variable"] -Density - - - - - - - - - - --4 --3 --2 --1 -0 -1 -2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1_inclusion -posterior1[, "mu_x_cont1_inclusion"] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-2.svg deleted file mode 100644 index bf82515..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-formula-spike-and-slab-2.svg +++ /dev/null @@ -1,378 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_fac3t[A] -temp_samples[, 1] -Density - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[B] -temp_samples[, 2] -Density - - - - - - - - - - --0.6 --0.5 --0.4 --0.3 --0.2 --0.1 -0.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[C] -temp_samples[, 3] -Density - - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[A] -temp_samples_variable[, 1] -Density - - - - - - - - - --2 --1 -0 -1 -2 -3 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[B] -temp_samples_variable[, 2] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t_variable[C] -temp_samples_variable[, 3] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-fit-posterior.svg b/tests/testthat/_snaps/JAGS-fit/jags-fit-posterior.svg deleted file mode 100644 index 233b404..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-fit-posterior.svg +++ /dev/null @@ -1,246 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, i] -samples[, i] -Density - - - - - - - - - --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, i] -samples[, i] -Density - - - - - - - - - - - -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 -0.65 - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-1.svg deleted file mode 100644 index 323b00a..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-1.svg +++ /dev/null @@ -1,104 +0,0 @@ - - - - - - - - - - - - -Normal -(0, 1) -samples[, names(priors)[i]] -Density - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-10.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-10.svg deleted file mode 100644 index 663ce55..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-10.svg +++ /dev/null @@ -1,98 +0,0 @@ - - - - - - - - - - - - -Uniform -(1, 5) -samples[, names(priors)[i]] -Density - - - - - - -1 -2 -3 -4 -5 - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -0.25 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-11.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-11.svg deleted file mode 100644 index 5ddfc7d..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-11.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - -Spike -(1) -samples[, names(priors)[i]] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-12.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-12.svg deleted file mode 100644 index 78f12c6..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-12.svg +++ /dev/null @@ -1,101 +0,0 @@ - - - - - - - - - - - - -PET ~ -Normal -(0, 1) -[ -0 -, -∞ -] -samples[, names(priors)[i]] -Density - - - - - - -0 -1 -2 -3 -4 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-13.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-13.svg deleted file mode 100644 index 69552f1..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-13.svg +++ /dev/null @@ -1,102 +0,0 @@ - - - - - - - - - - - - -PEESE ~ -Gamma -(1, 1) -samples[, names(priors)[i]] -Density - - - - - - -0 -2 -4 -6 -8 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-14.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-14.svg deleted file mode 100644 index 608a2e4..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-14.svg +++ /dev/null @@ -1,56 +0,0 @@ - - - - - - - - - - - - - - -0 -1 -Bernoulli -(0.75) - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-2.svg deleted file mode 100644 index 3d8ef7d..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-2.svg +++ /dev/null @@ -1,102 +0,0 @@ - - - - - - - - - - - - -Normal -(0, 1) -[ -1 -, -∞ -] -samples[, names(priors)[i]] -Density - - - - - -1 -2 -3 -4 - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-3.svg deleted file mode 100644 index 28f6b49..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-3.svg +++ /dev/null @@ -1,116 +0,0 @@ - - - - - - - - - - - - -Lognormal -(0, 0.5) -samples[, names(priors)[i]] -Density - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-4.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-4.svg deleted file mode 100644 index 09e1233..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-4.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - -Student-t -(0, 0.5, 5) -samples[, names(priors)[i]] -Density - - - - - --5 -0 -5 -10 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-5.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-5.svg deleted file mode 100644 index e6704fa..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-5.svg +++ /dev/null @@ -1,109 +0,0 @@ - - - - - - - - - - - - -Cauchy -(1, 0.1) -[-10, 0] -samples[, names(priors)[i]] -Density - - - - - - - --10 --8 --6 --4 --2 -0 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-6.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-6.svg deleted file mode 100644 index e594b95..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-6.svg +++ /dev/null @@ -1,121 +0,0 @@ - - - - - - - - - - - - -Gamma -(2, 1) -samples[, names(priors)[i]] -Density - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-7.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-7.svg deleted file mode 100644 index 53a68b0..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-7.svg +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - - - - - - -InvGamma -(3, 2) -[1, 3] -samples[, names(priors)[i]] -Density - - - - - - -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-8.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-8.svg deleted file mode 100644 index 482d9e4..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-8.svg +++ /dev/null @@ -1,129 +0,0 @@ - - - - - - - - - - - - -Exponential -(1.5) -samples[, names(priors)[i]] -Density - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-9.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-9.svg deleted file mode 100644 index 27d98d2..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-9.svg +++ /dev/null @@ -1,105 +0,0 @@ - - - - - - - - - - - - -Beta -(3, 2) -samples[, names(priors)[i]] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e1.svg deleted file mode 100644 index eed71a2..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e1.svg +++ /dev/null @@ -1,94 +0,0 @@ - - - - - - - - - - - - -Normal -(0, x_sigma) -x_samples[abs(x_samples) < 10] -Density - - - - - - --10 --5 -0 -5 -10 - - - - - -0.0 -0.1 -0.2 -0.3 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e2.svg deleted file mode 100644 index d4b1e92..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e2.svg +++ /dev/null @@ -1,101 +0,0 @@ - - - - - - - - - - - - -Normal -(0, x_sigma) - -* - -Spike -(0.5) -x_samples[abs(x_samples) < 10] -Density - - - - - - --10 --5 -0 -5 -10 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e3.svg deleted file mode 100644 index 8db9a15..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-e3.svg +++ /dev/null @@ -1,123 +0,0 @@ - - - - - - - - - - - - -( -1 -/ -2 -) - -* - -Normal -(0, x_sigma) - -+ - -( -1 -/ -2 -) - -* - -Cauchy -(0, 1) -x_samples[abs(x_samples) < 10] -Density - - - - - - --10 --5 -0 -5 -10 - - - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 -0.35 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-1.svg deleted file mode 100644 index 7114a45..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-1.svg +++ /dev/null @@ -1,10152 +0,0 @@ - - - - - - - - - - - - - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -samples[, "p1[1]"] -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - --4 --2 -0 -2 -4 - - - - - - - - -orthonormal contrast: -mNormal -(0, 1) -X1 -X2 - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-10.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-10.svg deleted file mode 100644 index 9c334a2..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-10.svg +++ /dev/null @@ -1,124 +0,0 @@ - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p10[1]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p10[2]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-2.svg deleted file mode 100644 index 76b2b7b..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-2.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - -treatment contrast: -Beta -(1, 1) -samples[, "p2"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-3.svg deleted file mode 100644 index a1cf82a..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-3.svg +++ /dev/null @@ -1,10158 +0,0 @@ - - - - - - - - - - - - - - - - - - - -treatment contrast: -Beta -(2, 2) -samples[, "p3[1]"] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - -0.0 -0.5 -1.0 - - - - - - - - -treatment contrast: -Beta -(2, 2) -X1 -X2 - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-4.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-4.svg deleted file mode 100644 index 7f011aa..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-4.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - -independent contrast: -Gamma -(2, 3) -samples[, "p4"] -Density - - - - - - -0 -1 -2 -3 -4 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-5.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-5.svg deleted file mode 100644 index 63784fd..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-5.svg +++ /dev/null @@ -1,288 +0,0 @@ - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p5[1]"] -Density - - - - - - - - --0.5 -0.0 -0.5 -1.0 -1.5 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p5[2]"] -Density - - - - - - - - --0.5 -0.0 -0.5 -1.0 -1.5 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p5[3]"] -Density - - - - - - - - --0.5 -0.0 -0.5 -1.0 -1.5 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-6.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-6.svg deleted file mode 100644 index f60de5a..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-6.svg +++ /dev/null @@ -1,187 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mean difference contrast: -mNormal -(0, 0.5) -samples[, "p6[1]"] -Density - - - - - - - --1 -0 -1 -2 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mean difference contrast: -mNormal -(0, 0.5) -samples[, "p6[2]"] -Density - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-7.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-7.svg deleted file mode 100644 index 3d8c796..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-7.svg +++ /dev/null @@ -1,63 +0,0 @@ - - - - - - - - - - - - -treatment contrast: -Spike -(1) -samples[, "p7"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-8.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-8.svg deleted file mode 100644 index 0a6334d..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-8.svg +++ /dev/null @@ -1,170 +0,0 @@ - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p8[1]"] -Density - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p8[2]"] -Density - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p8[3]"] -Density - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-9.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-9.svg deleted file mode 100644 index c0b3320..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-factor-9.svg +++ /dev/null @@ -1,124 +0,0 @@ - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p9[1]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - - - -independent contrast: -Uniform -(-0.5, 1.5) -samples[, "p9[2]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-1.svg deleted file mode 100644 index e5833c9..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-1.svg +++ /dev/null @@ -1,201 +0,0 @@ - - - - - - - - - - - - -( -1 -/ -7 -) - -* - -Normal -(0, 1) - -+ - -( -5 -/ -7 -) - -* - -Normal -(-3, 1) - -+ - -( -1 -/ -7 -) - -* - -Gamma -(5, 10) -temp_samples -Density - - - - - - --6 --4 --2 -0 -2 - - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-2.svg deleted file mode 100644 index 642e2db..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-2.svg +++ /dev/null @@ -1,181 +0,0 @@ - - - - - - - - - - - - -( -1 -/ -6 -) - -* - -Normal -(0, 1) - -+ - -( -5 -/ -6 -) - -* - -Normal -(-3, 1) -temp_samples -Density - - - - - - --6 --4 --2 -0 -2 - - - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 -0.35 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-3.svg deleted file mode 100644 index 6b4a510..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-3.svg +++ /dev/null @@ -1,169 +0,0 @@ - - - - - - - - - - - - -( -1 -/ -2 -) - -* - -Spike -(2) - -+ - -( -1 -/ -2 -) - -* - -Normal -(-3, 1) -temp_samples -Density - - - - - - --6 --4 --2 -0 -2 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-4.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-4.svg deleted file mode 100644 index 85e5195..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-mixture-4.svg +++ /dev/null @@ -1,711 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 - - -Bias componenets - - - - - - - - - -0.00 -0.10 -0.20 - - - - - - - - - - - - - - -PET -samples_PET[samples_PET != 0 & samples_PET < 10] -Density - - - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -PEESE -samples_PEESE[samples_PEESE != 0 & samples_PEESE < 20] -Density - - - - - - - - -0 -5 -10 -15 -20 - - - - - -0.00 -0.05 -0.10 -0.15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[2:1] -samples_omega[samples_bias == 2, 1] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - -omega[2:2] -samples_omega[samples_bias == 2, 2] -Density - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[2:3] -samples_omega[samples_bias == 2, 3] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[2:4] -samples_omega[samples_bias == 2, 4] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[2:5] -samples_omega[samples_bias == 2, 5] -Density - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[2:6] -samples_omega[samples_bias == 2, 6] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-1.svg deleted file mode 100644 index 1963214..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-1.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - -Normal -(0, 1) - -* - -Beta -(1, 1) -temp_samples[temp_samples != 0] -Density - - - - - - --4 --2 -0 -2 -4 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-2.svg deleted file mode 100644 index 1524108..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-spike-and-slab-2.svg +++ /dev/null @@ -1,382 +0,0 @@ - - - - - - - - - - - - - - - - - - - -orthonormal contrast: -mNormal -(0, 1) - -* - -Beta -(1, 1) -temp_samples[temp_samples[, 1] != 0, 1] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -orthonormal contrast: -mNormal -(0, 1) - -* - -Beta -(1, 1) -temp_samples[temp_samples[, 2] != 0, 2] -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -orthonormal contrast: -mNormal -(0, 1) - -* - -Beta -(1, 1) -temp_samples[temp_samples[, 3] != 0, 3] -Density - - - - - - - - - --2 --1 -0 -1 -2 -3 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-1.svg deleted file mode 100644 index 9ded896..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-1.svg +++ /dev/null @@ -1,10152 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mNormal -(0, 1) -samples[, "p1[1]"] -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - --4 --2 -0 -2 -4 - - - - - - - - -mNormal -(0, 1) -X1 -X2 - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-2.svg deleted file mode 100644 index af219bd..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-2.svg +++ /dev/null @@ -1,10022 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mCauchy -(0, 1.5) -samples[, "p2[1]"][abs(samples[, "p2[1]"]) < 5] -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -0.25 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --4 --2 -0 -2 -4 - - - - --5 -0 -5 - - - - - - - - -mCauchy -(0, 1.5) -X1 -X2 - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-3.svg deleted file mode 100644 index b1f3239..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-prior-vector-3.svg +++ /dev/null @@ -1,10160 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mStudent-t -(2, 0.5, 5) -samples[, "p3[1]"] -Density - - - - - - - - - --4 --2 -0 -2 -4 -6 - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 -0 -2 -4 -6 - - - - - --5 -0 -5 -10 - - - - - - - - -mStudent-t -(2, 0.5, 5) -X1 -X2 - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-1.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-1.svg deleted file mode 100644 index 9806b7b..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-1.svg +++ /dev/null @@ -1,168 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-2.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-2.svg deleted file mode 100644 index 47b0f1f..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-2.svg +++ /dev/null @@ -1,245 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-3.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-3.svg deleted file mode 100644 index d7a567a..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-3.svg +++ /dev/null @@ -1,286 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - -0 -5 -10 -15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-4.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-4.svg deleted file mode 100644 index 9806b7b..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-4.svg +++ /dev/null @@ -1,168 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-5.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-5.svg deleted file mode 100644 index 937bb34..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-5.svg +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-6.svg b/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-6.svg deleted file mode 100644 index 76a256b..0000000 --- a/tests/testthat/_snaps/JAGS-fit/jags-model-weightfunction-6.svg +++ /dev/null @@ -1,160 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - -Histogram of samples[, paste0("omega[", j, "]")] -samples[, paste0("omega[", j, "]")] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1.svg deleted file mode 100644 index aedb81a..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1.svg +++ /dev/null @@ -1,202 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_1[, "mu_intercept"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 -samples_1[, "mu_x_cont1"] -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma -samples_1[, "sigma"] -Density - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-10.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-10.svg deleted file mode 100644 index 7523e21..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-10.svg +++ /dev/null @@ -1,386 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_10[, "mu_intercept"] -Density - - - - - - - - -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t -samples_10[, "mu_x_fac3t[1]"] -Density - - - - - - - - - - --1.4 --1.2 --1.0 --0.8 --0.6 --0.4 --0.2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t -samples_10[, "mu_x_fac3t[2]"] -Density - - - - - - - --1.5 --1.0 --0.5 -0.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 -samples_10[, "mu_x_cont1"] -Density - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1:x_fac3t -samples_10[, "mu_x_cont1__xXx__x_fac3t[1]"] -Density - - - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1:x_fac3t -samples_10[, "mu_x_cont1__xXx__x_fac3t[2]"] -Density - - - - - - -0.0 -0.5 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-11.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-11.svg deleted file mode 100644 index d06ad53..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-11.svg +++ /dev/null @@ -1,203 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_fac3i[1] -samples_11[, "mu_x_fac3i[1]"] -Density - - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3i[2] -samples_11[, "mu_x_fac3i[2]"] -Density - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3i[3] -samples_11[, "mu_x_fac3i[3]"] -Density - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-12.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-12.svg deleted file mode 100644 index 74bc2b0..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-12.svg +++ /dev/null @@ -1,215 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_12[, "mu_intercept"] -Density - - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3md -samples_12[, "mu_x_fac3md[1]"] -Density - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3md -samples_12[, "mu_x_fac3md[2]"] -Density - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0 -1 -2 -3 - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-13.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-13.svg deleted file mode 100644 index e8bda53..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-13.svg +++ /dev/null @@ -1,164 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_fac3i[1] -samples_13[, "mu_x_fac3i[1]"] -Density - - - - - - - - - -1.0 -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - -x_fac3i[2] -samples_13[, "mu_x_fac3i[2]"] -Density - - - - - - - - - -1.0 -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - -x_fac3i[3] -samples_13[, "mu_x_fac3i[3]"] -Density - - - - - - - - - -1.0 -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-14.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-14.svg deleted file mode 100644 index 75480fb..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-14.svg +++ /dev/null @@ -1,173 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_14[, "mu_intercept"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3md -samples_14[, "mu_x_fac3md[1]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - -x_fac3md -samples_14[, "mu_x_fac3md[2]"] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1s.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1s.svg deleted file mode 100644 index f31c2f7..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-1s.svg +++ /dev/null @@ -1,204 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_1s[, "mu_intercept"] -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -I(sd(y) * x_cont1) -samples_1s[, "mu_x_cont1"] -Density - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma -samples_1s[, "sigma"] -Density - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-2.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-2.svg deleted file mode 100644 index fd99e8c..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-2.svg +++ /dev/null @@ -1,202 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_cont1 -samples_2[, "mu_x_cont1"] -Density - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont2 -samples_2[, "mu_x_cont2"] -Density - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1:x_cont2 -samples_2[, "mu_x_cont1__xXx__x_cont2"] -Density - - - - - - - - - --0.8 --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - -0 -1 -2 -3 - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-3.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-3.svg deleted file mode 100644 index 21a17d8..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-3.svg +++ /dev/null @@ -1,207 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_3[, "mu_intercept"] -Density - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2t -samples_3[, "mu_x_fac2t"] -Density - - - - - - - - - - - --0.8 --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma -samples_3[, "sigma"] -Density - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-4.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-4.svg deleted file mode 100644 index b49f043..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-4.svg +++ /dev/null @@ -1,208 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_4[, "mu_intercept"] -Density - - - - - - - -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2o -samples_4[, "mu_x_fac2o"] -Density - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -sigma -samples_4[, "sigma"] -Density - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-5.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-5.svg deleted file mode 100644 index 4a7c9ef..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-5.svg +++ /dev/null @@ -1,205 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_5[, "mu_intercept"] -Density - - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[1] -samples_5[, "mu_x_fac3t[1]"] -Density - - - - - - - --1.5 --1.0 --0.5 -0.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t[2] -samples_5[, "mu_x_fac3t[2]"] -Density - - - - - - --1.0 --0.5 -0.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-6.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-6.svg deleted file mode 100644 index 6e8e6d9..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-6.svg +++ /dev/null @@ -1,213 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_6[, "mu_intercept"] -Density - - - - - - - - - - - --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_6[, "mu_x_fac3o[1]"] -Density - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_6[, "mu_x_fac3o[2]"] -Density - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-7.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-7.svg deleted file mode 100644 index 3a4f108..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-7.svg +++ /dev/null @@ -1,383 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_7[, "mu_intercept"] -Density - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - -0 -1 -2 -3 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_7[, "mu_x_fac3o[1]"] -Density - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_7[, "mu_x_fac3o[2]"] -Density - - - - - - -0.0 -0.5 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2t -samples_7[, "mu_x_fac2t"] -Density - - - - - - - --1.0 --0.5 -0.0 -0.5 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2t:x_fac3o -samples_7[, "mu_x_fac2t__xXx__x_fac3o[1]"] -Density - - - - - - - --1.0 --0.5 -0.0 -0.5 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2t:x_fac3o -samples_7[, "mu_x_fac2t__xXx__x_fac3o[2]"] -Density - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-8.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-8.svg deleted file mode 100644 index 4375d5c..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-8.svg +++ /dev/null @@ -1,379 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_8[, "mu_intercept"] -Density - - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t -samples_8[, "mu_x_fac3t[1]"] -Density - - - - - - - --1.5 --1.0 --0.5 -0.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3t -samples_8[, "mu_x_fac3t[2]"] -Density - - - - - - - --1.5 --1.0 --0.5 -0.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2o -samples_8[, "mu_x_fac2o"] -Density - - - - - - --0.5 -0.0 -0.5 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2o:fac3t -samples_8[, "mu_x_fac2o__xXx__x_fac3t[1]"] -Density - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac2o:fac3t -samples_8[, "mu_x_fac2o__xXx__x_fac3t[2]"] -Density - - - - - - - --1.0 --0.5 -0.0 -0.5 - - - - - -0.0 -0.5 -1.0 -1.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-9.svg b/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-9.svg deleted file mode 100644 index 734e625..0000000 --- a/tests/testthat/_snaps/JAGS-formula/jags-formula-lm-9.svg +++ /dev/null @@ -1,414 +0,0 @@ - - - - - - - - - - - - - - - - - - - -Intercept -samples_9[, "mu_intercept"] -Density - - - - - - - - - - --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_9[, "mu_x_fac3o[1]"] -Density - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_fac3o -samples_9[, "mu_x_fac3o[2]"] -Density - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 -samples_9[, "mu_x_cont1"] -Density - - - - - - - - - - --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1:x_fac3o -samples_9[, "mu_x_cont1__xXx__x_fac3o[1]"] -Density - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1:x_fac3o -samples_9[, "mu_x_cont1__xXx__x_fac3o[2]"] -Density - - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-cont1.svg new file mode 100644 index 0000000..9b021d3 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-cont1.svg @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + + + + + + + + +-1SD +0SD +1SD + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg new file mode 100644 index 0000000..9e48780 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg @@ -0,0 +1,89 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +Density + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg new file mode 100644 index 0000000..c2ba10a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +fac2t +Density + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg new file mode 100644 index 0000000..f4a8f39 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + +-8 +-6 +-4 +-2 +0 +2 +4 +6 +8 +Density + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg new file mode 100644 index 0000000..2980e9f --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac3md.svg new file mode 100644 index 0000000..493bf4c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-mu-x-fac3md.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Density + + + + + + + + + + + + + + + + +A +B +C + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg new file mode 100644 index 0000000..5e12ae8 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg @@ -0,0 +1,109 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + + + + + + + + +-1SD +0SD +1SD + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg new file mode 100644 index 0000000..f67babe --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +Density + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg new file mode 100644 index 0000000..18303e9 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +fac2t +Density + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg new file mode 100644 index 0000000..aa55270 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + + +-6 +-4 +-2 +0 +2 +4 +6 +Density + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg new file mode 100644 index 0000000..d787055 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg new file mode 100644 index 0000000..eb0c1a1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Density + + + + + + + + + + + + + + + + +A +B +C + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-exp.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-exp.svg new file mode 100644 index 0000000..6649167 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-exp.svg @@ -0,0 +1,217 @@ + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(-1) +marg_post_x_cont1.exp[["-1SD"]] +Density + + + + + + + +1.2 +1.4 +1.6 +1.8 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(0) +marg_post_x_cont1.exp[["0SD"]] +Density + + + + + + + + + + + +1.5 +1.6 +1.7 +1.8 +1.9 +2.0 +2.1 +2.2 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(1) +marg_post_x_cont1.exp[["1SD"]] +Density + + + + + + + + + +1.8 +2.0 +2.2 +2.4 +2.6 +2.8 + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p-exp.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p-exp.svg new file mode 100644 index 0000000..8535811 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p-exp.svg @@ -0,0 +1,403 @@ + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(-1) +attr(marg_post_x_cont1.exp[["-1SD"]], "prior_samples") +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(0) +exp(attr(marg_post_x_cont1[["0SD"]], "prior_samples")) +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(1) +attr(marg_post_x_cont1.exp[["1SD"]], "prior_samples") +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + +0.0 +0.2 +0.4 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p.svg similarity index 61% rename from tests/testthat/_snaps/marginal-distributions/marginal-form-con-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p.svg index 5436182..2a6e13c 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con-p.svg @@ -42,21 +42,21 @@ 0 5 10 - + - - - - - - + + + + + + 0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 @@ -64,86 +64,86 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -175,17 +175,15 @@ 0 5 10 - + - - - - + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 @@ -213,39 +211,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -299,102 +297,102 @@ 0 5 10 - + - - - - - - + + + + + + 0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con.svg new file mode 100644 index 0000000..ac83bf8 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-con.svg @@ -0,0 +1,200 @@ + + + + + + + + + + + + + + + + + + + +marginal posterior x_cont1 +(-1) +marg_post_x_cont1[["-1SD"]] +Density + + + + + + + + +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal posterior x_cont1 +(0) +marg_post_x_cont1[["0SD"]] +Density + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal posterior x_cont1 +(1) +marg_post_x_cont1[["1SD"]] +Density + + + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-at.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-at.svg new file mode 100644 index 0000000..c500975 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-at.svg @@ -0,0 +1,398 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = A | 1,A +marg_post_x_fac3md_AT[["A"]][1, ] +Density + + + + + + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 +1.3 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = A | 1,B +marg_post_x_fac3md_AT[["A"]][2, ] +Density + + + + + + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 +1.3 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = B | 1,A +marg_post_x_fac3md_AT[["B"]][1, ] +Density + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = B | 1,B +marg_post_x_fac3md_AT[["B"]][2, ] +Density + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = C | 1,A +marg_post_x_fac3md_AT[["C"]][1, ] +Density + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 +1.1 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = C | 1,B +marg_post_x_fac3md_AT[["C"]][2, ] +Density + + + + + + + +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-p.svg similarity index 85% rename from tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-p.svg index 2717efd..6ec27ca 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md-p.svg @@ -82,39 +82,39 @@ - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -206,40 +206,40 @@ - - - + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - + - + @@ -330,40 +330,40 @@ - - - - + + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - + - + - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md.svg new file mode 100644 index 0000000..4bc899e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-md.svg @@ -0,0 +1,239 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = A +marg_post_x_fac3md[["A"]] +Density + + + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = B +marg_post_x_fac3md[["B"]] +Density + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = B +marg_post_x_fac3md[["C"]] +Density + + + + + + + +0.4 +0.5 +0.6 +0.7 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi-p.svg similarity index 72% rename from tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi-p.svg index 4e616ae..902b9df 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi-p.svg @@ -60,86 +60,86 @@ - + - - + + - - - - - - - - + + + + + + + + - - + + - - - + + + - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + @@ -187,84 +187,84 @@ - + - - - + + + - - - - - - - - - - - + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + - - + + - + - - - - - + + + + + - + @@ -310,86 +310,86 @@ 0.4 - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - + + + + + + + + + + + @@ -460,39 +460,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + @@ -583,38 +583,38 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -710,35 +710,35 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -813,81 +813,81 @@ - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - - + + + + - - - - - - + + + + + + @@ -935,86 +935,86 @@ 0.4 - + - - - - + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + - + - - - - + + + + @@ -1060,85 +1060,85 @@ 0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - + + + + + + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi.svg new file mode 100644 index 0000000..f40a3be --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-mdi.svg @@ -0,0 +1,620 @@ + + + + + + + + + + + + + + + + + + + +x_cont1 = -1 +marg_post_x_fac3md = A +marg_post_x_cont1__xXx__x_fac3md[["-1SD, A"]] +Density + + + + + + + +0.2 +0.4 +0.6 +0.8 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = -1 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["-1SD, B"]] +Density + + + + + + + +0.0 +0.2 +0.4 +0.6 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = -1 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["-1SD, C"]] +Density + + + + + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 0 +marg_post_x_fac3md = A +marg_post_x_cont1__xXx__x_fac3md[["0SD, A"]] +Density + + + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 0 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["0SD, B"]] +Density + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 0 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["0SD, C"]] +Density + + + + + + + +0.4 +0.5 +0.6 +0.7 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 1 +marg_post_x_fac3md = A +marg_post_x_cont1__xXx__x_fac3md[["1SD, A"]] +Density + + + + + + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 +1.3 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 1 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["1SD, B"]] +Density + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 = 1 +marg_post_x_fac3md = B +marg_post_x_cont1__xXx__x_fac3md[["1SD, C"]] +Density + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 +1.1 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t-p.svg similarity index 83% rename from tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t-p.svg index dc13d15..6351665 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t-p.svg @@ -84,36 +84,36 @@ - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + @@ -200,51 +200,51 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t.svg new file mode 100644 index 0000000..b9391ae --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-fac-t.svg @@ -0,0 +1,146 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = A +marg_post_x_fac2t[["A"]] +Density + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = B +marg_post_x_fac2t[["B"]] +Density + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int-p.svg new file mode 100644 index 0000000..a38afc3 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int-p.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + +marginal prior intercept +attr(marg_post_int[["intercept"]], "prior_samples") +Density + + + + + + +-4 +-2 +0 +2 +4 + + + + + +0.0 +0.1 +0.2 +0.3 + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int.svg new file mode 100644 index 0000000..821faeb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-form-int.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + +marginal posterior intercept +marg_post_int[["intercept"]] +Density + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont-p.svg new file mode 100644 index 0000000..b1a985c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont-p.svg @@ -0,0 +1,392 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = -1SD +attr(marg_post_x_cont1[["-1SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 0SD +attr(marg_post_x_cont1[["0SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 1SD +attr(marg_post_x_cont1[["1SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont.svg new file mode 100644 index 0000000..9f4b1b9 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-cont.svg @@ -0,0 +1,227 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = -1SD +marg_post_x_cont1[["-1SD"]] +Density + + + + + + + + +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 0SD +marg_post_x_cont1[["0SD"]] +Density + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = +1SD +marg_post_x_cont1[["1SD"]] +Density + + + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md-p.svg similarity index 53% rename from tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md-p.svg index f928ba8..9776f21 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md-p.svg @@ -84,38 +84,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + @@ -139,7 +139,7 @@ - + @@ -208,38 +208,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -263,7 +263,7 @@ - + @@ -333,37 +333,37 @@ - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + @@ -387,6 +387,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md.svg new file mode 100644 index 0000000..180e767 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-fac-md.svg @@ -0,0 +1,239 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = A +marg_post_x_fac3md[["A"]] +Density + + + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = B +marg_post_x_fac3md[["B"]] +Density + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = B +marg_post_x_fac3md[["C"]] +Density + + + + + + + +0.4 +0.5 +0.6 +0.7 + + + + + + +0 +2 +4 +6 +8 + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg new file mode 100644 index 0000000..1d553fe --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg @@ -0,0 +1,392 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = -1SD +attr(marg_post_x_cont1[["-1SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 0SD +attr(marg_post_x_cont1[["0SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 1SD +attr(marg_post_x_cont1[["1SD"]], "prior_samples") +Density + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont.svg new file mode 100644 index 0000000..fc01536 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont.svg @@ -0,0 +1,227 @@ + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = -1SD +marg_post_x_cont1[["-1SD"]] +Density + + + + + + + + +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = 0SD +marg_post_x_cont1[["0SD"]] +Density + + + + + + + + +0.50 +0.55 +0.60 +0.65 +0.70 + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mu_x_cont1 = +1SD +marg_post_x_cont1[["1SD"]] +Density + + + + + + + + + + +0.65 +0.70 +0.75 +0.80 +0.85 +0.90 +0.95 + + + + + +0 +2 +4 +6 + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg similarity index 53% rename from tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg index b9ef91d..3eea383 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg @@ -82,40 +82,40 @@ - + - - - - - - - - - - - - - - + + + + + + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - + + + - + @@ -139,7 +139,7 @@ - + @@ -206,39 +206,39 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -263,7 +263,7 @@ - + @@ -330,38 +330,38 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -387,6 +387,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md.svg new file mode 100644 index 0000000..d8b62a9 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md.svg @@ -0,0 +1,225 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = A +marg_post_x_fac3md[["A"]] +Density + + + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = B +marg_post_x_fac3md[["B"]] +Density + + + + + + + +0.4 +0.5 +0.6 +0.7 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac3md = C +marg_post_x_fac3md[["C"]] +Density + + + + + + + +0.4 +0.5 +0.6 +0.7 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-prior-ind.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg similarity index 100% rename from tests/testthat/_snaps/marginal-distributions/marginal-prior-ind.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-prior-trt.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg similarity index 100% rename from tests/testthat/_snaps/marginal-distributions/marginal-prior-trt.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-prior-weightfunction.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg similarity index 100% rename from tests/testthat/_snaps/marginal-distributions/marginal-prior-weightfunction.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con-p.svg new file mode 100644 index 0000000..07feb8b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con-p.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + +marginal prior sigma +attr(marg_post_sigma, "prior_samples") +Density + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + +0.0 +0.2 +0.4 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con.svg new file mode 100644 index 0000000..6bded04 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-con.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + +marginal posterior sigma +marg_post_sigma +Density + + + + + +0.45 +0.50 +0.55 +0.60 + + + + + +0 +5 +10 +15 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac-p.svg similarity index 77% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac-p.svg index ae612df..c48e8b8 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac-p.svg @@ -98,37 +98,37 @@ 1 2 3 - + - - - - - - + + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 - - - - - - + + + + + + - - - - - - - - + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac.svg new file mode 100644 index 0000000..cffb520 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-simple-fac.svg @@ -0,0 +1,138 @@ + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = A +marg_post_simple_x_fac2t[["A"]] +Density + + + + + + + + + +-1.0 +-0.8 +-0.6 +-0.4 +-0.2 +0.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + + + + + + + + + + +marg_post_x_fac2t = B +marg_post_simple_x_fac2t[["B"]] +Density + + + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + + +0 +5 +10 +15 +20 +25 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-cond-fac.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg similarity index 51% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-cond-fac.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg index 6068a76..c4e55fb 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-cond-fac.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg @@ -30,34 +30,30 @@ Density - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - + + + + + + +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - - - + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 @@ -65,17 +61,16 @@ - - - - - - - - - - - + + + + + + + + + + @@ -95,50 +90,43 @@ Density - + - - - + + - - -0.2 -0.3 -0.4 -0.5 + +0.3 +0.4 +0.5 0.6 -0.7 -0.8 - +0.7 + - - - - - - + + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 +6 - - - - - - - - - - - - + + + + + + + + + @@ -171,31 +159,31 @@ 0.6 0.7 0.8 - + - - - - - + + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 - - - - - + + + + + - - - - + + + + @@ -215,49 +203,45 @@ Density - - + + - - - --4 + + + +-4 -2 -0 -2 -4 - +0 +2 +4 + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + @@ -277,48 +261,45 @@ Density - - - - - - --4 --2 -0 -2 -4 - + + + + + + +-4 +-2 +0 +2 +4 + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + @@ -338,47 +319,42 @@ Density - - - - - - --4 --2 -0 -2 -4 - + + + + + +-2 +0 +2 +4 + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-exp.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-exp.svg new file mode 100644 index 0000000..e64f61b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-exp.svg @@ -0,0 +1,207 @@ + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(-1) +marg_post_x_cont1.exp[["-1SD"]] +Density + + + + + + + + + + + +1.2 +1.3 +1.4 +1.5 +1.6 +1.7 +1.8 +1.9 + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(0) +marg_post_x_cont1.exp[["0SD"]] +Density + + + + + + + + + +1.6 +1.7 +1.8 +1.9 +2.0 +2.1 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + +exp marginal posterior x_cont1 +(1) +marg_post_x_cont1.exp[["1SD"]] +Density + + + + + + + +2.0 +2.2 +2.4 +2.6 + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg new file mode 100644 index 0000000..f6fe2a4 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg @@ -0,0 +1,407 @@ + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(-1) +attr(marg_post_x_cont1.exp[["-1SD"]], "prior_samples") +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(0) +exp(attr(marg_post_x_cont1[["0SD"]], "prior_samples")) +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +marginal prior x_cont1 +(1) +attr(marg_post_x_cont1.exp[["1SD"]], "prior_samples") +Density + + + + + + + + +-10 +-5 +0 +5 +10 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg similarity index 65% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg index 389ffce..1ad0421 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg @@ -42,23 +42,23 @@ 0 5 10 - + - - - - - - - + + + + + + + 0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 -0.35 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +0.35 @@ -66,84 +66,84 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -177,17 +177,17 @@ 0 5 10 - + - - - - + + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 +0.4 @@ -214,38 +214,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -321,84 +321,84 @@ - + - + - - - + + + - - - - - - + + + + + + - - - - - - - - - - - + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con.svg similarity index 56% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con.svg index fafdf87..7ecc9be 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con.svg @@ -31,34 +31,32 @@ Density - + - - - - - + + + + 0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - +0.3 +0.4 +0.5 +0.6 + - - - - - - + + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 +6 @@ -66,17 +64,15 @@ - - - - - - - - - - - + + + + + + + + + @@ -97,53 +93,47 @@ Density - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - + + + + + + + +0.50 +0.55 +0.60 +0.65 +0.70 +0.75 + - - - - - + + + + + 0 -2 -4 -6 -8 -10 +2 +4 +6 +8 +10 - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -164,46 +154,41 @@ Density - - - - - - + + + + + -0.6 -0.7 -0.8 -0.9 -1.0 -1.1 - +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - - - + + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 +6 - - - - - - - - - - - + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-at.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-at.svg similarity index 51% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-at.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-at.svg index eac143e..3ed07a7 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-at.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-at.svg @@ -30,34 +30,32 @@ Density - + - - - - - - - + + + + + + 0.6 -0.7 -0.8 -0.9 -1.0 -1.1 -1.2 -1.3 - +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 @@ -65,20 +63,19 @@ - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -98,50 +95,47 @@ Density - + - - - - - - - + + + + + + 0.6 -0.7 -0.8 -0.9 -1.0 -1.1 -1.2 -1.3 - +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -161,43 +155,62 @@ Density - - - - - -0.4 -0.6 -0.8 -1.0 - + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 + - - - - + + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 +5 - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -217,43 +230,62 @@ Density - - - - - -0.4 -0.6 -0.8 -1.0 - + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 + - - - - + + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 +5 - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -273,46 +305,47 @@ Density - + - - - - + + + + + + 0.4 -0.6 -0.8 -1.0 -1.2 - +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 - - - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -332,45 +365,46 @@ Density - + - - - - + + + + + + 0.4 -0.6 -0.8 -1.0 -1.2 - +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 - - - - - - - - - - - - - - - - + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg similarity index 85% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg index 8e7a480..cd7781b 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg @@ -83,38 +83,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -207,37 +207,37 @@ - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -332,36 +332,36 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md.svg similarity index 52% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md.svg index 71b9ce7..bd1a523 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-md.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md.svg @@ -30,32 +30,30 @@ Density - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - - + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 @@ -63,34 +61,32 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -110,48 +106,51 @@ Density - - - - - + + + - - -0.2 -0.3 -0.4 -0.5 + +0.4 +0.5 0.6 -0.7 -0.8 - +0.7 + - - - - - + + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + @@ -171,60 +170,53 @@ Density - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - + + + + + +0.4 +0.5 +0.6 +0.7 + - - - - - - + + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 +6 - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg similarity index 72% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg index 47e7c76..5647463 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg @@ -60,86 +60,86 @@ - + - - - + + + - + - - - - - - - - - - - + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + - + @@ -185,86 +185,86 @@ 0.4 - + - - - - - + + + + + - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + - - + + - - - - - + + + + + - + - + @@ -311,83 +311,83 @@ - - - - - - + + + + + + - - - - - - - + + + + + + + - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - + + + + - - - - + + + + - - + + @@ -460,36 +460,36 @@ - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - + @@ -586,37 +586,37 @@ - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + @@ -708,38 +708,38 @@ - - + + - - - - - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + @@ -810,86 +810,86 @@ 0.4 - - - + + + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - + + @@ -936,85 +936,85 @@ - - - + + + - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + - + @@ -1063,83 +1063,83 @@ - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - + + + + - - - - - + + + + + - - - - - - - - - - + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi.svg similarity index 53% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi.svg index bc6e84c..6c8b227 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-mdi.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi.svg @@ -31,26 +31,26 @@ Density - - - - - -0.2 -0.4 -0.6 -0.8 - + + + + + +0.2 +0.4 +0.6 +0.8 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 @@ -58,24 +58,21 @@ - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + @@ -96,44 +93,62 @@ Density - - - - - -0.0 -0.2 -0.4 -0.6 - + + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + - - - - + + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 +5 - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -154,49 +169,59 @@ Density - - - - - - - - -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - + + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + - - - - - + + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + @@ -217,62 +242,58 @@ Density - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - + + + + + + + +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - - + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -293,48 +314,51 @@ Density - - - - - + + + - - -0.2 -0.3 -0.4 -0.5 + +0.4 +0.5 0.6 -0.7 -0.8 - +0.7 + - - - - - + + + + + 0 -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + @@ -355,61 +379,54 @@ Density - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - + + + + + +0.4 +0.5 +0.6 +0.7 + - - - - - - + + + + + + 0 -1 -2 -3 -4 -5 -6 +1 +2 +3 +4 +5 +6 - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + @@ -430,50 +447,47 @@ Density - + - - - - - - - + + + + + + 0.6 -0.7 -0.8 -0.9 -1.0 -1.1 -1.2 -1.3 - +0.7 +0.8 +0.9 +1.0 +1.1 +1.2 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -494,43 +508,62 @@ Density - - - - - -0.4 -0.6 -0.8 -1.0 - + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 + - - - - + + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 +5 - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -551,45 +584,46 @@ Density - + - - - - + + + + + + 0.4 -0.6 -0.8 -1.0 -1.2 - +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 + - - - - + + + + 0 -1 -2 -3 -4 +1 +2 +3 +4 - - - - - - - - - - - - - - - - + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg similarity index 83% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg index 9d8188f..1a25506 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg @@ -85,36 +85,36 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -201,49 +201,49 @@ - - + + - - - - - - - - - - + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t.svg similarity index 54% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t.svg index ab0a9f5..a78377a 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-fac-t.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t.svg @@ -30,34 +30,32 @@ Density - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - + + + + + + + +0.50 +0.55 +0.60 +0.65 +0.70 +0.75 + - - - - - + + + + + 0 -2 -4 -6 -8 -10 +2 +4 +6 +8 +10 @@ -65,23 +63,19 @@ - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + @@ -101,53 +95,51 @@ Density - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - + + + + + + + + +0.50 +0.55 +0.60 +0.65 +0.70 +0.75 +0.80 + - - - - - + + + + + 0 -2 -4 -6 -8 -10 +2 +4 +6 +8 +10 - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg new file mode 100644 index 0000000..49a76da --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + +marginal prior intercept +attr(marg_post_int[["intercept"]], "prior_samples") +Density + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int.svg similarity index 54% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int.svg index 3861ed0..7f77cfe 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int.svg @@ -21,34 +21,32 @@ marginal posterior intercept marg_post_int[["intercept"]] Density - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - + + + + + + + +0.50 +0.55 +0.60 +0.65 +0.70 +0.75 + - - - - - + + + + + 0 -2 -4 -6 -8 -10 +2 +4 +6 +8 +10 @@ -56,22 +54,18 @@ - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg new file mode 100644 index 0000000..b2fd41b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg @@ -0,0 +1,88 @@ + + + + + + + + + + + + +marginal prior sigma +attr(marg_post_sigma, "prior_samples") +Density + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con.svg new file mode 100644 index 0000000..4b929cc --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + +marginal posterior sigma +marg_post_sigma +Density + + + + + +0.45 +0.50 +0.55 +0.60 + + + + + +0 +5 +10 +15 + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-simple-fac-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg similarity index 69% rename from tests/testthat/_snaps/marginal-distributions/marginal-simple-fac-p.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg index 0bd4541..f1a7552 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-simple-fac-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg @@ -83,51 +83,50 @@ Density - - - - - + + + + + --4 --2 -0 -2 +-4 +-2 +0 +2 4 - + - - - - - - + + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac.svg similarity index 62% rename from tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac.svg rename to tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac.svg index f462523..cb74882 100644 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-fac.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac.svg @@ -83,62 +83,49 @@ Density - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - + + + + + + + + +-0.15 +-0.05 +0.00 +0.05 +0.10 +0.15 + - - - - + + + + 0 -10 -20 -30 -40 +10 +20 +30 +40 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-int.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-int.svg new file mode 100644 index 0000000..7a5f61f --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-int.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Density + + + + +intercept + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-cont1.svg new file mode 100644 index 0000000..e1a5b53 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-cont1.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +2 +4 +6 +8 +Density + + + + + + + + + + + + + +-1SD +0SD +1SD + + + + + + +-1SD +0SD +1SD + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-1.svg new file mode 100644 index 0000000..70bdefc --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-1.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 + + + + + +0 +2 +4 +6 +Density + + + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-2.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-2.svg new file mode 100644 index 0000000..f1bd97f --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-2.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + +0.4 +0.5 +0.6 +0.7 +0.8 + + + + + +0 +2 +4 +6 +fac2t +Density + + + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-3.svg new file mode 100644 index 0000000..6f93780 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-3.svg @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + + +-6 +-4 +-2 +0 +2 +4 +6 + + + + + +0 +2 +4 +6 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-4.svg new file mode 100644 index 0000000..1eee0a1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-4.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +2 +4 +6 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-5.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-5.svg new file mode 100644 index 0000000..ed80be2 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac2t-5.svg @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac3md.svg new file mode 100644 index 0000000..99d8b1b --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-mu-x-fac3md.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + +0 +2 +4 +6 +Density + + + + + + + + + + + + + +A +B +C + + + + + + +A +B +C + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg new file mode 100644 index 0000000..bcb1783 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Density + + + + +intercept + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg new file mode 100644 index 0000000..0907ac7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +2 +4 +6 +8 +10 +Density + + + + + + + + + + + + + +-1SD +0SD +1SD + + + + + + +-1SD +0SD +1SD + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg new file mode 100644 index 0000000..8a16efb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + + +0 +2 +4 +6 +8 +10 +Density + + + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg new file mode 100644 index 0000000..aac81c6 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + +0.5 +0.6 +0.7 +0.8 + + + + + + + +0 +2 +4 +6 +8 +10 +fac2t +Density + + + + + + + + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg new file mode 100644 index 0000000..6cee19a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + +-6 +-4 +-2 +0 +2 +4 +6 + + + + + + + +0 +2 +4 +6 +8 +10 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg new file mode 100644 index 0000000..591d056 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0 +2 +4 +6 +8 +10 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg new file mode 100644 index 0000000..1268467 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg @@ -0,0 +1,68 @@ + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + +0 +1 +2 +3 +4 +5 +Density + + + + + + + + + + + +A +B + + + + +A +B + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg new file mode 100644 index 0000000..235f4ab --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + + + +0 +1 +2 +3 +4 +5 +Density + + + + + + + + + + + + + +A +B +C + + + + + + +A +B +C + + diff --git a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-1.svg b/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-1.svg deleted file mode 100644 index a32eb80..0000000 --- a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-1.svg +++ /dev/null @@ -1,138 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged -mixed_posterior -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 -6000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional -mixed_posterior_conditional -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -500 -1000 -1500 -2000 - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-2.svg b/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-2.svg deleted file mode 100644 index 63622ac..0000000 --- a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-2.svg +++ /dev/null @@ -1,267 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged (m) -mixed_posteriors$m -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - - -0 -1000 -3000 -5000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (m) -mixed_posteriors_conditional$m -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -500 -1000 -1500 -2000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (s) -mixed_posteriors$s -Frequency - - - - - - - - -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - -0 -200 -600 -1000 -1400 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional = conditional (s) -mixed_posteriors_conditional$s -Frequency - - - - - - - - -0.6 -0.8 -1.0 -1.2 -1.4 - - - - - - - - - -0 -200 -600 -1000 -1400 - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-3.svg b/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-3.svg deleted file mode 100644 index 8ddcb3c..0000000 --- a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-3.svg +++ /dev/null @@ -1,382 +0,0 @@ - - - - - - - - - - - - - - - - - - - -averaged x_fac2t -mixed_posteriors$mu_x_fac2t -Frequency - - - - - - - --0.5 -0.0 -0.5 -1.0 - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditiona x_fac2t -mixed_posteriors_c$mu_x_fac2t -Frequency - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional mu_x_fac3t[1] -mixed_posteriors_c$mu_x_fac3t[, 1] -Frequency - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional mu_x_fac3t[2] -mixed_posteriors_c$mu_x_fac3t[, 2] -Frequency - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - -0 -500 -1000 -1500 -2000 -2500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional mu_x_cont1__xXx__x_fac3o[1] -mixed_posteriors_c$mu_x_cont1__xXx__x_fac3o[, 1] -Frequency - - - - - - - --1.0 --0.5 -0.0 -0.5 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional mu_x_cont1__xXx__x_fac3o[2] -mixed_posteriors_c$mu_x_cont1__xXx__x_fac3o[, 2] -Frequency - - - - - - - --1.0 --0.5 -0.0 -0.5 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-1.svg b/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-1.svg deleted file mode 100644 index e9747c6..0000000 --- a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-1.svg +++ /dev/null @@ -1,384 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2000 -4000 -6000 -8000 -10000 - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.05,0.5] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -500 -1000 -1500 -2000 -2500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.5,1] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -500 -1000 -1500 -2000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2000 -4000 -6000 -8000 -10000 - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.05,0.5] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.5,1] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - -0 -100 -200 -300 -400 -500 -600 -700 - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-2.svg b/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-2.svg deleted file mode 100644 index 6272e3f..0000000 --- a/tests/testthat/_snaps/JAGS-model-averaging/jags-model-averaging-weightfunctions-2.svg +++ /dev/null @@ -1,650 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0,0.05] -Frequency - - - - - - - - - - - -0.3 -0.5 -0.7 -0.9 - - - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 -6000 -7000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.05,0.1] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - - - -0 -500 -1000 -1500 -2000 -2500 -3000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.1,0.5] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.5,0.9] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (omega) -omega[0.9,1] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - - - -0 -500 -1000 -1500 -2000 -2500 -3000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0,0.05] -Frequency - - - - - - - - - - - -0.3 -0.5 -0.7 -0.9 - - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 -6000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.05,0.1] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - -0 -1000 -2000 -3000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.1,0.5] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.5,0.9] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - -0 -1000 -2000 -3000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (omega) -omega[0.9,1] -Frequency - - - - - - - - - -0.0 -0.4 -0.8 - - - - - - -0 -1000 -2000 -3000 -4000 - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-cont1.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-cont1.svg deleted file mode 100644 index 6eb9b04..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-cont1.svg +++ /dev/null @@ -1,105 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Density - - - - - - - - - - - - - - - - --1SD -0SD -1SD - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg deleted file mode 100644 index a98e2b2..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-1.svg +++ /dev/null @@ -1,89 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -Density - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg deleted file mode 100644 index f98ed78..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-2.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -fac2t -Density - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg deleted file mode 100644 index 3cacfdd..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-3.svg +++ /dev/null @@ -1,99 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - --6 --4 --2 -0 -2 -4 -6 -8 -Density - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg deleted file mode 100644 index 0b35d07..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac2t-4.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Density - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac3md.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac3md.svg deleted file mode 100644 index 1e4aace..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-mu-x-fac3md.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density - - - - - - - - - - - - - - - - -A -B -C - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg deleted file mode 100644 index a87d8cc..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg +++ /dev/null @@ -1,109 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Density - - - - - - - - - - - - - - - - --1SD -0SD -1SD - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg deleted file mode 100644 index da133bd..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-1.svg +++ /dev/null @@ -1,89 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 -Density - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg deleted file mode 100644 index 6b5e4e1..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-2.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 -fac2t -Density - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg deleted file mode 100644 index 9aaf58c..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - - - - --6 --4 --2 -0 -2 -4 -6 -8 -Density - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg deleted file mode 100644 index a35fa4c..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg +++ /dev/null @@ -1,99 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Density - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg deleted file mode 100644 index f981e29..0000000 --- a/tests/testthat/_snaps/marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg +++ /dev/null @@ -1,105 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density - - - - - - - - - - - - - - - - -A -B -C - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-exp.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-con-exp.svg deleted file mode 100644 index bba0357..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-exp.svg +++ /dev/null @@ -1,213 +0,0 @@ - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(-1) -marg_post_x_cont1.exp[["-1SD"]] -Density - - - - - - - - -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(0) -marg_post_x_cont1.exp[["0SD"]] -Density - - - - - - - -1.6 -1.8 -2.0 -2.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(1) -marg_post_x_cont1.exp[["1SD"]] -Density - - - - - - - - - -1.8 -2.0 -2.2 -2.4 -2.6 -2.8 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-p-exp.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-con-p-exp.svg deleted file mode 100644 index 47794cd..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-con-p-exp.svg +++ /dev/null @@ -1,411 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(-1) -attr(marg_post_x_cont1.exp[["-1SD"]], "prior_samples") -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(0) -exp(attr(marg_post_x_cont1[["0SD"]], "prior_samples")) -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(1) -attr(marg_post_x_cont1.exp[["1SD"]], "prior_samples") -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-con.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-con.svg deleted file mode 100644 index f3641cd..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-con.svg +++ /dev/null @@ -1,208 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marginal posterior x_cont1 -(-1) -marg_post_x_cont1[["-1SD"]] -Density - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal posterior x_cont1 -(0) -marg_post_x_cont1[["0SD"]] -Density - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal posterior x_cont1 -(1) -marg_post_x_cont1[["1SD"]] -Density - - - - - - - - -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-at.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-at.svg deleted file mode 100644 index 1bfd629..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md-at.svg +++ /dev/null @@ -1,369 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = A | 1,A -marg_post_x_fac3md_AT[["A"]][1, ] -Density - - - - - - - -0.6 -0.8 -1.0 -1.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = A | 1,B -marg_post_x_fac3md_AT[["A"]][2, ] -Density - - - - - - - -0.6 -0.8 -1.0 -1.2 - - - - - -0 -1 -2 -3 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = B | 1,A -marg_post_x_fac3md_AT[["B"]][1, ] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = B | 1,B -marg_post_x_fac3md_AT[["B"]][2, ] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = C | 1,A -marg_post_x_fac3md_AT[["C"]][1, ] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = C | 1,B -marg_post_x_fac3md_AT[["C"]][2, ] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md.svg deleted file mode 100644 index fa73ae0..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-md.svg +++ /dev/null @@ -1,213 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = A -marg_post_x_fac3md[["A"]] -Density - - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 -1.1 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = B -marg_post_x_fac3md[["B"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = B -marg_post_x_fac3md[["C"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi.svg deleted file mode 100644 index 6d38ffa..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-mdi.svg +++ /dev/null @@ -1,579 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_cont1 = -1 -marg_post_x_fac3md = A -marg_post_x_cont1__xXx__x_fac3md[["-1SD, A"]] -Density - - - - - - - - -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = -1 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["-1SD, B"]] -Density - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = -1 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["-1SD, C"]] -Density - - - - - - - -0.2 -0.4 -0.6 -0.8 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 0 -marg_post_x_fac3md = A -marg_post_x_cont1__xXx__x_fac3md[["0SD, A"]] -Density - - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 -1.1 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 0 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["0SD, B"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 0 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["0SD, C"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 1 -marg_post_x_fac3md = A -marg_post_x_cont1__xXx__x_fac3md[["1SD, A"]] -Density - - - - - - - -0.6 -0.8 -1.0 -1.2 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 1 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["1SD, B"]] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 = 1 -marg_post_x_fac3md = B -marg_post_x_cont1__xXx__x_fac3md[["1SD, C"]] -Density - - - - - - - -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t.svg deleted file mode 100644 index a2dbdb5..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-fac-t.svg +++ /dev/null @@ -1,150 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = A -marg_post_x_fac2t[["A"]] -Density - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = B -marg_post_x_fac2t[["B"]] -Density - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-int-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-int-p.svg deleted file mode 100644 index be67257..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-int-p.svg +++ /dev/null @@ -1,73 +0,0 @@ - - - - - - - - - - - - -marginal prior intercept -attr(marg_post_int[["intercept"]], "prior_samples") -Density - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-form-int.svg b/tests/testthat/_snaps/marginal-distributions/marginal-form-int.svg deleted file mode 100644 index e0dbc18..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-form-int.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - -marginal posterior intercept -marg_post_int[["intercept"]] -Density - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont-p.svg deleted file mode 100644 index af92734..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont-p.svg +++ /dev/null @@ -1,392 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = -1SD -attr(marg_post_x_cont1[["-1SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 0SD -attr(marg_post_x_cont1[["0SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 1SD -attr(marg_post_x_cont1[["1SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont.svg deleted file mode 100644 index 71ac0c4..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-cont.svg +++ /dev/null @@ -1,233 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = -1SD -marg_post_x_cont1[["-1SD"]] -Density - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 0SD -marg_post_x_cont1[["0SD"]] -Density - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = +1SD -marg_post_x_cont1[["1SD"]] -Density - - - - - - - - -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md.svg deleted file mode 100644 index 788ea14..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-fac-md.svg +++ /dev/null @@ -1,213 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = A -marg_post_x_fac3md[["A"]] -Density - - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 -1.1 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = B -marg_post_x_fac3md[["B"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = B -marg_post_x_fac3md[["C"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont-p.svg deleted file mode 100644 index ade6ff8..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont-p.svg +++ /dev/null @@ -1,392 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = -1SD -attr(marg_post_x_cont1[["-1SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 0SD -attr(marg_post_x_cont1[["0SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 1SD -attr(marg_post_x_cont1[["1SD"]], "prior_samples") -Density - - - - - - - - --4 --2 -0 -2 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont.svg deleted file mode 100644 index 9959015..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-cont.svg +++ /dev/null @@ -1,235 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = -1SD -marg_post_x_cont1[["-1SD"]] -Density - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = 0SD -marg_post_x_cont1[["0SD"]] -Density - - - - - - - - - - -0.45 -0.50 -0.55 -0.60 -0.65 -0.70 -0.75 - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_cont1 = +1SD -marg_post_x_cont1[["1SD"]] -Density - - - - - - - - - -0.6 -0.7 -0.8 -0.9 -1.0 -1.1 - - - - - -0 -2 -4 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md.svg b/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md.svg deleted file mode 100644 index e25d7b3..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-inference-ss-fac-md.svg +++ /dev/null @@ -1,233 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = A -marg_post_x_fac3md[["A"]] -Density - - - - - - - - - -0.5 -0.6 -0.7 -0.8 -0.9 -1.0 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = B -marg_post_x_fac3md[["B"]] -Density - - - - - - - - - - -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac3md = C -marg_post_x_fac3md[["C"]] -Density - - - - - - - - - -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-simple-con-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-simple-con-p.svg deleted file mode 100644 index b8bdf0b..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-simple-con-p.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - -marginal prior sigma -attr(marg_post_sigma, "prior_samples") -Density - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-simple-con.svg b/tests/testthat/_snaps/marginal-distributions/marginal-simple-con.svg deleted file mode 100644 index af58a24..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-simple-con.svg +++ /dev/null @@ -1,73 +0,0 @@ - - - - - - - - - - - - -marginal posterior sigma -marg_post_sigma -Density - - - - - - -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 -14 - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-simple-fac.svg b/tests/testthat/_snaps/marginal-distributions/marginal-simple-fac.svg deleted file mode 100644 index 73d4b37..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-simple-fac.svg +++ /dev/null @@ -1,148 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = A -marg_post_simple_x_fac2t[["A"]] -Density - - - - - - - - - --1.0 --0.8 --0.6 --0.4 --0.2 -0.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - - - - - - - - - - -marg_post_x_fac2t = B -marg_post_simple_x_fac2t[["B"]] -Density - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - -0 -5 -10 -15 -20 -25 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-exp.svg b/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-exp.svg deleted file mode 100644 index 89882a2..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-exp.svg +++ /dev/null @@ -1,209 +0,0 @@ - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(-1) -marg_post_x_cont1.exp[["-1SD"]] -Density - - - - - - - - -1.2 -1.4 -1.6 -1.8 -2.0 - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(0) -marg_post_x_cont1.exp[["0SD"]] -Density - - - - - - - - - - -1.6 -1.7 -1.8 -1.9 -2.0 -2.1 -2.2 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -exp marginal posterior x_cont1 -(1) -marg_post_x_cont1.exp[["1SD"]] -Density - - - - - - - - - -1.8 -2.0 -2.2 -2.4 -2.6 -2.8 - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p-exp.svg b/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p-exp.svg deleted file mode 100644 index d494ef4..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-con-p-exp.svg +++ /dev/null @@ -1,407 +0,0 @@ - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(-1) -attr(marg_post_x_cont1.exp[["-1SD"]], "prior_samples") -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(0) -exp(attr(marg_post_x_cont1[["0SD"]], "prior_samples")) -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -marginal prior x_cont1 -(1) -attr(marg_post_x_cont1.exp[["1SD"]], "prior_samples") -Density - - - - - - - - --10 --5 -0 -5 -10 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int-p.svg deleted file mode 100644 index e079013..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-form-int-p.svg +++ /dev/null @@ -1,69 +0,0 @@ - - - - - - - - - - - - -marginal prior intercept -attr(marg_post_int[["intercept"]], "prior_samples") -Density - - - - - - --4 --2 -0 -2 -4 - - - - - -0.0 -0.1 -0.2 -0.3 - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con-p.svg b/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con-p.svg deleted file mode 100644 index fb5f81b..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con-p.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - -marginal prior sigma -attr(marg_post_sigma, "prior_samples") -Density - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con.svg b/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con.svg deleted file mode 100644 index f9e929b..0000000 --- a/tests/testthat/_snaps/marginal-distributions/marginal-ss-simple-con.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - -marginal posterior sigma -marg_post_sigma -Density - - - - - -0.45 -0.50 -0.55 -0.60 - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 -14 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-int.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-int.svg deleted file mode 100644 index 3df96ac..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-int.svg +++ /dev/null @@ -1,83 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density - - - - -intercept - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-cont1.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-cont1.svg deleted file mode 100644 index 2575419..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-cont1.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - - - --1SD -0SD -1SD - - - - - - --1SD -0SD -1SD - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-1.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-1.svg deleted file mode 100644 index 3072d93..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-1.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-2.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-2.svg deleted file mode 100644 index 6e66986..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-2.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 - - - - - - -0 -2 -4 -6 -8 -fac2t -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-3.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-3.svg deleted file mode 100644 index ad34858..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-3.svg +++ /dev/null @@ -1,68 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --6 --4 --2 -0 -2 -4 -6 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-4.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-4.svg deleted file mode 100644 index d756817..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-4.svg +++ /dev/null @@ -1,66 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-5.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-5.svg deleted file mode 100644 index 63b1394..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac2t-5.svg +++ /dev/null @@ -1,66 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - -0 -1 -2 -3 -4 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac3md.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac3md.svg deleted file mode 100644 index 141cc8f..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-mu-x-fac3md.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 -Density - - - - - - - - - - - - - -A -B -C - - - - - - -A -B -C - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-int.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-int.svg deleted file mode 100644 index e45e9d3..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-int.svg +++ /dev/null @@ -1,87 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density - - - - -intercept - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-cont1.svg deleted file mode 100644 index ad3f420..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-cont1.svg +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2 -4 -6 -8 -10 -Density - - - - - - - - - - - - - --1SD -0SD -1SD - - - - - - --1SD -0SD -1SD - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg deleted file mode 100644 index 3ff3d57..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-1.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - -0.5 -0.6 -0.7 -0.8 - - - - - - - -0 -2 -4 -6 -8 -10 -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg deleted file mode 100644 index e2e29a7..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-2.svg +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - -0.5 -0.6 -0.7 -0.8 - - - - - - - -0 -2 -4 -6 -8 -10 -fac2t -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg deleted file mode 100644 index 07858b5..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg +++ /dev/null @@ -1,68 +0,0 @@ - - - - - - - - - - - - - - - - - - - --4 --2 -0 -2 -4 -6 - - - - - - - -0 -2 -4 -6 -8 -10 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg deleted file mode 100644 index 217731b..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg +++ /dev/null @@ -1,68 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2 -4 -6 -8 -10 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg deleted file mode 100644 index 8c220c7..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg +++ /dev/null @@ -1,68 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - -0 -1 -2 -3 -4 -5 -Density - - - - - - - - - - - -A -B - - - - -A -B - - diff --git a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg deleted file mode 100644 index 1b3f0fc..0000000 --- a/tests/testthat/_snaps/marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - - - - - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -Density - - - - - - - - - - - - - -A -B -C - - - - - - -A -B -C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-1.svg deleted file mode 100644 index 06acb07..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-1.svg +++ /dev/null @@ -1,101 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -Density - - - - - -A -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-2.svg deleted file mode 100644 index c99d185..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-i-2.svg +++ /dev/null @@ -1,106 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - -A -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-1.svg deleted file mode 100644 index fe36c9c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-1.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-2.svg deleted file mode 100644 index a3a6e85..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-2.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-3.svg deleted file mode 100644 index 87d76fd..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-3.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-4.svg deleted file mode 100644 index 9ac9aec..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-4.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-5.svg deleted file mode 100644 index ce59b85..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-md-5.svg +++ /dev/null @@ -1,120 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - --1.5 --1.0 --0.5 -0.0 -0.5 -1.0 -1.5 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-1.svg deleted file mode 100644 index 1b3803e..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-1.svg +++ /dev/null @@ -1,113 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 -0.07 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-2.svg deleted file mode 100644 index e135309..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-2.svg +++ /dev/null @@ -1,113 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 -0.07 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-3.svg deleted file mode 100644 index b364e70..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-3.svg +++ /dev/null @@ -1,113 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 -0.07 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-4.svg deleted file mode 100644 index 52d764c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-4.svg +++ /dev/null @@ -1,103 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 -0.07 - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -Density -Probability - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-5.svg deleted file mode 100644 index dcfcd6c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-o-5.svg +++ /dev/null @@ -1,120 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 - - - - - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - --1.5 --1.0 --0.5 -0.0 -0.5 -1.0 -1.5 -Density -Probability - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-1.svg deleted file mode 100644 index 572d24b..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-1.svg +++ /dev/null @@ -1,111 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - -0 -0.05 -0.1 -0.15 -0.2 - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -Density -Probability - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-2.svg deleted file mode 100644 index 2715509..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-2.svg +++ /dev/null @@ -1,111 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - -0 -0.05 -0.1 -0.15 -0.2 - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -Density -Probability - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-3.svg deleted file mode 100644 index 2caf250..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-3.svg +++ /dev/null @@ -1,111 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - -0 -0.05 -0.1 -0.15 -0.2 - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -Density -Probability - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-4.svg deleted file mode 100644 index 81d517b..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-4.svg +++ /dev/null @@ -1,107 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - -0 -0.05 -0.1 -0.15 -0.2 - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -Density -Probability - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-5.svg deleted file mode 100644 index 5f14585..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-ggplot-posterior-t-5.svg +++ /dev/null @@ -1,108 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - --1.5 --1.0 --0.5 -0.0 -0.5 -1.0 -1.5 -Density -Probability - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-1.svg deleted file mode 100644 index 050896f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-1.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -mu - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 - - - - - - - - -0.02 [-0.19, 0.43] -0.00 [ 0.00, 0.00] -BF = 2.42 [0.33 -> 0.55] -0.13 [-0.44, 0.68] -BF = 0.43 [0.33 -> 0.18] -0.00 [ 0.00, 0.00] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-10.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-10.svg deleted file mode 100644 index e36079c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-10.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -0.02 [-0.19, 0.43] -BF = 2.42 [0.33 -> 0.55] -BF = 0.43 [0.33 -> 0.18] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - --0.6 --0.4 --0.2 -0 -0.2 -0.4 -0.6 -0.8 -mu -model-averaging-plot-models-10 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-2.svg deleted file mode 100644 index bae31c7..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-2.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 -tau - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 - - - - - - - - -0.23 [0.00, 1.11] -0.00 [0.00, 0.00] -BF = 2.42 [0.33 -> 0.55] -0.00 [0.00, 0.00] -BF = 0.43 [0.33 -> 0.18] -0.84 [0.53, 1.31] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-3.svg deleted file mode 100644 index cfb3beb..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-3.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 -mu - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 - - - - - - - - -0.02 [-0.19, 0.43] -0.00 [ 0.00, 0.00] -BF = 2.42 [0.33 -> 0.55] -0.13 [-0.44, 0.68] -BF = 0.43 [0.33 -> 0.18] -0.00 [ 0.00, 0.00] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-4.svg deleted file mode 100644 index 1495b68..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-4.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -tau - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 - - - - - - - - -0.23 [0.00, 1.11] -0.00 [0.00, 0.00] -BF = 2.42 [0.33 -> 0.55] -0.00 [0.00, 0.00] -BF = 0.43 [0.33 -> 0.18] -0.84 [0.53, 1.31] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-5.svg deleted file mode 100644 index c471cbf..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-5.svg +++ /dev/null @@ -1,65 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -mu - - - -Model-Averaged -Model 2 - - - - -0.02 [-0.19, 0.43] -0.13 [-0.44, 0.68] -BF = 0.43 [0.33 -> 0.18] - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-6.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-6.svg deleted file mode 100644 index b375278..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-6.svg +++ /dev/null @@ -1,65 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -tau - - - -Model-Averaged -Model 3 - - - - -0.23 [0.00, 1.11] -0.84 [0.53, 1.31] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-7.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-7.svg deleted file mode 100644 index 4f4df6c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-7.svg +++ /dev/null @@ -1,94 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -0.02 [-0.19, 0.43] -0.00 [ 0.00, 0.00] -0.13 [-0.44, 0.68] -0.00 [ 0.00, 0.00] -BF = 2.42 [0.33 -> 0.55] -BF = 0.43 [0.33 -> 0.18] -BF = 0.75 [0.33 -> 0.27] - - - - - - - - --0.6 --0.4 --0.2 -0 -0.2 -0.4 -0.6 -0.8 -mu -model-averaging-plot-models-7 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-8.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-8.svg deleted file mode 100644 index 55c2ad5..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-8.svg +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -0.23 [0.00, 1.11] -0.00 [0.00, 0.00] -0.00 [0.00, 0.00] -0.84 [0.53, 1.31] -BF = 2.42 [0.33 -> 0.55] -BF = 0.43 [0.33 -> 0.18] -BF = 0.75 [0.33 -> 0.27] - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 -tau -model-averaging-plot-models-8 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-9.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-9.svg deleted file mode 100644 index b4570a0..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-9.svg +++ /dev/null @@ -1,87 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 - - - - - - - - --0.6 --0.4 --0.2 -0 -0.2 -0.4 -0.6 -0.8 -mu -model-averaging-plot-models-9 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-1.svg deleted file mode 100644 index 8818420..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-1.svg +++ /dev/null @@ -1,89 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -(mu) x_cont1 - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.12 [0.00, 0.53] -0.00 [0.00, 0.00] -BF = 3.33 [0.25 -> 0.53] -0.33 [0.05, 0.60] -BF = 1.54 [0.25 -> 0.34] -0.00 [0.00, 0.00] -BF = 0.33 [0.25 -> 0.10] -0.32 [0.05, 0.60] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-10.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-10.svg deleted file mode 100644 index 91197a8..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-10.svg +++ /dev/null @@ -1,103 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 -0.12 [0.00, 0.53] -0.00 [0.00, 0.00] -0.33 [0.05, 0.60] -0.00 [0.00, 0.00] -0.32 [0.05, 0.60] -BF = 3.33 [0.25 -> 0.53] -BF = 1.54 [0.25 -> 0.34] -BF = 0.33 [0.25 -> 0.10] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -(mu) x_cont1 -model-averaging-plot-models-formula-10 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-11.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-11.svg deleted file mode 100644 index 2df433f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-11.svg +++ /dev/null @@ -1,117 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.04 [-0.37, 0.30] --0.01 [-0.34, 0.32] -BF = 3.33 [0.25 -> 0.53] -BF = 1.54 [0.25 -> 0.34] -BF = 0.33 [0.25 -> 0.10] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - --2 --1.5 --1 --0.5 -0 -0.5 -1 -1.5 -2 -(mu) x_fac3o [dif: A] -model-averaging-plot-models-formula-11 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-12.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-12.svg deleted file mode 100644 index 7b5ba8d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-12.svg +++ /dev/null @@ -1,117 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.01 [-0.34, 0.33] --0.06 [-0.40, 0.27] -BF = 3.33 [0.25 -> 0.53] -BF = 1.54 [0.25 -> 0.34] -BF = 0.33 [0.25 -> 0.10] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - --2 --1.5 --1 --0.5 -0 -0.5 -1 -1.5 -2 -(mu) x_fac3o [dif: B] -model-averaging-plot-models-formula-12 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-13.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-13.svg deleted file mode 100644 index f2aa0eb..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-13.svg +++ /dev/null @@ -1,117 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 -0.00 [-0.16, 0.16] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.05 [-0.29, 0.38] -0.07 [-0.25, 0.40] -BF = 3.33 [0.25 -> 0.53] -BF = 1.54 [0.25 -> 0.34] -BF = 0.33 [0.25 -> 0.10] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - --2 --1.5 --1 --0.5 -0 -0.5 -1 -1.5 -2 -(mu) x_fac3o [dif: C] -model-averaging-plot-models-formula-13 - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-2.svg deleted file mode 100644 index bcd7776..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-2.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -(mu) x_fac2t[B] - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - --0.01 [-0.42, 0.38] --0.02 [-0.49, 0.44] -BF = 3.33 [0.25 -> 0.53] - 0.00 [ 0.00, 0.00] -BF = 1.54 [0.25 -> 0.34] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.25 -> 0.10] - 0.00 [ 0.00, 0.00] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-3.svg deleted file mode 100644 index fd32345..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-3.svg +++ /dev/null @@ -1,87 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 -(mu) x_fac2t[B] - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - --0.01 [-0.42, 0.38] --0.02 [-0.49, 0.44] -BF = 3.33 [0.25 -> 0.53] - 0.00 [ 0.00, 0.00] -BF = 1.54 [0.25 -> 0.34] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.25 -> 0.10] - 0.00 [ 0.00, 0.00] -BF = 0.11 [0.25 -> 0.03] - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-4.svg deleted file mode 100644 index 8fc419f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-4.svg +++ /dev/null @@ -1,162 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_fac3t[B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.02 [-0.35, 0.46] -0.00 [ 0.00, 0.00] -0.01 [-0.55, 0.55] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -(mu) x_fac3t[C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.02 [-0.35, 0.46] -0.00 [ 0.00, 0.00] -0.12 [-0.43, 0.66] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-5.svg deleted file mode 100644 index 15c3fa0..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-5.svg +++ /dev/null @@ -1,166 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_fac3t[B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.02 [-0.35, 0.46] -0.00 [ 0.00, 0.00] -0.01 [-0.55, 0.55] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_fac3t[C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.02 [-0.35, 0.46] -0.00 [ 0.00, 0.00] -0.12 [-0.43, 0.66] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-6.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-6.svg deleted file mode 100644 index 88eed84..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-6.svg +++ /dev/null @@ -1,226 +0,0 @@ - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - -(mu) x_fac3o [dif: A] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.04 [-0.37, 0.30] --0.01 [-0.34, 0.32] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 - - - - - - - -(mu) x_fac3o [dif: B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.01 [-0.34, 0.33] --0.06 [-0.40, 0.27] - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 - - - - - - - -(mu) x_fac3o [dif: C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.05 [-0.29, 0.38] -0.07 [-0.25, 0.40] - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-7.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-7.svg deleted file mode 100644 index 9cafff3..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-7.svg +++ /dev/null @@ -1,258 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_fac3o [dif: A] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.04 [-0.37, 0.30] --0.01 [-0.34, 0.32] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_fac3o [dif: B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.01 [-0.34, 0.33] --0.06 [-0.40, 0.27] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_fac3o [dif: C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [-0.16, 0.16] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.05 [-0.29, 0.38] -0.07 [-0.25, 0.40] - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-8.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-8.svg deleted file mode 100644 index dc0405c..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-8.svg +++ /dev/null @@ -1,225 +0,0 @@ - - - - - - - - - - - - - - - - - - - --0.8 --0.6 --0.4 --0.2 -0.0 -0.2 - - - - - - - -(mu) x_cont1:x_fac3o [dif: A] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.28 [-0.67, 0.10] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_cont1:x_fac3o [dif: B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.16 [-0.22, 0.54] - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_cont1:x_fac3o [dif: C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.12 [-0.28, 0.52] - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-9.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-9.svg deleted file mode 100644 index 6abc3ce..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-9.svg +++ /dev/null @@ -1,240 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_cont1:x_fac3o [dif: A] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] - 0.00 [ 0.00, 0.00] --0.28 [-0.67, 0.10] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_cont1:x_fac3o [dif: B] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.16 [-0.22, 0.54] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - -(mu) x_cont1:x_fac3o [dif: C] - - - - - - - - -Model-Averaged -Model 1 -Model 2 -Model 3 -Model 4 - - - - - - - - - - -0.00 [0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.00 [ 0.00, 0.00] -0.12 [-0.28, 0.52] - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-1.svg deleted file mode 100644 index 87bba1d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-1.svg +++ /dev/null @@ -1,205 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - -(mu) x_fac3md [dif: A] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] --0.01 [-0.16, 0.14] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.4 --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - -(mu) x_fac3md [dif: B] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] --0.17 [-0.31, -0.02] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - -(mu) x_fac3md [dif: C] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] -0.00 [0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] -0.18 [0.03, 0.33] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-2.svg deleted file mode 100644 index 6f0aa2b..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-models-formula-s-2.svg +++ /dev/null @@ -1,216 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_fac3md [dif: A] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] --0.01 [-0.16, 0.14] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_fac3md [dif: B] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] - 0.00 [ 0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] --0.17 [-0.31, -0.02] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - - -(mu) x_fac3md [dif: C] - - - - - - -Model-Averaged -Model 1 -Model 2 - - - - - - -0.00 [-0.26, 0.27] -0.00 [0.00, 0.00] -BF = 0.33 [0.50 -> 0.25] -0.18 [0.03, 0.33] -BF = 3.02 [0.50 -> 0.75] - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-1.svg deleted file mode 100644 index 0cf048f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-1.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-2.svg deleted file mode 100644 index 0b9d8c8..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-2.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -Density - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-3.svg deleted file mode 100644 index 9b43ffa..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-i-3.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --0.5 -0.0 -0.5 - - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 -3 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - -A -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-1.svg deleted file mode 100644 index 505c071..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-1.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --0.5 -0.0 -0.5 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -Probability - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-2.svg deleted file mode 100644 index 8d8f057..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-2.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --0.5 -0.0 -0.5 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -Probability - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-3.svg deleted file mode 100644 index 5433f42..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-3.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --0.5 -0.0 -0.5 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -Probability - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-4.svg deleted file mode 100644 index af10823..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-4.svg +++ /dev/null @@ -1,69 +0,0 @@ - - - - - - - - - - - - -Density - - - - --0.5 -0.0 -0.5 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -Probability - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-5.svg deleted file mode 100644 index 50a955d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-md-5.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-5.svg deleted file mode 100644 index 9cc62e7..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-o-5.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -1.2 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-5.svg deleted file mode 100644 index 3dad306..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-5.svg +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.00 -0.02 -0.04 -0.06 -0.08 -0.10 -0.12 -PET-PEESE (1/2x) -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-6.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-6.svg deleted file mode 100644 index 77ecde8..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-6.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.00 -0.05 -0.10 -0.15 -0.20 -PET-PEESE -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-8.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-8.svg deleted file mode 100644 index 597a182..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-petpeese-8.svg +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - -0.00 -0.02 -0.04 -0.06 -0.08 -0.10 -0.12 -PET-PEESE -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-1.svg deleted file mode 100644 index cdae361..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-1.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -μ -Density - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - -0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-2.svg deleted file mode 100644 index 5752b61..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-2.svg +++ /dev/null @@ -1,98 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 -1.5 -Density -Probability - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-3.svg deleted file mode 100644 index 3981682..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-3.svg +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - -0 -1 -2 -3 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-4.svg deleted file mode 100644 index 8f4aaaa..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-4.svg +++ /dev/null @@ -1,77 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - -0 -1 -2 -3 -4 -Density - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-5.svg deleted file mode 100644 index 5e5e872..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-5.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -10 -20 -30 -40 - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-6.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-6.svg deleted file mode 100644 index 676e924..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-6.svg +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - -0 -0.2 -0.4 -0.6 -0.8 - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-8.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-8.svg deleted file mode 100644 index 8e8d72e..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-simple-8.svg +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - -0 -10 -20 -30 -40 - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-1.svg deleted file mode 100644 index f453553..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-1.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 - - - - - - -0 -0.05 -0.1 -0.15 -0.2 -Probability - - - - - - - - - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-2.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-2.svg deleted file mode 100644 index 734148b..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-2.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 - - - - - - -0 -0.05 -0.1 -0.15 -0.2 -Probability - - - - - - - - - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-3.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-3.svg deleted file mode 100644 index 5cbf003..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-3.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 - - - - - - -0 -0.05 -0.1 -0.15 -0.2 -Probability - - - - - - - - - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-4.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-4.svg deleted file mode 100644 index 604a442..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-4.svg +++ /dev/null @@ -1,73 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - - --0.2 -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 - - - - - - -0 -0.05 -0.1 -0.15 -0.2 -Probability - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-5.svg deleted file mode 100644 index 660b696..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-posterior-t-5.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - - - - - -0 -0.5 -1 -1.5 -2 -2.5 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - -B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-1.svg deleted file mode 100644 index b944f05..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-1.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -PET-PEESE -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-5.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-5.svg deleted file mode 100644 index f633a9d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-5.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -PET-PEESE -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-7.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-7.svg deleted file mode 100644 index 3cdfe3d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-prior-petpeese-7.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -PET-PEESE -Standard error -Effect size - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg deleted file mode 100644 index dc9a7ce..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.new.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - -Density - - - - - -0 -1 -2 -3 - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -0.1 -0.12 -0.14 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.svg deleted file mode 100644 index 29c2cc7..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-bias-pet.svg +++ /dev/null @@ -1,78 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - -0 -1 -2 -3 -4 - - - - - - - - - -0 -0.02 -0.04 -0.06 -0.08 -0.1 -0.12 -0.14 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg deleted file mode 100644 index 3eb9d44..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.new.svg +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.svg deleted file mode 100644 index 6be81d4..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept-con.svg +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg deleted file mode 100644 index ee8b34b..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.new.svg +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --2 --1 -0 -1 -2 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.svg deleted file mode 100644 index c53810f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-intercept.svg +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --2 --1 -0 -1 -2 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.svg deleted file mode 100644 index a03d4bf..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-omega-con.svg +++ /dev/null @@ -1,730 +0,0 @@ - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0 -5000 -10000 -15000 - - - - - - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2000 -4000 -6000 -8000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -2000 -4000 -6000 -8000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -2000 -4000 -6000 -8000 - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -500 -1000 -1500 -2000 -2500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -500 -1000 -1500 -2000 -2500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0 -50 -100 -150 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0 -50 -100 -150 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg deleted file mode 100644 index ca775a5..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.new.svg +++ /dev/null @@ -1,384 +0,0 @@ - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - -0 -2000 -6000 -10000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - -0 -1000 -2000 -3000 -4000 -5000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - - - - - - - - -0 -20 -40 -60 -80 -100 -120 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.svg deleted file mode 100644 index 8c931e5..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-pet-con.svg +++ /dev/null @@ -1,260 +0,0 @@ - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - -0 -1 -2 -3 - - - - - - - - - -0 -2000 -6000 -10000 -14000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - -0 -1 -2 -3 - - - - - - - -0 -1000 -3000 -5000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -PET -PET -Frequency - - - - - - - -0 -1 -2 -3 - - - - - - -0 -50 -100 -150 -200 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg deleted file mode 100644 index cecb8df..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.new.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - -0 -2 -4 -6 -8 -10 -12 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.svg deleted file mode 100644 index d939804..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-sigma.svg +++ /dev/null @@ -1,60 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - -0 -2 -4 -6 -8 -10 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg deleted file mode 100644 index 1bdce00..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction-con.new.svg +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - -Selection Models -p --value -Probability - - - - - - -0 -0.05 -0.975 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg deleted file mode 100644 index 22398bc..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-weightfunction.new.svg +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - -Selection Models -p --value -Probability - - - - - - -0 -0.05 -0.975 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg deleted file mode 100644 index 0a29d5d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.new.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg deleted file mode 100644 index 0e6a476..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1-con.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg deleted file mode 100644 index 4205eaf..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-cont1.new.svg +++ /dev/null @@ -1,78 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --2 --1 -0 -1 -2 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg deleted file mode 100644 index c4dae9f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.new.svg +++ /dev/null @@ -1,55 +0,0 @@ - - - - - - - - - - - - - - - - --1 -0 -1 - - - - - - -0 -1 -2 -3 -4 -Density - - - - - - - - - - - - - A - B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg deleted file mode 100644 index ae80863..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t-con.svg +++ /dev/null @@ -1,55 +0,0 @@ - - - - - - - - - - - - - - - - --1 -0 -1 - - - - - - -0 -1 -2 -3 -4 -Density - - - - - - - - - - - - - A - B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg deleted file mode 100644 index 25d5fb4..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.new.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --1 -0 -1 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - - - - - A - B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.svg deleted file mode 100644 index d2a2468..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac2t.svg +++ /dev/null @@ -1,75 +0,0 @@ - - - - - - - - - - - - -Density - - - - --1 -0 -1 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - - - - - A - B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg deleted file mode 100644 index abea367..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.new.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -Density - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg deleted file mode 100644 index 5e18c64..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t-con.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -Density - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg deleted file mode 100644 index 3b44b5a..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.new.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --2 --1 -0 -1 -2 - - - - - - -0 -0.5 -1 -1.5 -2 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.svg deleted file mode 100644 index 57144f2..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-plot-ss-posterior-x-fac3t.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - --2 --1 -0 -1 -2 - - - - - - -0 -0.5 -1 -1.5 -2 - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -Probability - - - - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg deleted file mode 100644 index 9c8a1c0..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.new.svg +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - --2.0 --1.5 --1.0 --0.5 -0.0 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.svg deleted file mode 100644 index 0e66ba4..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-intercept.svg +++ /dev/null @@ -1,54 +0,0 @@ - - - - - - - - - - - - - - - - - - --2.0 --1.5 --1.0 --0.5 -0.0 - - - - - - -0 -2 -4 -6 -8 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-sigma.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-sigma.svg deleted file mode 100644 index 52b5c24..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-sigma.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - - -0 -2 -4 -6 -8 -10 -12 - - - - - - - - -0 -2 -4 -6 -8 -10 -12 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg deleted file mode 100644 index 9df4cbd..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.new.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg deleted file mode 100644 index aa1cae2..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-cont1.svg +++ /dev/null @@ -1,58 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -Density - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg deleted file mode 100644 index 9409a29..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac2t.svg +++ /dev/null @@ -1,55 +0,0 @@ - - - - - - - - - - - - - - - - --1 -0 -1 - - - - - - -0 -1 -2 -3 -4 -Density - - - - - - - - - - - - - A - B - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg deleted file mode 100644 index 5cdd89f..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.new.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -Density - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg b/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg deleted file mode 100644 index 2471253..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/model-averaging-simple-plot-ss-posterior-x-fac3t.svg +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - --2 --1 -0 -1 -2 - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -Density - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg deleted file mode 100644 index afb5849..0000000 --- a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.new.svg +++ /dev/null @@ -1,256 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 -mixed_posteriors$mu_x_cont1 -Frequency - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - -0 -50 -100 -150 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac2t -mixed_posteriors$mu_x_fac2t -Frequency - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3o[1] -mixed_posteriors$mu_x_fac3o[, 1] -Frequency - - - - - - - - - - - --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3o[2] -mixed_posteriors$mu_x_fac3o[, 2] -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg b/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg deleted file mode 100644 index ca2e5f5..0000000 --- a/tests/testthat/_snaps/model-averaging/model-averaging-formulas.svg +++ /dev/null @@ -1,256 +0,0 @@ - - - - - - - - - - - - - - - - - - - -mu_x_cont1 -mixed_posteriors$mu_x_cont1 -Frequency - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - -0 -50 -100 -150 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac2t -mixed_posteriors$mu_x_fac2t -Frequency - - - - - - - - - - --0.6 --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3o[1] -mixed_posteriors$mu_x_fac3o[, 1] -Frequency - - - - - - - - - - - --0.1 -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -mu_x_fac3o[2] -mixed_posteriors$mu_x_fac3o[, 2] -Frequency - - - - - - - - - --0.4 --0.2 -0.0 -0.2 -0.4 -0.6 - - - - - - -0 -200 -400 -600 -800 - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg deleted file mode 100644 index 1671f29..0000000 --- a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.new.svg +++ /dev/null @@ -1,269 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged (m) -mixed_posteriors$m -Frequency - - - - - - - --0.1 -0.0 -0.1 -0.2 - - - - - - -0 -2000 -4000 -6000 -8000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (m) -mixed_posteriors_conditional$m -Frequency - - - - - - - --0.1 -0.0 -0.1 -0.2 - - - - - - - - -0 -200 -400 -600 -800 -1200 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (s) -mixed_posteriors$s -Frequency - - - - - - - - - - -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (s) -mixed_posteriors_conditional$s -Frequency - - - - - - - - - - -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg b/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg deleted file mode 100644 index 04a232c..0000000 --- a/tests/testthat/_snaps/model-averaging/model-averaging-simple-priors.svg +++ /dev/null @@ -1,269 +0,0 @@ - - - - - - - - - - - - - - - - - - - -model-averaged (m) -mixed_posteriors$m -Frequency - - - - - - - --0.1 -0.0 -0.1 -0.2 - - - - - - -0 -2000 -4000 -6000 -8000 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (m) -mixed_posteriors_conditional$m -Frequency - - - - - - - --0.1 -0.0 -0.1 -0.2 - - - - - - - - -0 -200 -400 -600 -800 -1200 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -model-averaged (s) -mixed_posteriors$s -Frequency - - - - - - - - - - -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -conditional (s) -mixed_posteriors_conditional$s -Frequency - - - - - - - - - - -0.30 -0.35 -0.40 -0.45 -0.50 -0.55 -0.60 - - - - - -0 -500 -1000 -1500 - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 7302caf..c23d4a5 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -88,20 +88,20 @@ test_that("Simple prior models fit correctly", { }" fit_simple_normal <- JAGS_fit(model_syntax, data, priors_simple_normal, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) # Compute marginal likelihood for model averaging log_posterior_simple_normal <- function(parameters, data){ sum(stats::dnorm(data$x, parameters[["m"]], parameters[["s"]], log = TRUE)) } marglik_simple_normal <- JAGS_bridgesampling(fit_simple_normal, - log_posterior = log_posterior_simple_normal, - data = data, prior_list = priors_simple_normal) + log_posterior = log_posterior_simple_normal, + data = data, prior_list = priors_simple_normal) result <- save_fit(fit_simple_normal, "fit_simple_normal", - marglik = marglik_simple_normal, - simple_priors = TRUE, - note = "Normal and truncated normal priors with data") + marglik = marglik_simple_normal, + simple_priors = TRUE, + note = "Normal and truncated normal priors with data") model_registry[["fit_simple_normal"]] <<- result$registry_entry fit_simple_normal <- result$fit @@ -116,13 +116,13 @@ test_that("Simple prior models fit correctly", { # Compute marginal likelihood for model averaging marglik_simple_spike <- JAGS_bridgesampling(fit_simple_spike, - log_posterior = log_posterior_simple_normal, - data = data, prior_list = priors_simple_spike) + log_posterior = log_posterior_simple_normal, + data = data, prior_list = priors_simple_spike) result <- save_fit(fit_simple_spike, "fit_simple_spike", - marglik = marglik_simple_spike, - simple_priors = TRUE, - note = "Spike and truncated normal priors with data (for model averaging)") + marglik = marglik_simple_spike, + simple_priors = TRUE, + note = "Spike and truncated normal priors with data (for model averaging)") model_registry[["fit_simple_spike"]] <<- result$registry_entry fit_simple_spike <- result$fit @@ -143,10 +143,10 @@ test_that("Simple prior models fit correctly", { model_syntax_simple <- "model{}" fit_simple_various <- suppressWarnings(JAGS_fit(model_syntax_simple, data = NULL, prior_list = priors_various, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_simple_various, "fit_simple_various", - simple_priors = TRUE, - note = "Various univariate distributions: normal, lognormal, t, Cauchy, gamma, invgamma, exp, beta, uniform, point") + simple_priors = TRUE, + note = "Various univariate distributions: normal, lognormal, t, Cauchy, gamma, invgamma, exp, beta, uniform, point") model_registry[["fit_simple_various"]] <<- result$registry_entry fit_simple_various <- result$fit @@ -159,10 +159,10 @@ test_that("Simple prior models fit correctly", { model_syntax_pb <- "model{}" fit_simple_pub_bias <- suppressWarnings(JAGS_fit(model_syntax_pb, data = NULL, prior_list = priors_pub_bias, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_simple_pub_bias, "fit_simple_pub_bias", - pub_bias_priors = TRUE, - note = "PET and PEESE priors for publication bias") + pub_bias_priors = TRUE, + note = "PET and PEESE priors for publication bias") model_registry[["fit_simple_pub_bias"]] <<- result$registry_entry fit_simple_pub_bias <- result$fit @@ -173,10 +173,10 @@ test_that("Simple prior models fit correctly", { model_syntax_thin <- "model{}" fit_simple_thin <- suppressWarnings(JAGS_fit(model_syntax_thin, data = NULL, prior_list = priors_thin, - chains = 2, adapt = 100, burnin = 150, sample = 300, thin = 3, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 300, thin = 3, seed = 2)) result <- save_fit(fit_simple_thin, "fit_simple_thin", - simple_priors = TRUE, thinning = TRUE, - note = "Simple normal prior with thinning parameter (thin=3)") + simple_priors = TRUE, thinning = TRUE, + note = "Simple normal prior with thinning parameter (thin=3)") model_registry[["fit_simple_thin"]] <<- result$registry_entry fit_simple_thin <- result$fit @@ -229,9 +229,9 @@ test_that("Summary tables models fit correctly", { data = data_summary, prior_list = priors_summary0) result <- save_fit(fit_summary0, "fit_summary0", - marglik = marglik_summary0, - simple_priors = TRUE, weightfunction_priors = TRUE, - note = "Model for summary tables with no weightfunction") + marglik = marglik_summary0, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with no weightfunction") model_registry[["fit_summary0"]] <<- result$registry_entry fit_summary0 <- result$fit @@ -249,9 +249,9 @@ test_that("Summary tables models fit correctly", { data = data_summary, prior_list = priors_summary1) result <- save_fit(fit_summary1, "fit_summary1", - marglik = marglik_summary1, - simple_priors = TRUE, weightfunction_priors = TRUE, - note = "Model for summary tables with one-sided weightfunction (cutpoint at .05)") + marglik = marglik_summary1, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with one-sided weightfunction (cutpoint at .05)") model_registry[["fit_summary1"]] <<- result$registry_entry fit_summary1 <- result$fit @@ -269,9 +269,9 @@ test_that("Summary tables models fit correctly", { data = data_summary, prior_list = priors_summary2) result <- save_fit(fit_summary2, "fit_summary2", - marglik = marglik_summary2, - simple_priors = TRUE, weightfunction_priors = TRUE, - note = "Model for summary tables with one-sided weightfunction (cutpoints at .05, .50)") + marglik = marglik_summary2, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with one-sided weightfunction (cutpoints at .05, .50)") model_registry[["fit_summary2"]] <<- result$registry_entry fit_summary2 <- result$fit @@ -289,9 +289,9 @@ test_that("Summary tables models fit correctly", { data = data_summary, prior_list = priors_summary3) result <- save_fit(fit_summary3, "fit_summary3", - marglik = marglik_summary3, - simple_priors = TRUE, weightfunction_priors = TRUE, - note = "Model for summary tables with fixed weightfunction") + marglik = marglik_summary3, + simple_priors = TRUE, weightfunction_priors = TRUE, + note = "Model for summary tables with fixed weightfunction") model_registry[["fit_summary3"]] <<- result$registry_entry fit_summary3 <- result$fit @@ -317,10 +317,10 @@ test_that("Vector prior models fit correctly", { model_syntax_vec <- "model{}" fit_vector_mnormal <- suppressWarnings(JAGS_fit(model_syntax_vec, data = NULL, prior_list = priors_mnormal, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_vector_mnormal, "fit_vector_mnormal", - vector_priors = TRUE, - note = "Multivariate normal prior (K=3)") + vector_priors = TRUE, + note = "Multivariate normal prior (K=3)") model_registry[["fit_vector_mnormal"]] <<- result$registry_entry fit_vector_mnormal <- result$fit @@ -332,10 +332,10 @@ test_that("Vector prior models fit correctly", { model_syntax_mc <- "model{}" fit_vector_mcauchy <- suppressWarnings(JAGS_fit(model_syntax_mc, data = NULL, prior_list = priors_mcauchy, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_vector_mcauchy, "fit_vector_mcauchy", - vector_priors = TRUE, - note = "Multivariate Cauchy prior (K=2)") + vector_priors = TRUE, + note = "Multivariate Cauchy prior (K=2)") model_registry[["fit_vector_mcauchy"]] <<- result$registry_entry fit_vector_mcauchy <- result$fit @@ -347,10 +347,10 @@ test_that("Vector prior models fit correctly", { model_syntax_mt <- "model{}" fit_vector_mt <- suppressWarnings(JAGS_fit(model_syntax_mt, data = NULL, prior_list = priors_mt, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_vector_mt, "fit_vector_mt", - vector_priors = TRUE, - note = "Multivariate t prior with df=5 (K=2)") + vector_priors = TRUE, + note = "Multivariate t prior with df=5 (K=2)") model_registry[["fit_vector_mt"]] <<- result$registry_entry fit_vector_mt <- result$fit @@ -377,10 +377,10 @@ test_that("Factor prior models fit correctly", { model_syntax_orth <- "model{}" fit_factor_orthonormal <- suppressWarnings(JAGS_fit(model_syntax_orth, data = NULL, prior_list = priors_orthonormal, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_factor_orthonormal, "fit_factor_orthonormal", - factor_priors = TRUE, - note = "Orthonormal contrast with 3 levels") + factor_priors = TRUE, + note = "Orthonormal contrast with 3 levels") model_registry[["fit_factor_orthonormal"]] <<- result$registry_entry fit_factor_orthonormal <- result$fit @@ -393,10 +393,10 @@ test_that("Factor prior models fit correctly", { model_syntax_treat <- "model{}" fit_factor_treatment <- suppressWarnings(JAGS_fit(model_syntax_treat, data = NULL, prior_list = priors_treatment, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_factor_treatment, "fit_factor_treatment", - factor_priors = TRUE, - note = "Treatment contrast with 2 levels and beta prior") + factor_priors = TRUE, + note = "Treatment contrast with 2 levels and beta prior") model_registry[["fit_factor_treatment"]] <<- result$registry_entry fit_factor_treatment <- result$fit @@ -409,10 +409,10 @@ test_that("Factor prior models fit correctly", { model_syntax_ind <- "model{}" fit_factor_independent <- suppressWarnings(JAGS_fit(model_syntax_ind, data = NULL, prior_list = priors_independent, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_factor_independent, "fit_factor_independent", - factor_priors = TRUE, - note = "Independent contrast with 3 levels and gamma prior") + factor_priors = TRUE, + note = "Independent contrast with 3 levels and gamma prior") model_registry[["fit_factor_independent"]] <<- result$registry_entry fit_factor_independent <- result$fit @@ -425,10 +425,10 @@ test_that("Factor prior models fit correctly", { model_syntax_md <- "model{}" fit_factor_meandif <- suppressWarnings(JAGS_fit(model_syntax_md, data = NULL, prior_list = priors_meandif, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) result <- save_fit(fit_factor_meandif, "fit_factor_meandif", - factor_priors = TRUE, - note = "Meandif contrast with 3 levels") + factor_priors = TRUE, + note = "Meandif contrast with 3 levels") model_registry[["fit_factor_meandif"]] <<- result$registry_entry fit_factor_meandif <- result$fit @@ -454,10 +454,10 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf1 <- "model{}" fit_weightfunction_onesided2 <- suppressWarnings(JAGS_fit(model_syntax_wf1, data = NULL, prior_list = priors_wf_onesided2, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_weightfunction_onesided2, "fit_weightfunction_onesided2", - weightfunction_priors = TRUE, - note = "One-sided weightfunction with 2 intervals (cutpoint at .05)") + weightfunction_priors = TRUE, + note = "One-sided weightfunction with 2 intervals (cutpoint at .05)") model_registry[["fit_weightfunction_onesided2"]] <<- result$registry_entry fit_weightfunction_onesided2 <- result$fit @@ -469,10 +469,10 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf2 <- "model{}" fit_weightfunction_onesided3 <- suppressWarnings(JAGS_fit(model_syntax_wf2, data = NULL, prior_list = priors_wf_onesided3, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_weightfunction_onesided3, "fit_weightfunction_onesided3", - weightfunction_priors = TRUE, - note = "One-sided weightfunction with 3 intervals (cutpoints at .05, .10)") + weightfunction_priors = TRUE, + note = "One-sided weightfunction with 3 intervals (cutpoints at .05, .10)") model_registry[["fit_weightfunction_onesided3"]] <<- result$registry_entry fit_weightfunction_onesided3 <- result$fit @@ -484,10 +484,10 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf3 <- "model{}" fit_weightfunction_twosided <- suppressWarnings(JAGS_fit(model_syntax_wf3, data = NULL, prior_list = priors_wf_twosided, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_weightfunction_twosided, "fit_weightfunction_twosided", - weightfunction_priors = TRUE, - note = "Two-sided weightfunction with cutpoint at .05") + weightfunction_priors = TRUE, + note = "Two-sided weightfunction with cutpoint at .05") model_registry[["fit_weightfunction_twosided"]] <<- result$registry_entry fit_weightfunction_twosided <- result$fit @@ -499,10 +499,10 @@ test_that("Weightfunction prior models fit correctly", { model_syntax_wf4 <- "model{}" fit_weightfunction_fixed <- suppressWarnings(JAGS_fit(model_syntax_wf4, data = NULL, prior_list = priors_wf_fixed, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4)) result <- save_fit(fit_weightfunction_fixed, "fit_weightfunction_fixed", - weightfunction_priors = TRUE, - note = "One-sided fixed weightfunction (weights: 1, .5)") + weightfunction_priors = TRUE, + note = "One-sided fixed weightfunction (weights: 1, .5)") model_registry[["fit_weightfunction_fixed"]] <<- result$registry_entry fit_weightfunction_fixed <- result$fit @@ -523,23 +523,23 @@ test_that("Spike-and-slab prior models fit correctly", { # Simple spike-and-slab priors_spike_slab_simple <- list( "mu" = prior_spike_and_slab(prior("normal", list(0, 1)), - prior_inclusion = prior("beta", list(1,1))) + prior_inclusion = prior("beta", list(1,1))) ) model_syntax_ss1 <- "model{}" fit_spike_slab_simple <- suppressWarnings(JAGS_fit(model_syntax_ss1, data = NULL, prior_list = priors_spike_slab_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_spike_slab_simple, "fit_spike_slab_simple", - spike_and_slab_priors = TRUE, - note = "Simple spike-and-slab with normal alternative and beta inclusion prior") + spike_and_slab_priors = TRUE, + note = "Simple spike-and-slab with normal alternative and beta inclusion prior") model_registry[["fit_spike_slab_simple"]] <<- result$registry_entry fit_spike_slab_simple <- result$fit # Spike-and-slab with factor prior priors_spike_slab_factor <- list( "beta" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - prior_inclusion = prior("beta", list(1,1))) + prior_inclusion = prior("beta", list(1,1))) ) # Set levels attribute on the factor prior component within the spike_and_slab mixture @@ -552,10 +552,10 @@ test_that("Spike-and-slab prior models fit correctly", { model_syntax_ss2 <- "model{}" fit_spike_slab_factor <- suppressWarnings(JAGS_fit(model_syntax_ss2, data = NULL, prior_list = priors_spike_slab_factor, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_spike_slab_factor, "fit_spike_slab_factor", - spike_and_slab_priors = TRUE, factor_priors = TRUE, - note = "Spike-and-slab with orthonormal factor prior (3 levels) as alternative") + spike_and_slab_priors = TRUE, factor_priors = TRUE, + note = "Spike-and-slab with orthonormal factor prior (3 levels) as alternative") model_registry[["fit_spike_slab_factor"]] <<- result$registry_entry fit_spike_slab_factor <- result$fit @@ -586,10 +586,10 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix1 <- "model{}" fit_mixture_simple <- suppressWarnings(JAGS_fit(model_syntax_mix1, data = NULL, prior_list = priors_mixture_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_mixture_simple, "fit_mixture_simple", - mixture_priors = TRUE, - note = "Mixture of 3 components (2 normals, 1 gamma) with is_null flags") + mixture_priors = TRUE, + note = "Mixture of 3 components (2 normals, 1 gamma) with is_null flags") model_registry[["fit_mixture_simple"]] <<- result$registry_entry fit_mixture_simple <- result$fit @@ -607,10 +607,10 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix2 <- "model{}" fit_mixture_components <- suppressWarnings(JAGS_fit(model_syntax_mix2, data = NULL, prior_list = priors_mixture_components, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_mixture_components, "fit_mixture_components", - mixture_priors = TRUE, - note = "Mixture with named components (a, b)") + mixture_priors = TRUE, + note = "Mixture with named components (a, b)") model_registry[["fit_mixture_components"]] <<- result$registry_entry fit_mixture_components <- result$fit @@ -627,10 +627,10 @@ test_that("Mixture prior models fit correctly", { model_syntax_mix3 <- "model{}" fit_mixture_spike <- suppressWarnings(JAGS_fit(model_syntax_mix3, data = NULL, prior_list = priors_mixture_spike, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_mixture_spike, "fit_mixture_spike", - mixture_priors = TRUE, - note = "Mixture containing spike prior at value 2") + mixture_priors = TRUE, + note = "Mixture containing spike prior at value 2") model_registry[["fit_mixture_spike"]] <<- result$registry_entry fit_mixture_spike <- result$fit @@ -695,9 +695,9 @@ test_that("Simple formula-based regression models fit correctly", { formula_prior_list = formula_prior_list_simple) result <- save_fit(fit_formula_simple, "fit_formula_simple", - marglik = marglik_formula_simple, - formulas = TRUE, simple_priors = TRUE, - note = "Simple linear regression with continuous predictor") + marglik = marglik_formula_simple, + formulas = TRUE, simple_priors = TRUE, + note = "Simple linear regression with continuous predictor") model_registry[["fit_formula_simple"]] <<- result$registry_entry fit_formula_simple <- result$fit @@ -726,9 +726,9 @@ test_that("Simple formula-based regression models fit correctly", { formula_prior_list = formula_prior_list_treatment) result <- save_fit(fit_formula_treatment, "fit_formula_treatment", - marglik = marglik_formula_treatment, - formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Regression with continuous predictor and 2-level treatment factor") + marglik = marglik_formula_treatment, + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with continuous predictor and 2-level treatment factor") model_registry[["fit_formula_treatment"]] <<- result$registry_entry fit_formula_treatment <- result$fit @@ -757,9 +757,9 @@ test_that("Simple formula-based regression models fit correctly", { formula_prior_list = formula_prior_list_orthonormal) result <- save_fit(fit_formula_orthonormal, "fit_formula_orthonormal", - marglik = marglik_formula_orthonormal, - formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Regression with continuous predictor and 3-level orthonormal factor") + marglik = marglik_formula_orthonormal, + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with continuous predictor and 3-level orthonormal factor") model_registry[["fit_formula_orthonormal"]] <<- result$registry_entry fit_formula_orthonormal <- result$fit @@ -815,8 +815,8 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_cont_int, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) result <- save_fit(fit_formula_interaction_cont, "fit_formula_interaction_cont", - formulas = TRUE, interactions = TRUE, simple_priors = TRUE, - note = "Continuous-continuous interaction") + formulas = TRUE, interactions = TRUE, simple_priors = TRUE, + note = "Continuous-continuous interaction") model_registry[["fit_formula_interaction_cont"]] <<- result$registry_entry fit_formula_interaction_cont <- result$fit @@ -849,9 +849,9 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_mix_int) result <- save_fit(fit_formula_interaction_mix, "fit_formula_interaction_mix", - marglik = marglik_formula_interaction_mix, - formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Continuous-factor interaction with 3-level orthonormal factor") + marglik = marglik_formula_interaction_mix, + formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Continuous-factor interaction with 3-level orthonormal factor") model_registry[["fit_formula_interaction_mix"]] <<- result$registry_entry fit_formula_interaction_mix <- result$fit @@ -879,9 +879,9 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_mix_main) result <- save_fit(fit_formula_interaction_mix_main, "fit_formula_interaction_mix_main", - marglik = marglik_formula_interaction_mix_main, - formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Continuous-factor main effects only (for interaction test)") + marglik = marglik_formula_interaction_mix_main, + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Continuous-factor main effects only (for interaction test)") model_registry[["fit_formula_interaction_mix_main"]] <<- result$registry_entry fit_formula_interaction_mix_main <- result$fit @@ -903,8 +903,8 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_fac_int, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) result <- save_fit(fit_formula_interaction_fac, "fit_formula_interaction_fac", - formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Factor-factor interaction: 2-level treatment x 3-level orthonormal") + formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Factor-factor interaction: 2-level treatment x 3-level orthonormal") model_registry[["fit_formula_interaction_fac"]] <<- result$registry_entry fit_formula_interaction_fac <- result$fit @@ -939,8 +939,8 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_factor_mix, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 4) result <- save_fit(fit_formula_factor_mixture, "fit_formula_factor_mixture", - formulas = TRUE, mixture_priors = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Regression with mixture prior on 3-level treatment factor (spike vs normal)") + formulas = TRUE, mixture_priors = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Regression with mixture prior on 3-level treatment factor (spike vs normal)") model_registry[["fit_formula_factor_mixture"]] <<- result$registry_entry fit_formula_factor_mixture <- result$fit @@ -1007,8 +1007,8 @@ test_that("Multi-formula models fit correctly", { formula_prior_list = formula_prior_list_multi, chains = 2, adapt = 500, burnin = 500, sample = 500, seed = 1) result <- save_fit(fit_formula_multi, "fit_formula_multi", - formulas = TRUE, multi_formula = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Two formulas: mu (continuous) and sigma_exp (meandif factor)") + formulas = TRUE, multi_formula = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Two formulas: mu (continuous) and sigma_exp (meandif factor)") model_registry[["fit_formula_multi"]] <<- result$registry_entry fit_formula_multi <- result$fit @@ -1063,8 +1063,8 @@ test_that("Random effects models fit correctly", { formula_prior_list = formula_prior_list_re_int, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) result <- save_fit(fit_random_intercept, "fit_random_intercept", - formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, - note = "Random intercept model (uncorrelated random effects)") + formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, + note = "Random intercept model (uncorrelated random effects)") model_registry[["fit_random_intercept"]] <<- result$registry_entry fit_random_intercept <- result$fit @@ -1084,8 +1084,8 @@ test_that("Random effects models fit correctly", { formula_prior_list = formula_prior_list_re_slope, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) result <- save_fit(fit_random_slope, "fit_random_slope", - formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, - note = "Random slope for continuous predictor (no random intercept)") + formulas = TRUE, random_effects = TRUE, simple_priors = TRUE, + note = "Random slope for continuous predictor (no random intercept)") model_registry[["fit_random_slope"]] <<- result$registry_entry fit_random_slope <- result$fit @@ -1107,8 +1107,8 @@ test_that("Random effects models fit correctly", { formula_prior_list = formula_prior_list_re_fac, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) result <- save_fit(fit_random_factor_slope, "fit_random_factor_slope", - formulas = TRUE, random_effects = TRUE, factor_priors = TRUE, simple_priors = TRUE, - note = "Random factor slopes with random intercept") + formulas = TRUE, random_effects = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Random factor slopes with random intercept") model_registry[["fit_random_factor_slope"]] <<- result$registry_entry fit_random_factor_slope <- result$fit @@ -1163,78 +1163,16 @@ test_that("Spike factor prior models fit correctly", { formula_prior_list = formula_prior_list_spike, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) result <- save_fit(fit_spike_factors, "fit_spike_factors", - formulas = TRUE, factor_priors = TRUE, - note = "Spike priors with all 4 contrast types: independent, orthonormal, treatment, meandif") + formulas = TRUE, factor_priors = TRUE, + note = "Spike priors with all 4 contrast types: independent, orthonormal, treatment, meandif") model_registry[["fit_spike_factors"]] <<- result$registry_entry fit_spike_factors <- result$fit - # Spike vs Normal factor (meandif contrast) - # ------------------------------------------------------- - formula_list_sf <- list(mu = ~ x_fac3md) - formula_data_list_sf <- list(mu = data_formula) - - # Log posterior for formula models - log_posterior_formula <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - # Null model (Spike) - formula_prior_list_sf_null <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) - ) - ) - - fit_spike_factors_null <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, - formula_prior_list = formula_prior_list_sf_null, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - - marglik_spike_factors_null <- JAGS_bridgesampling( - fit_spike_factors_null, log_posterior = log_posterior_formula, data = data, - prior_list = prior_list, - formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, - formula_prior_list = formula_prior_list_sf_null) - - result <- save_fit(fit_spike_factors_null, "fit_spike_factors_null", - marglik = marglik_spike_factors_null, - formulas = TRUE, factor_priors = TRUE, - note = "Spike factor prior (meandif)") - model_registry[["fit_spike_factors_null"]] <<- result$registry_entry - fit_spike_factors_null <- result$fit - - # Alternative model (Normal) - formula_prior_list_sf_alt <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) - ) - ) - - fit_spike_factors_alt <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, - formula_prior_list = formula_prior_list_sf_alt, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) - - marglik_spike_factors_alt <- JAGS_bridgesampling( - fit_spike_factors_alt, log_posterior = log_posterior_formula, data = data, - prior_list = prior_list, - formula_list = formula_list_sf, formula_data_list = formula_data_list_sf, - formula_prior_list = formula_prior_list_sf_alt) - - result <- save_fit(fit_spike_factors_alt, "fit_spike_factors_alt", - marglik = marglik_spike_factors_alt, - formulas = TRUE, factor_priors = TRUE, - note = "Normal factor prior (meandif)") - model_registry[["fit_spike_factors_alt"]] <<- result$registry_entry - fit_spike_factors_alt <- result$fit + # NOTE: fit_spike_factors_null and fit_spike_factors_alt have been removed + # because they are now replaced by fit_marginal_0 and fit_marginal_1 + # (which have the same meandif factor structure plus additional features) expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors_null.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors_alt.RDS"))) }) @@ -1309,9 +1247,9 @@ test_that("Joint complex models fit correctly", { formula_prior_list = formula_prior_list_joint, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) result <- save_fit(fit_joint_complex, "fit_joint_complex", - formulas = TRUE, mixture_priors = TRUE, spike_and_slab_priors = TRUE, - factor_priors = TRUE, simple_priors = TRUE, - note = "Complex model: mixture intercept, mixture sigma, spike-and-slab continuous, spike-and-slab factor") + formulas = TRUE, mixture_priors = TRUE, spike_and_slab_priors = TRUE, + factor_priors = TRUE, simple_priors = TRUE, + note = "Complex model: mixture intercept, mixture sigma, spike-and-slab continuous, spike-and-slab factor") model_registry[["fit_joint_complex"]] <<- result$registry_entry fit_joint_complex <- result$fit @@ -1335,10 +1273,10 @@ test_that("Expression prior models fit correctly", { model_syntax_expr1 <- "model{}" fit_expression_simple <- suppressWarnings(JAGS_fit(model_syntax_expr1, data = NULL, prior_list = priors_expr_simple, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1)) result <- save_fit(fit_expression_simple, "fit_expression_simple", - expression_priors = TRUE, simple_priors = TRUE, - note = "Normal prior with expression referencing another parameter (x_sigma)") + expression_priors = TRUE, simple_priors = TRUE, + note = "Normal prior with expression referencing another parameter (x_sigma)") model_registry[["fit_expression_simple"]] <<- result$registry_entry fit_expression_simple <- result$fit @@ -1353,10 +1291,10 @@ test_that("Expression prior models fit correctly", { model_syntax_expr2 <- "model{}" fit_expression_spike_slab <- suppressWarnings(JAGS_fit(model_syntax_expr2, data = NULL, prior_list = priors_expr_ss, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2)) result <- save_fit(fit_expression_spike_slab, "fit_expression_spike_slab", - expression_priors = TRUE, spike_and_slab_priors = TRUE, simple_priors = TRUE, - note = "Spike-and-slab with expression in alternative prior") + expression_priors = TRUE, spike_and_slab_priors = TRUE, simple_priors = TRUE, + note = "Spike-and-slab with expression in alternative prior") model_registry[["fit_expression_spike_slab"]] <<- result$registry_entry fit_expression_spike_slab <- result$fit @@ -1372,10 +1310,10 @@ test_that("Expression prior models fit correctly", { model_syntax_expr3 <- "model{}" fit_expression_mixture <- suppressWarnings(JAGS_fit(model_syntax_expr3, data = NULL, prior_list = priors_expr_mix, - chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3)) result <- save_fit(fit_expression_mixture, "fit_expression_mixture", - expression_priors = TRUE, mixture_priors = TRUE, simple_priors = TRUE, - note = "Mixture prior with expression in one component") + expression_priors = TRUE, mixture_priors = TRUE, simple_priors = TRUE, + note = "Mixture prior with expression in one component") model_registry[["fit_expression_mixture"]] <<- result$registry_entry fit_expression_mixture <- result$fit @@ -1420,11 +1358,11 @@ test_that("Advanced JAGS_fit features work correctly", { }" fit_add_parameters <- JAGS_fit(model_syntax_add_param, data, priors_list, - add_parameters = "g", - chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 1) + add_parameters = "g", + chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 1) result <- save_fit(fit_add_parameters, "fit_add_parameters", - simple_priors = TRUE, add_parameters = TRUE, - note = "Model with additional monitored parameter 'g' not in prior_list") + simple_priors = TRUE, add_parameters = TRUE, + note = "Model with additional monitored parameter 'g' not in prior_list") model_registry[["fit_add_parameters"]] <<- result$registry_entry fit_add_parameters <- result$fit @@ -1454,11 +1392,11 @@ test_that("Advanced JAGS_fit features work correctly", { # First fit without autofit (should have poor convergence) fit_no_autofit <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, - autofit = FALSE, - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) + autofit = FALSE, + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) result <- save_fit(fit_no_autofit, "fit_no_autofit", - simple_priors = TRUE, - note = "Model without autofit (poor convergence expected)") + simple_priors = TRUE, + note = "Model without autofit (poor convergence expected)") model_registry[["fit_no_autofit"]] <<- result$registry_entry fit_no_autofit <- result$fit @@ -1468,12 +1406,12 @@ test_that("Advanced JAGS_fit features work correctly", { # Now fit with autofit using max_error criterion fit_autofit_error <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, - autofit = TRUE, - autofit_control = list(max_error = 0.05, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) + autofit = TRUE, + autofit_control = list(max_error = 0.05, sample_extend = 100), + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 2) result <- save_fit(fit_autofit_error, "fit_autofit_error", - simple_priors = TRUE, autofit = TRUE, - note = "Autofit with max_error criterion (< 0.05)") + simple_priors = TRUE, autofit = TRUE, + note = "Autofit with max_error criterion (< 0.05)") model_registry[["fit_autofit_error"]] <<- result$registry_entry fit_autofit_error <- result$fit @@ -1483,12 +1421,12 @@ test_that("Advanced JAGS_fit features work correctly", { # Test autofit with min_ESS criterion fit_autofit_ess <- JAGS_fit(model_syntax_autofit, data_autofit, priors_autofit, - autofit = TRUE, - autofit_control = list(min_ESS = 200, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 3) + autofit = TRUE, + autofit_control = list(min_ESS = 200, sample_extend = 100), + chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 3) result <- save_fit(fit_autofit_ess, "fit_autofit_ess", - simple_priors = TRUE, autofit = TRUE, - note = "Autofit with min_ESS criterion (> 200)") + simple_priors = TRUE, autofit = TRUE, + note = "Autofit with min_ESS criterion (> 200)") model_registry[["fit_autofit_ess"]] <<- result$registry_entry fit_autofit_ess <- result$fit @@ -1501,8 +1439,8 @@ test_that("Advanced JAGS_fit features work correctly", { parallel = TRUE, cores = 2, chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 4) result <- save_fit(fit_parallel, "fit_parallel", - simple_priors = TRUE, parallel = TRUE, - note = "Model fitted with parallel chains (cores=2)") + simple_priors = TRUE, parallel = TRUE, + note = "Model fitted with parallel chains (cores=2)") model_registry[["fit_parallel"]] <<- result$registry_entry fit_parallel <- result$fit @@ -1518,6 +1456,439 @@ test_that("Advanced JAGS_fit features work correctly", { }) +# ============================================================================ # +# SECTION 15: MODELS FOR MARGINAL DISTRIBUTION TESTING +# ============================================================================ # +# These models test marginal_posterior, ensemble_inference, and mix_posteriors +# with complex formulas including interactions and multiply_by scaling. +test_that("Marginal distribution models fit correctly", { + + skip_if_not_installed("rjags") + + skip_if_not_installed("bridgesampling") + + set.seed(1) + data_formula_marg <- data.frame( + x_cont1 = rnorm(180), + x_fac2t = factor(rep(c("A", "B"), 90), levels = c("A", "B")), + x_fac3md = factor(rep(c("A", "B", "C"), 60), levels = c("A", "B", "C")) + ) + data_marg <- list( + y = rnorm(180, 0.1, 0.5) + 0.5 + 0.20 * data_formula_marg$x_cont1 + + ifelse(data_formula_marg$x_fac3md == "A", 0.15, ifelse(data_formula_marg$x_fac3md == "B", -0.15, 0)), + N = 180 + ) + + # Null model: spike priors on factor effects + prior_list_marg_0 <- list( + "intercept" = prior("normal", list(0, 1)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac2t" = prior_factor("spike", contrast = "treatment", list(0)), + "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)), + "x_cont1:x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) + ) + attr(prior_list_marg_0$x_cont1, "multiply_by") <- "sigma" + + # Alternative model: normal priors on factor effects + prior_list_marg_1 <- list( + "intercept" = prior("normal", list(0, 1)), + "x_cont1" = prior("normal", list(0, 1)), + "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1.00)), + "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)), + "x_cont1:x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) + ) + attr(prior_list_marg_1$x_cont1, "multiply_by") <- "sigma" + + prior_list_marg <- list( + "sigma" = prior("cauchy", list(0, 1), list(0, 5)) + ) + model_syntax_marg <- paste0( + "model{", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + log_posterior_marg <- function(parameters, data){ + return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) + } + model_formula_marg <- list(mu = ~ x_cont1 + x_fac2t + x_cont1*x_fac3md) + + # Fit null model + fit_marginal_0 <- JAGS_fit( + model_syntax = model_syntax_marg, data = data_marg, + prior_list = prior_list_marg, + formula_list = model_formula_marg, + formula_prior_list = list(mu = prior_list_marg_0), + formula_data_list = list(mu = data_formula_marg), + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + + marglik_marginal_0 <- JAGS_bridgesampling( + fit = fit_marginal_0, + log_posterior = log_posterior_marg, + data = data_marg, + prior_list = prior_list_marg, + formula_list = model_formula_marg, + formula_prior_list = list(mu = prior_list_marg_0), + formula_data_list = list(mu = data_formula_marg)) + + result <- save_fit(fit_marginal_0, "fit_marginal_0", + marglik = marglik_marginal_0, + formulas = TRUE, factor_priors = TRUE, interactions = TRUE, + note = "Marginal dist null model: spike priors on factors with interaction and multiply_by") + model_registry[["fit_marginal_0"]] <<- result$registry_entry + fit_marginal_0 <- result$fit + + # Fit alternative model + fit_marginal_1 <- JAGS_fit( + model_syntax = model_syntax_marg, data = data_marg, + prior_list = prior_list_marg, + formula_list = model_formula_marg, + formula_prior_list = list(mu = prior_list_marg_1), + formula_data_list = list(mu = data_formula_marg), + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + marglik_marginal_1 <- JAGS_bridgesampling( + fit = fit_marginal_1, + log_posterior = log_posterior_marg, + data = data_marg, + prior_list = prior_list_marg, + formula_list = model_formula_marg, + formula_prior_list = list(mu = prior_list_marg_1), + formula_data_list = list(mu = data_formula_marg)) + + result <- save_fit(fit_marginal_1, "fit_marginal_1", + marglik = marglik_marginal_1, + formulas = TRUE, factor_priors = TRUE, interactions = TRUE, + note = "Marginal dist alt model: normal priors on factors with interaction and multiply_by") + model_registry[["fit_marginal_1"]] <<- result$registry_entry + fit_marginal_1 <- result$fit + + # Spike-and-slab/mixture model for marginal distributions + prior_list_marg_ss <- list( + "intercept" = prior("normal", list(0, 1)), + "x_cont1" = prior_mixture(list( + prior("spike", list(0)), + prior("normal", list(0, 1)) + ), is_null = c(T, F)), + "x_fac2t" = prior_spike_and_slab(prior_factor("normal", contrast = "treatment", list(0, 1.00))), + "x_fac3md" = prior_spike_and_slab(prior_factor("mnormal", contrast = "meandif", list(0, 0.25))), + "x_cont1:x_fac3md" = prior_spike_and_slab(prior_factor("mnormal", contrast = "meandif", list(0, 0.25))) + ) + attr(prior_list_marg_ss$x_cont1, "multiply_by") <- "sigma" + + fit_marginal_ss <- JAGS_fit( + model_syntax = model_syntax_marg, data = data_marg, + prior_list = prior_list_marg, + formula_list = model_formula_marg, + formula_prior_list = list(mu = prior_list_marg_ss), + formula_data_list = list(mu = data_formula_marg), + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + + result <- save_fit(fit_marginal_ss, "fit_marginal_ss", + formulas = TRUE, factor_priors = TRUE, interactions = TRUE, + spike_and_slab_priors = TRUE, mixture_priors = TRUE, + note = "Marginal dist model: spike-and-slab and mixture priors with interaction and multiply_by") + model_registry[["fit_marginal_ss"]] <<- result$registry_entry + fit_marginal_ss <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_0.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_1.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_ss.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS"))) +}) + + +# ============================================================================ # +# SECTION: MODELS FOR ENSEMBLE PLOTS TESTING +# ============================================================================ # +test_that("PET-PEESE models fit correctly", { + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + set.seed(1) + data <- NULL + model_syntax <- "model{}" + log_posterior <- function(parameters, data){ return(0) } + + # PET model + priors_pet <- list( + mu = prior("spike", list(0)), + PET = prior_PET("normal", list(0, .2)) + ) + fit_pet <- suppressWarnings(JAGS_fit(model_syntax, data, priors_pet, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 0)) + marglik_pet <- JAGS_bridgesampling(fit_pet, log_posterior = log_posterior, data = data, prior_list = priors_pet) + result <- save_fit(fit_pet, "fit_pet", marglik = marglik_pet, pub_bias_priors = TRUE, note = "PET prior only") + model_registry[["fit_pet"]] <<- result$registry_entry + + # PEESE model + priors_peese <- list( + mu = prior("spike", list(0)), + PEESE = prior_PEESE("normal", list(0, .8)) + ) + fit_peese <- suppressWarnings(JAGS_fit(model_syntax, data, priors_peese, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) + marglik_peese <- JAGS_bridgesampling(fit_peese, log_posterior = log_posterior, data = data, prior_list = priors_peese) + result <- save_fit(fit_peese, "fit_peese", marglik = marglik_peese, pub_bias_priors = TRUE, note = "PEESE prior only") + model_registry[["fit_peese"]] <<- result$registry_entry + + # Missing model (overwhelming) + priors_missing <- list( + mu = prior("normal", list(.2, .2), prior_weights = 4) + ) + fit_missing <- suppressWarnings(JAGS_fit(model_syntax, data, priors_missing, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) + marglik_missing <- JAGS_bridgesampling(fit_missing, log_posterior = log_posterior, data = data, prior_list = priors_missing) + result <- save_fit(fit_missing, "fit_missing", marglik = marglik_missing, simple_priors = TRUE, note = "Overwhelming missing model") + model_registry[["fit_missing"]] <<- result$registry_entry + + expect_true(file.exists(file.path(temp_fits_dir, "fit_pet.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_peese.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_missing.RDS"))) +}) + +test_that("Weightfunction models fit correctly", { + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + set.seed(1) + data <- NULL + model_syntax <- "model{}" + log_posterior <- function(parameters, data){ return(0) } + + # One-sided + priors_wf_onesided <- list( + omega = prior_weightfunction("one.sided", list(c(.025), c(1, 1))) + ) + fit_wf_onesided <- suppressWarnings(JAGS_fit(model_syntax, data, priors_wf_onesided, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 0)) + marglik_wf_onesided <- JAGS_bridgesampling(fit_wf_onesided, log_posterior = log_posterior, data = data, prior_list = priors_wf_onesided) + result <- save_fit(fit_wf_onesided, "fit_wf_onesided", marglik = marglik_wf_onesided, weightfunction_priors = TRUE, note = "One-sided weightfunction") + model_registry[["fit_wf_onesided"]] <<- result$registry_entry + + # Two-sided + priors_wf_twosided <- list( + omega = prior_weightfunction("two.sided", list(c(.05), c(1, 1))) + ) + fit_wf_twosided <- suppressWarnings(JAGS_fit(model_syntax, data, priors_wf_twosided, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) + marglik_wf_twosided <- JAGS_bridgesampling(fit_wf_twosided, log_posterior = log_posterior, data = data, prior_list = priors_wf_twosided) + result <- save_fit(fit_wf_twosided, "fit_wf_twosided", marglik = marglik_wf_twosided, weightfunction_priors = TRUE, note = "Two-sided weightfunction") + model_registry[["fit_wf_twosided"]] <<- result$registry_entry + + # Missing model for WF (overwhelming) + priors_wf_missing <- list( + mu = prior("normal", list(0, .8), prior_weights = 4) + ) + fit_wf_missing <- suppressWarnings(JAGS_fit(model_syntax, data, priors_wf_missing, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) + marglik_wf_missing <- JAGS_bridgesampling(fit_wf_missing, log_posterior = log_posterior, data = data, prior_list = priors_wf_missing) + result <- save_fit(fit_wf_missing, "fit_wf_missing", marglik = marglik_wf_missing, simple_priors = TRUE, note = "Overwhelming missing model for WF") + model_registry[["fit_wf_missing"]] <<- result$registry_entry + + expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_onesided.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_twosided.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_missing.RDS"))) +}) + +test_that("Orthonormal contrast models fit correctly", { + skip_on_os(c("mac", "linux", "solaris")) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + set.seed(1) + data_formula <- data.frame( + x_fac3o = factor(rep(c("A", "B", "C"), 40), levels = c("A", "B", "C")) + ) + data <- list( + y = rnorm(120, .4 + ifelse(data_formula$x_fac3o == "A", 0.0, ifelse(data_formula$x_fac3o == "B", -0.5, 0.5)), 1), + N = 120 + ) + + formula_list0 <- list(mu = ~ 1) + formula_list1 <- list(mu = ~ x_fac3o) + + formula_prior_list0 <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)) + ) + ) + formula_prior_list1 <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 0.5)) + ) + ) + + prior_list <- list(sigma = prior("lognormal", list(0, 1))) + formula_data_list <- list(mu = data_formula) + + model_syntax <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + + log_posterior <- function(parameters, data){ + sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) + } + + fit_orthonormal_0 <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) + marglik_orthonormal_0 <- JAGS_bridgesampling( + fit_orthonormal_0, log_posterior = log_posterior, data = data, prior_list = prior_list, + formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) + result <- save_fit(fit_orthonormal_0, "fit_orthonormal_0", marglik = marglik_orthonormal_0, formulas = TRUE, factor_priors = TRUE, note = "Orthonormal null model") + model_registry[["fit_orthonormal_0"]] <<- result$registry_entry + + fit_orthonormal_1 <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) + marglik_orthonormal_1 <- JAGS_bridgesampling( + fit_orthonormal_1, log_posterior = log_posterior, data = data, prior_list = prior_list, + formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) + result <- save_fit(fit_orthonormal_1, "fit_orthonormal_1", marglik = marglik_orthonormal_1, formulas = TRUE, factor_priors = TRUE, note = "Orthonormal alternative model") + model_registry[["fit_orthonormal_1"]] <<- result$registry_entry + + expect_true(file.exists(file.path(temp_fits_dir, "fit_orthonormal_0.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_orthonormal_1.RDS"))) +}) + + +# ============================================================================ # +# SECTION 2: COMPLEX MODELS FOR PLOTTING +# ============================================================================ # +test_that("Complex models for plotting fit correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + skip_if_not_installed("RoBMA") + require("RoBMA") + + set.seed(1) + + data_formula <- data.frame( + x_cont1 = rnorm(300), + x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), + x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) + ) + data <- list( + y = rnorm(300, -0.15 + 0.20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), + N = 300 + ) + + # create model with mix of a formula and free parameters --- + formula_list1 <- list( + mu = ~ x_cont1 + x_fac2t + x_fac3t + ) + formula_data_list1 <- list( + mu = data_formula + ) + formula_prior_list1 <- list( + mu = list( + "intercept" = prior_mixture( + list( + prior("spike", list(0), prior_weights = 2), + prior("normal", list(-1, 0.5), prior_weights = 1), + prior("normal", list( 1, 0.5), prior_weights = 1) + ), + is_null = c(TRUE, FALSE, FALSE) + ), + "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1), prior_weights = 1)), + "x_fac2t" = prior_mixture(list( + prior("spike", list(0), prior_weights = 1), + prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + ), + is_null = c(TRUE, FALSE) + ), + "x_fac3t" = prior_mixture(list( + prior("spike", list(0), prior_weights = 1), + prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + ), + is_null = c(TRUE, FALSE) + ) + ) + ) + + attr(formula_prior_list1$mu$x_cont1, "multiply_by") <- "sigma" + prior_list1 <- list( + "sigma" = prior_mixture( + list( + prior("normal", list(0, 1), truncation = list(0, Inf)), + prior("lognormal", list(0, 1)) + ), + components = c("normal", "lognormal") + ), + "bias" = prior_mixture(list( + prior_none(prior_weights = 1), + prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/3), + prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.025, 0.05)), prior_weights = 1/3), + prior_PET("normal", list(0, 1), prior_weights = 1/3) + ), is_null = c(TRUE, FALSE, FALSE, FALSE)) + ) + model_syntax1 <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + + fit_complex_mixed <- JAGS_fit( + model_syntax = model_syntax1, data = data, prior_list = prior_list1, + formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) + + result <- save_fit(fit_complex_mixed, "fit_complex_mixed", + formulas = TRUE, mixture_priors = TRUE, spike_and_slab_priors = TRUE, + pub_bias_priors = TRUE, weightfunction_priors = TRUE, + note = "Complex model with formula, mixtures, spike and slab, and publication bias") + model_registry[["fit_complex_mixed"]] <<- result$registry_entry + fit_complex_mixed <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_complex_mixed.RDS"))) + + # Simple formula mixed model + formula_list_simple_mixed <- list( + mu = ~ x_cont1 + x_fac2t + x_fac3t + ) + formula_data_list_simple_mixed <- list( + mu = data_formula + ) + formula_prior_list_simple_mixed <- list( + mu = list( + "intercept" = prior("normal", list(-1, 0.5), prior_weights = 1), + "x_cont1" = prior("normal", list(0, 1), prior_weights = 1), + "x_fac2t" = prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), + "x_fac3t" = prior_factor("mnormal", list(0, 1), contrast = "meandif") + ) + ) + + attr(formula_prior_list_simple_mixed$mu$x_cont1, "multiply_by") <- "sigma" + prior_list_simple_mixed <- list( + "sigma" = prior("lognormal", list(0, 1)) + ) + model_syntax_simple_mixed <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", + "}\n", + "}" + ) + + fit_simple_formula_mixed <- JAGS_fit( + model_syntax = model_syntax_simple_mixed, data = data, prior_list = prior_list_simple_mixed, + formula_list = formula_list_simple_mixed, formula_data_list = formula_data_list_simple_mixed, formula_prior_list = formula_prior_list_simple_mixed, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) + + result <- save_fit(fit_simple_formula_mixed, "fit_simple_formula_mixed", + formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Simple formula model with continuous, orthonormal factor, and meandif factor") + model_registry[["fit_simple_formula_mixed"]] <<- result$registry_entry + fit_simple_formula_mixed <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_formula_mixed.RDS"))) +}) + # ============================================================================ # # SAVE MODEL REGISTRY # ============================================================================ # @@ -1539,4 +1910,3 @@ test_that("Model registry is created and saved", { expect_s3_class(model_registry_df, "data.frame") expect_true(nrow(model_registry_df) > 0) }) - diff --git a/tests/testthat/test-JAGS-diagnostic-plots.R b/tests/testthat/test-JAGS-diagnostic-plots.R new file mode 100644 index 0000000..d43efa7 --- /dev/null +++ b/tests/testthat/test-JAGS-diagnostic-plots.R @@ -0,0 +1,260 @@ +context("JAGS diagnostics") + +# Load common test helpers +source(testthat::test_path("common-functions.R")) + +test_that("JAGS diagnostics work", { + + skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes + skip_on_cran() + skip_if_not_installed("rjags") + + # Load pre-fitted models + fit_formula_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS")) + fit_formula_fac <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_fac.RDS")) + fit_pet <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) + fit_wf <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided.RDS")) + fit_independent <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) + fit_meandif <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) # Has meandif factor priors + + ### density plots + vdiffr::expect_doppelganger("diagnostics-plot-density-1", function() JAGS_diagnostics_density(fit_formula_mix, parameter = "mu_x_cont1", formula_prefix = FALSE)) + vdiffr::expect_doppelganger("diagnostics-plot-density-2", function() JAGS_diagnostics_density(fit_formula_mix, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + vdiffr::expect_doppelganger("diagnostics-plot-density-3", function() JAGS_diagnostics_density(fit_formula_fac, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", formula_prefix = FALSE, ylab = "Smth")) + vdiffr::expect_doppelganger("diagnostics-plot-density-4", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_density(fit_formula_mix, parameter = "mu_x_fac3o") + }) + vdiffr::expect_doppelganger("diagnostics-plot-density-5", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_density(fit_formula_mix, parameter = "mu_x_fac3o", formula_prefix = FALSE, transform_factors = TRUE) + }) + vdiffr::expect_doppelganger("diagnostics-plot-density-6", function() JAGS_diagnostics_density(fit_pet, parameter = "PET")) + vdiffr::expect_doppelganger("diagnostics-plot-density-7", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_density(fit_wf, parameter = "omega") + }) + vdiffr::expect_doppelganger("diagnostics-plot-density-8", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + # Using p1 from fit_independent (prior only model) + JAGS_diagnostics_density(fit_independent, parameter = "p1") + }) + + vdiffr::expect_doppelganger("diagnostics-ggplot-density-1", JAGS_diagnostics_density(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + temp_plot <- JAGS_diagnostics_density(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) + vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.1",temp_plot[[1]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.2",temp_plot[[2]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.3",temp_plot[[3]]) + temp_plot <- JAGS_diagnostics_density(fit_wf, plot_type = "ggplot", parameter = "omega") + vdiffr::expect_doppelganger("diagnostics-ggplot-density-3.1",temp_plot) + + + ### trace plots + vdiffr::expect_doppelganger("diagnostics-plot-trace-1", function() JAGS_diagnostics_trace(fit_formula_mix, parameter = "mu_x_cont1", formula_prefix = FALSE)) + vdiffr::expect_doppelganger("diagnostics-plot-trace-2", function() JAGS_diagnostics_trace(fit_formula_mix, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + vdiffr::expect_doppelganger("diagnostics-plot-trace-3", function() JAGS_diagnostics_trace(fit_formula_fac, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", formula_prefix = FALSE, ylab = "Smth")) + vdiffr::expect_doppelganger("diagnostics-plot-trace-4", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_trace(fit_formula_mix, parameter = "mu_x_fac3o", formula_prefix = FALSE) + }) + vdiffr::expect_doppelganger("diagnostics-plot-trace-5", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_trace(fit_formula_mix, parameter = "mu_x_fac3o", transform_factors = TRUE) + }) + vdiffr::expect_doppelganger("diagnostics-plot-trace-6", function() JAGS_diagnostics_trace(fit_pet, parameter = "PET")) + vdiffr::expect_doppelganger("diagnostics-plot-trace-7", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_trace(fit_wf, parameter = "omega") + }) + vdiffr::expect_doppelganger("diagnostics-plot-trace-8", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_trace(fit_independent, parameter = "p1") + }) + + vdiffr::expect_doppelganger("diagnostics-ggplot-trace-1", JAGS_diagnostics_trace(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + temp_plot <- JAGS_diagnostics_trace(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) + vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.1",temp_plot[[1]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.2",temp_plot[[2]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.3",temp_plot[[3]]) + temp_plot <- JAGS_diagnostics_trace(fit_wf, plot_type = "ggplot", parameter = "omega") + vdiffr::expect_doppelganger("diagnostics-ggplot-trace-3.1",temp_plot) + + + ### autocorrelation plots + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-1", function() JAGS_diagnostics_autocorrelation(fit_formula_mix, parameter = "mu_x_cont1", formula_prefix = FALSE)) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-2", function() JAGS_diagnostics_autocorrelation(fit_formula_mix, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-3", function() JAGS_diagnostics_autocorrelation(fit_formula_fac, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", ylab = "Smth")) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-4", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_autocorrelation(fit_formula_mix, parameter = "mu_x_fac3o") + }) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-5", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_autocorrelation(fit_formula_mix, parameter = "mu_x_fac3o", formula_prefix = FALSE, transform_factors = TRUE) + }) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-6", function() JAGS_diagnostics_autocorrelation(fit_pet, parameter = "PET")) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-7", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_autocorrelation(fit_wf, parameter = "omega") + }) + vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-8", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_autocorrelation(fit_independent, parameter = "p1") + }) + + vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-1", JAGS_diagnostics_autocorrelation(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) + temp_plot <- JAGS_diagnostics_autocorrelation(fit_formula_mix, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) + vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.1",temp_plot[[1]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.2",temp_plot[[2]]) + vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.3",temp_plot[[3]]) + temp_plot <- JAGS_diagnostics_autocorrelation(fit_wf, plot_type = "ggplot", parameter = "omega") + vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-3.1",temp_plot) +}) + +test_that("JAGS diagnostics work (spike and slab)", { + + skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes + skip_on_cran() + skip_if_not_installed("rjags") + + # Use fit_complex_mixed which has spike and slab on x_cont1 + fit <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) + + ### density plots + vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-1", function() JAGS_diagnostics_density(fit, parameter = "mu_x_cont1")) + vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-2", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_cont1")) + vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-3", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_cont1")) +}) + +test_that("JAGS diagnostics work (mixture priors)", { + + skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes + skip_on_cran() + skip_if_not_installed("rjags") + + # Use fit_complex_mixed which has mixture on intercept and x_fac3t + fit <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) + + ### density plots + # Using mu_intercept as the first mixture example (was mu_x_cont in original, but x_cont1 is spike/slab in this model) + vdiffr::expect_doppelganger("diagnostics-plot-mixture-1", function() JAGS_diagnostics_density(fit, parameter = "mu_intercept")) + vdiffr::expect_doppelganger("diagnostics-plot-mixture-2", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_intercept")) + vdiffr::expect_doppelganger("diagnostics-plot-mixture-3", function() JAGS_diagnostics_trace(fit, parameter = "mu_intercept")) + + # Using mu_x_fac3t as the second mixture example + vdiffr::expect_doppelganger("diagnostics-plot-mixture-4", function() JAGS_diagnostics_density(fit, parameter = "mu_x_fac3t")) + vdiffr::expect_doppelganger("diagnostics-plot-mixture-5", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac3t")) + vdiffr::expect_doppelganger("diagnostics-plot-mixture-6", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3t")) +}) + +test_that("JAGS diagnostics work (meandif and independent)", { + + skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes + skip_on_cran() + skip_if_not_installed("rjags") + + fit_independent <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) + fit_meandif <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) # Has meandif factor priors + + ### density plots + vdiffr::expect_doppelganger("diagnostics3-plot-density-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_density(fit_independent, parameter = "p1") + }) + vdiffr::expect_doppelganger("diagnostics3-plot-density-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_density(fit_meandif, parameter = "mu_x_fac3md") + }) + vdiffr::expect_doppelganger("diagnostics3-plot-density-3", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_density(fit_meandif, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) + }) + + + temp_plot <- JAGS_diagnostics_density(fit_independent, plot_type = "ggplot", parameter = "p1") + vdiffr::expect_doppelganger("diagnostics3-ggplot-density-1.1",temp_plot[[1]]) + vdiffr::expect_doppelganger("diagnostics3-ggplot-density-1.2",temp_plot[[2]]) + + temp_plot <- JAGS_diagnostics_density(fit_meandif, plot_type = "ggplot", parameter = "mu_x_fac3md", transform_factors = TRUE) + vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.1",temp_plot[[1]]) + vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.2",temp_plot[[2]]) + vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.3",temp_plot[[3]]) + + + ### trace plots + vdiffr::expect_doppelganger("diagnostics3-plot-trace-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_trace(fit_independent, parameter = "p1") + }) + vdiffr::expect_doppelganger("diagnostics3-plot-trace-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_trace(fit_meandif, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) + }) + + + ### autocorrelation plots + vdiffr::expect_doppelganger("diagnostics3-plot-autocorrelation-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 2)) + JAGS_diagnostics_autocorrelation(fit_independent, parameter = "p1") + }) + vdiffr::expect_doppelganger("diagnostics3-plot-autocorrelation-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + par(mfrow = c(1, 3)) + JAGS_diagnostics_autocorrelation(fit_meandif, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) + }) +}) + +test_that("JAGS diagnostics work (spike priors)", { + + skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes + skip_on_cran() + skip_if_not_installed("rjags") + + fit <- readRDS(file.path(temp_fits_dir, "fit_spike_factors.RDS")) + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_spike_slab_simple.RDS")) + + ### density plots + vdiffr::expect_doppelganger("diagnostics4-ggplot-density-fit_simple",JAGS_diagnostics_density(fit_simple, parameter = "mu")) + + # fit_spike_factors has factor spikes + expect_message(JAGS_diagnostics_density(fit, parameter = "mu_x_fac2i"), "No diagnostic plots are produced for a spike prior distribution") + expect_message(JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3md"), "No diagnostic plots are produced for a spike prior distribution") + +}) diff --git a/tests/testthat/test-JAGS-diagnostics.R b/tests/testthat/test-JAGS-diagnostics.R deleted file mode 100644 index d1c2e89..0000000 --- a/tests/testthat/test-JAGS-diagnostics.R +++ /dev/null @@ -1,458 +0,0 @@ -context("JAGS diagnostics") - -test_that("JAGS diagnostics work", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(150), - x_fac2t = factor(rep(c("A", "B"), 75), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 50), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(150, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3o == "A", 0.0, ifelse(data_formula$x_fac3o == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 150 - ) - - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont1 + x_fac2t + x_fac3o - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)), - omega = prior_weightfunction("onesided", list(c(0.05, 0.10), c(1,1,1))), - PET = prior_PET("gamma", list(2, 2)), - fac2i = prior_factor("normal", contrast = "independent", list(0, 1/2)) - ) - attr(prior_list$fac2i, "levels") <- 2 - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - - ### density plots - vdiffr::expect_doppelganger("diagnostics-plot-density-1", function() JAGS_diagnostics_density(fit, parameter = "mu_x_cont1", formula_prefix = FALSE)) - vdiffr::expect_doppelganger("diagnostics-plot-density-2", function() JAGS_diagnostics_density(fit, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - vdiffr::expect_doppelganger("diagnostics-plot-density-3", function() JAGS_diagnostics_density(fit, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", formula_prefix = FALSE, ylab = "Smth")) - vdiffr::expect_doppelganger("diagnostics-plot-density-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_density(fit, parameter = "mu_x_fac3o") - }) - vdiffr::expect_doppelganger("diagnostics-plot-density-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_density(fit, parameter = "mu_x_fac3o", formula_prefix = FALSE, transform_factors = TRUE) - }) - vdiffr::expect_doppelganger("diagnostics-plot-density-6", function()JAGS_diagnostics_density(fit, parameter = "PET")) - vdiffr::expect_doppelganger("diagnostics-plot-density-7", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_density(fit, parameter = "omega") - }) - vdiffr::expect_doppelganger("diagnostics-plot-density-8", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_density(fit, parameter = "fac2i") - }) - - vdiffr::expect_doppelganger("diagnostics-ggplot-density-1", JAGS_diagnostics_density(fit, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - temp_plot <- JAGS_diagnostics_density(fit, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) - vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.2",temp_plot[[2]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-density-2.3",temp_plot[[3]]) - temp_plot <- JAGS_diagnostics_density(fit, plot_type = "ggplot", parameter = "omega") - vdiffr::expect_doppelganger("diagnostics-ggplot-density-3.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-density-3.2",temp_plot[[2]]) - - - ### trace plots - vdiffr::expect_doppelganger("diagnostics-plot-trace-1", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_cont1", formula_prefix = FALSE)) - vdiffr::expect_doppelganger("diagnostics-plot-trace-2", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - vdiffr::expect_doppelganger("diagnostics-plot-trace-3", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", formula_prefix = FALSE, ylab = "Smth")) - vdiffr::expect_doppelganger("diagnostics-plot-trace-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3o", formula_prefix = FALSE) - }) - vdiffr::expect_doppelganger("diagnostics-plot-trace-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3o", transform_factors = TRUE) - }) - vdiffr::expect_doppelganger("diagnostics-plot-trace-6", function() JAGS_diagnostics_trace(fit, parameter = "PET")) - vdiffr::expect_doppelganger("diagnostics-plot-trace-7", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_trace(fit, parameter = "omega") - }) - vdiffr::expect_doppelganger("diagnostics-plot-trace-8", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_trace(fit, parameter = "fac2i") - }) - - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-1", JAGS_diagnostics_trace(fit, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - temp_plot <- JAGS_diagnostics_trace(fit, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.2",temp_plot[[2]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-2.3",temp_plot[[3]]) - temp_plot <- JAGS_diagnostics_trace(fit, plot_type = "ggplot", parameter = "omega") - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-3.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-trace-3.2",temp_plot[[2]]) - - - ### autocorrelation plots - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-1", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_cont1", formula_prefix = FALSE)) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-2", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-3", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac2t", main = "Treatment", xlab = "Values", ylab = "Smth")) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac3o") - }) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac3o", formula_prefix = FALSE, transform_factors = TRUE) - }) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-6", function() JAGS_diagnostics_autocorrelation(fit, parameter = "PET")) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-7", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_autocorrelation(fit, parameter = "omega") - }) - vdiffr::expect_doppelganger("diagnostics-plot-autocorrelation-8", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_autocorrelation(fit, parameter = "fac2i") - }) - - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-1", JAGS_diagnostics_autocorrelation(fit, plot_type = "ggplot", parameter = "mu_x_cont1", col = c("red", "green", "blue", "yellow"), formula_prefix = FALSE, transformations = list(mu_x_cont1 = list(fun = function(x) exp(x))))) - temp_plot <- JAGS_diagnostics_autocorrelation(fit, plot_type = "ggplot", parameter = "mu_x_fac3o", transform_factors = TRUE) - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.2",temp_plot[[2]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-2.3",temp_plot[[3]]) - temp_plot <- JAGS_diagnostics_autocorrelation(fit, plot_type = "ggplot", parameter = "omega") - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-3.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics-ggplot-autocorrelation-3.2",temp_plot[[2]]) -}) - -test_that("JAGS diagnostics work (spike and slab)", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, .20 * data_formula$x_cont + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont" = prior_spike_and_slab(prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1,1))) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - ### density plots - vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-1", function() JAGS_diagnostics_density(fit, parameter = "mu_x_cont")) - vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-2", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_cont")) - vdiffr::expect_doppelganger("diagnostics-plot-spike-and-slab-3", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_cont")) -}) - -test_that("JAGS diagnostics work (mixture priors)", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, .20 * data_formula$x_cont + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont + x_fac3t - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont" = prior_mixture(list( - prior("normal", list(0, 1)), - prior("spike", list(0)) - )), - "x_fac3t" = prior_mixture(list( - prior("spike", list(0)), - prior_factor("mnormal", list(0, .3)) - )) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - ### density plots - vdiffr::expect_doppelganger("diagnostics-plot-mixture-1", function() JAGS_diagnostics_density(fit, parameter = "mu_x_cont")) - vdiffr::expect_doppelganger("diagnostics-plot-mixture-2", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_cont")) - vdiffr::expect_doppelganger("diagnostics-plot-mixture-3", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_cont")) - - vdiffr::expect_doppelganger("diagnostics-plot-mixture-4", function() JAGS_diagnostics_density(fit, parameter = "mu_x_fac3t")) - vdiffr::expect_doppelganger("diagnostics-plot-mixture-5", function() JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac3t")) - vdiffr::expect_doppelganger("diagnostics-plot-mixture-6", function() JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3t")) -}) - -test_that("JAGS diagnostics work (meandif and independent)", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(150), - x_fac2i = factor(rep(c("A", "B"), 75), levels = c("A", "B")), - x_fac3md = factor(rep(c("A", "B", "C"), 50), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(150, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3md == "A", 0.0, ifelse(data_formula$x_fac3md == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2i == "A", 0.5, 1)), - N = 150 - ) - - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont1 + x_fac2i + x_fac3md - 1 - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "x_cont1" = prior("normal", list(0, 1)), - "x_fac2i" = prior_factor("normal", contrast = "independent", list(0, 1)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 1)) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - - ### density plots - vdiffr::expect_doppelganger("diagnostics3-plot-density-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_density(fit, parameter = "mu_x_fac2i") - }) - vdiffr::expect_doppelganger("diagnostics3-plot-density-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_density(fit, parameter = "mu_x_fac3md") - }) - vdiffr::expect_doppelganger("diagnostics3-plot-density-3", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_density(fit, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) - }) - - - temp_plot <- JAGS_diagnostics_density(fit, plot_type = "ggplot", parameter = "mu_x_fac2i") - vdiffr::expect_doppelganger("diagnostics3-ggplot-density-1.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics3-ggplot-density-1.2",temp_plot[[2]]) - - temp_plot <- JAGS_diagnostics_density(fit, plot_type = "ggplot", parameter = "mu_x_fac3md", transform_factors = TRUE) - vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.1",temp_plot[[1]]) - vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.2",temp_plot[[2]]) - vdiffr::expect_doppelganger("diagnostics3-ggplot-density-2.3",temp_plot[[3]]) - - - ### trace plots - vdiffr::expect_doppelganger("diagnostics3-plot-trace-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_trace(fit, parameter = "mu_x_fac2i") - }) - vdiffr::expect_doppelganger("diagnostics3-plot-trace-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) - }) - - - ### autocorrelation plots - vdiffr::expect_doppelganger("diagnostics3-plot-autocorrelation-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac2i") - }) - vdiffr::expect_doppelganger("diagnostics3-plot-autocorrelation-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac3md", formula_prefix = FALSE, transform_factors = TRUE) - }) -}) - -test_that("JAGS diagnostics work (spike priors)", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(150), - x_fac2i = factor(rep(c("A", "B"), 75), levels = c("A", "B")), - x_fac3md = factor(rep(c("A", "B", "C"), 50), levels = c("A", "B", "C")), - x_fac2o = factor(rep(c("A", "B"), 75), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 50), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(150, 0.5, 1), - N = 150 - ) - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont1 + x_fac2i + x_fac3md + x_fac2o + x_fac3t - 1 - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "x_cont1" = prior("spike", list(0)), - "x_fac2i" = prior_factor("spike", contrast = "independent", list(1)), - "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)), - "x_fac2o" = prior_factor("spike", contrast = "orthonormal", list(0)), - "x_fac3t" = prior_factor("spike", contrast = "treatment", list(2)) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - - ### density plots - expect_message(JAGS_diagnostics_density(fit, parameter = "mu_x_cont1"), "No diagnostic plots are produced for a spike prior distribution") - expect_message(JAGS_diagnostics_density(fit, parameter = "mu_x_fac2i"), "No diagnostic plots are produced for a spike prior distribution") - expect_message(JAGS_diagnostics_trace(fit, parameter = "mu_x_fac3md"), "No diagnostic plots are produced for a spike prior distribution") - expect_message(JAGS_diagnostics_autocorrelation(fit, parameter = "mu_x_fac2o"), "No diagnostic plots are produced for a spike prior distribution") - expect_message(JAGS_diagnostics_density(fit, parameter = "mu_x_fac3t"), "No diagnostic plots are produced for a spike prior distribution") - -}) diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R similarity index 51% rename from tests/testthat/test-model-averaging-plots.R rename to tests/testthat/test-JAGS-ensemble-plots.R index db1559a..32db710 100644 --- a/tests/testthat/test-model-averaging-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1,5 +1,7 @@ -context("Model-averaging plot functions") -set.seed(1) +context("JAGS ensemble plot functions") + +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-ensemble-plots") +source(testthat::test_path("common-functions.R")) test_that("helper functions work", { @@ -99,7 +101,6 @@ test_that("prior plot functions (simple) work", { plot_prior_list(prior_list, plot_type = "ggplot", col = "red", lwd = 4) + geom_prior(prior_list$p1, col = "blue", lwd = 3, lty = 2) }) - ### mixtures prior_list <- list( p1 = prior("normal", list(0, 1)), @@ -551,29 +552,15 @@ test_that("prior plot functions (meandif) work", { test_that("posterior plot functions (simple) work", { - set.seed(1) - data <- NULL - priors_list0 <- list( - m = prior("spike", list(0)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - priors_list1 <- list( - m = prior("normal", list(0, .3)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - model_syntax <- - "model - { - }" - log_posterior <- function(parameters, data){ - return(0) - } - # fit the models - fit0 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 0)) - fit1 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1)) - # get marginal likelihoods - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + fit1 <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + # automatically mix posteriors models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), @@ -629,8 +616,22 @@ test_that("posterior plot functions (simple) work", { test_that("posterior plot functions (PET-PEESE) work", { - set.seed(1) - data <- NULL + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_pet_marglik.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_peese_marglik.RDS")) + + # automatically mix posteriors + models <- list( + list(fit = fit0, marglik = marglik0, prior_weights = 1), + list(fit = fit1, marglik = marglik1, prior_weights = 1) + ) + mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("mu", "PET", "PEESE"), is_null_list = list("mu" = c(T, T), "PET" = c(F,T), "PEESE" = c(T,F)), seed = 1) + + # Reconstruct priors for plotting (since we don't have them in the test scope directly) priors_list0 <- list( mu = prior("spike", list(0)), PET = prior_PET("normal", list(0, .2)) @@ -639,27 +640,6 @@ test_that("posterior plot functions (PET-PEESE) work", { mu = prior("spike", list(0)), PEESE = prior_PEESE("normal", list(0, .8)) ) - model_syntax <- - "model - { - }" - log_posterior <- function(parameters, data){ - return(0) - } - # fit the models - fit0 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 0)) - fit1 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) - # get marginal likelihoods - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) - # automatically mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("mu", "PET", "PEESE"), is_null_list = list("mu" = c(T, T), "PET" = c(F,T), "PEESE" = c(T,F)), seed = 1) - - vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-1", function(){ plot_posterior(mixed_posteriors, "PETPEESE", lwd = 2, col = "red", col.fill = scales::alpha("red", .20), par_name = "PET-PEESE", n_points = 50, ylim = c(0, 1)) @@ -690,14 +670,9 @@ test_that("posterior plot functions (PET-PEESE) work", { }) # add an overhelming missing model - priors_list2 <- list( - mu = prior("normal", list(.2, .2), prior_weights = 4) - ) - # fit the models - fit2 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list2, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) - # get marginal likelihoods - marglik2 <- JAGS_bridgesampling(fit2, log_posterior = log_posterior, data = data, prior_list = priors_list2) - # automatically mix posteriors + fit2 <- readRDS(file.path(temp_fits_dir, "fit_missing.RDS")) + marglik2 <- readRDS(file.path(temp_fits_dir, "fit_missing_marglik.RDS")) + models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), list(fit = fit1, marglik = marglik1, prior_weights = 1), @@ -713,27 +688,14 @@ test_that("posterior plot functions (PET-PEESE) work", { test_that("posterior plot functions (weightfunctions) work", { - set.seed(1) - data <- NULL - priors_list0 <- list( - omega = prior_weightfunction("one.sided", list(c(.025), c(1, 1))) - ) - priors_list1 <- list( - omega = prior_weightfunction("two.sided", list(c(.05), c(1, 1))) - ) - model_syntax <- - "model - { - }" - log_posterior <- function(parameters, data){ - return(0) - } - # fit the models - fit0 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 0)) - fit1 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) - # get marginal likelihoods - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided_marglik.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_wf_twosided.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_wf_twosided_marglik.RDS")) + # automatically mix posteriors models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), @@ -741,7 +703,13 @@ test_that("posterior plot functions (weightfunctions) work", { ) mixed_posteriors <- mix_posteriors(model_list = models, parameters = "omega", is_null_list = list("omega" = c(F,F)), seed = 1) - + # Reconstruct priors + priors_list0 <- list( + omega = prior_weightfunction("one.sided", list(c(.025), c(1, 1))) + ) + priors_list1 <- list( + omega = prior_weightfunction("two.sided", list(c(.05), c(1, 1))) + ) vdiffr::expect_doppelganger("model-averaging-plot-posterior-wf-1", function(){ plot_posterior(mixed_posteriors, "omega", lwd = 2, col = "red", col.fill = scales::alpha("red", .20), par_name = "Selection Models", n_points = 50, ylim = c(0, 1)) @@ -779,14 +747,9 @@ test_that("posterior plot functions (weightfunctions) work", { }) # add an overhelming missing model - priors_list2 <- list( - mu = prior("normal", list(0, .8), prior_weights = 4) - ) - # fit the models - fit2 <- suppressWarnings(JAGS_fit(model_syntax, data, priors_list2, chains = 1, adapt = 100, burnin = 150, sample = 2000, seed = 1)) - # get marginal likelihoods - marglik2 <- JAGS_bridgesampling(fit2, log_posterior = log_posterior, data = data, prior_list = priors_list2) - # automatically mix posteriors + fit2 <- readRDS(file.path(temp_fits_dir, "fit_wf_missing.RDS")) + marglik2 <- readRDS(file.path(temp_fits_dir, "fit_wf_missing_marglik.RDS")) + models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), list(fit = fit1, marglik = marglik1, prior_weights = 1), @@ -802,63 +765,14 @@ test_that("posterior plot functions (weightfunctions) work", { test_that("posterior plot functions (orthonormal) work", { - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac3o = factor(rep(c("A", "B", "C"), 40), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(120, .4 + ifelse(data_formula$x_fac3o == "A", 0.0, ifelse(data_formula$x_fac3o == "B", -0.5, 0.5)), 1), - N = 120 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ 1) - formula_list1 <- list(mu = ~ x_fac3o) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 0.5)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } + skip_on_os(c("mac", "linux", "solaris")) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) + fit0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) # mix posteriors models <- list( @@ -899,921 +813,14 @@ test_that("posterior plot functions (orthonormal) work", { par(mar = c(4, 4, 1, 4)) plot_posterior(mixed_posteriors, "mu_x_fac3o", legend = FALSE) }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-o-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3o", col = c("red", "green", "blue"), dots_prior = list(col = "grey"), prior = TRUE) - }) - - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-o-1", plot_posterior(mixed_posteriors, "mu_x_fac3o", plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-o-2", plot_posterior(mixed_posteriors, "mu_x_fac3o", col = c("red", "green", "blue"), plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-o-3", plot_posterior(mixed_posteriors, "mu_x_fac3o", lty = c(2, 3, 4), col = "blue", lwd = 2, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-o-4", plot_posterior(mixed_posteriors, "mu_x_fac3o", legend = FALSE, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-o-5", plot_posterior(mixed_posteriors, "mu_x_fac3o", col = c("red", "green", "blue"), prior = TRUE, plot_type = "ggplot")) - -}) - - -test_that("posterior plot functions (treatment) work", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac2t = factor(rep(c("A", "B"), 60), levels = c("A", "B")) - ) - data <- list( - y = rnorm(120, .4 + ifelse(data_formula$x_fac2t == "A", 0.0, 0.5), 1), - N = 120 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ 1) - formula_list1 <- list(mu = ~ x_fac2t) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 0.5)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_intercept", "mu_x_fac2t"), - is_null_list = list( - "mu_intercept" = c(TRUE, TRUE), - "mu_x_fac2t" = c(FALSE, TRUE) - ), - seed = 1, n_samples = 10000) - - vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t") - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t", col = "red") - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-3", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t", lty = 2, col = "blue", lwd = 2) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t", legend = FALSE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t", col = "red", prior = TRUE) - }) - - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-t-1", plot_posterior(mixed_posteriors, "mu_x_fac2t", plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-t-2", plot_posterior(mixed_posteriors, "mu_x_fac2t", col = "red", plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-t-3", plot_posterior(mixed_posteriors, "mu_x_fac2t", lty = 2, col = "blue", lwd = 2, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-t-4", plot_posterior(mixed_posteriors, "mu_x_fac2t", legend = FALSE, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-t-5", plot_posterior(mixed_posteriors, "mu_x_fac2t", col = "red", prior = TRUE, plot_type = "ggplot")) - -}) - - -test_that("posterior plot functions (independent) work", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac2i = factor(rep(c("A", "B"), 150), levels = c("A", "B")) - ) - data <- list( - y = rnorm(300, ifelse(data_formula$x_fac2i == "A", 0.0, 0.5), 1), - N = 300 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_fac2i - 1) - formula_list1 <- list(mu = ~ x_fac2i - 1) - - formula_prior_list0 <- list( - mu = list( - "x_fac2i" = prior_factor("spike", contrast = "independent", list(0)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "x_fac2i" = prior_factor("normal", contrast = "independent", list(0, 1/4)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_fac2i"), - is_null_list = list( - "mu_x_fac2i" = c(FALSE, TRUE) - ), - seed = 1, n_samples = 10000) - - vdiffr::expect_doppelganger("model-averaging-plot-posterior-i-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2i") - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-i-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2i", col = c("green", "yellow")) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-i-3", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2i", col = "red", prior = TRUE) - }) - - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-i-1", plot_posterior(mixed_posteriors, "mu_x_fac2i", plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-i-2", plot_posterior(mixed_posteriors, "mu_x_fac2i", prior = TRUE, plot_type = "ggplot")) - -}) - - -test_that("posterior plot functions (meandif) work", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac3md = factor(rep(c("A", "B", "C"), 40), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(120, .4 + ifelse(data_formula$x_fac3md == "A", 0.0, ifelse(data_formula$x_fac3md == "B", -0.5, 0.5)), 1), - N = 120 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ 1) - formula_list1 <- list(mu = ~ x_fac3md) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.5)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_intercept", "mu_x_fac3md"), - is_null_list = list( - "mu_intercept" = c(TRUE, TRUE), - "mu_x_fac3md" = c(FALSE, TRUE) - ), - seed = 1, n_samples = 10000) - - vdiffr::expect_doppelganger("model-averaging-plot-posterior-md-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3md") - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-md-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3md", col = c("red", "green", "blue")) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-md-3", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3md", lty = c(2, 3, 4), col = "blue", lwd = 2) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-md-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3md", legend = FALSE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-posterior-md-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3md", col = c("red", "green", "blue"), dots_prior = list(col = "grey"), prior = TRUE) - }) - - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-md-1", plot_posterior(mixed_posteriors, "mu_x_fac3md", plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-md-2", plot_posterior(mixed_posteriors, "mu_x_fac3md", col = c("red", "green", "blue"), plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-md-3", plot_posterior(mixed_posteriors, "mu_x_fac3md", lty = c(2, 3, 4), col = "blue", lwd = 2, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-md-4", plot_posterior(mixed_posteriors, "mu_x_fac3md", legend = FALSE, plot_type = "ggplot")) - vdiffr::expect_doppelganger("model-averaging-ggplot-posterior-md-5", plot_posterior(mixed_posteriors, "mu_x_fac3md", col = c("red", "green", "blue"), prior = TRUE, plot_type = "ggplot")) - -}) - - -test_that("models plot functions work", { - - set.seed(1) - ### prior distribution related functions - p0 <- prior(distribution = "point", parameters = list(location = 0)) - p1 <- prior(distribution = "normal", parameters = list(mean = 0, sd = 1)) - p2 <- prior(distribution = "normal", parameters = list(mean = 0, sd = 1), truncation = list(0, Inf)) - - data <- list( - x = rnorm(10), - N = 10 - ) - - ## create and fit models - priors_list0 <- list(mu = p0) - priors_list1 <- list(mu = p1) - priors_list2 <- list(tau = p2) - - # define likelihood for the data - model_syntax <- - "model{ - for(i in 1:N){ - x[i] ~ dnorm(mu, 1) - } - }" - model_syntax2 <- - "model{ - for(i in 1:N){ - x[i] ~ dnorm(0, pow(tau, -2)) - } - }" - - # define log posterior for bridge sampling - log_posterior <- function(parameters, data){ - sum(dnorm(data$x, parameters$mu, 1, log = TRUE)) - } - log_posterior2 <- function(parameters, data){ - sum(dnorm(data$x, 0, parameters$tau, log = TRUE)) - } - # fit the models - fit0 <- JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 200, sample = 1000, seed = 0) - fit1 <- JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 200, sample = 1000, seed = 1) - fit2 <- JAGS_fit(model_syntax2, data, priors_list2, chains = 1, adapt = 100, burnin = 200, sample = 1000, seed = 2) - # get marginal likelihoods - marglik0 <- list( - logml = sum(dnorm(data$x, mean(p0), 1, log = TRUE)) - ) - class(marglik0) <- "bridge" - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) - marglik2 <- JAGS_bridgesampling(fit2, log_posterior = log_posterior2, data = data, prior_list = priors_list2) - ## create an object with the models - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1, fit_summary = runjags_estimates_table(fit0)), - list(fit = fit1, marglik = marglik1, prior_weights = 1, fit_summary = runjags_estimates_table(fit1)), - list(fit = fit2, marglik = marglik2, prior_weights = 1, fit_summary = runjags_estimates_table(fit2)) - ) - # compare and summarize the models - models <- models_inference(models) - inference <- ensemble_inference(model_list = models, parameters = c("mu", "tau"), is_null_list = list("mu" = c(1, 3), "tau" = c(1, 2))) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("mu", "tau"), is_null_list = list("mu" = c(1, 3), "tau" = c(1, 2)), seed = 1) - - - vdiffr::expect_doppelganger("model-averaging-plot-models-1", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-2", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "tau") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-3", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu", prior = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-4", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "tau", prior = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-5", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu", conditional = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-6", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "tau", prior = TRUE, conditional = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-7", { - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu", plot_type = "ggplot") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-8", { - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "tau", prior = TRUE, plot_type = "ggplot") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-9", { - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu", plot_type = "ggplot", y_axis2 = FALSE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-10", { - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu", plot_type = "ggplot", show_estimates = FALSE) - }) - -}) - - -test_that("models plot functions work (formulas + factors)", { - - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(60), - x_fac2t = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3t = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(60, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_fac2t) - formula_list1 <- list(mu = ~ x_cont1 + x_fac3t) - formula_list2 <- list(mu = ~ x_fac3o) - formula_list3 <- list(mu = ~ x_cont1 * x_fac3o) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - formula_prior_list3 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), - "x_cont1:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - fit2 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2, seed = 3) - fit3 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3, seed = 4) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - marglik2 <- JAGS_bridgesampling( - fit2, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2) - marglik3 <- JAGS_bridgesampling( - fit3, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3) - - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1), prior_weights = 1), - list(fit = fit2, marglik = marglik2, fit_summary = runjags_estimates_table(fit2), prior_weights = 1), - list(fit = fit3, marglik = marglik3, fit_summary = runjags_estimates_table(fit3), prior_weights = 1) - ) - models <- models_inference(models) - - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac3t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac3o" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1__xXx__x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac3t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1__xXx__x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-1", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_cont1") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-2", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac2t") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-3", function(){ - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac2t", prior = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-4", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(2, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3t") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-5", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(2, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3t", prior = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-6", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3o") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-7", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3o", prior = TRUE) - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-8", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_cont1__xXx__x_fac3o") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-9", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_cont1__xXx__x_fac3o", prior = TRUE) - }) - - # ggplot versions - p1 <- plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_cont1", plot_type = "ggplot") - p2 <- plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3o", prior = TRUE, plot_type = "ggplot") - - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-10", p1) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-11", p2[[1]]) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-12", p2[[2]]) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-13", p2[[3]]) - -}) - - -test_that("models plot functions work (formulas + spike factors)", { - - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac3md = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, ifelse(data_formula$x_fac3md == "A", 0.0, ifelse(data_formula$x_fac3md == "B", -0.2, 0.4))), - N = 300 - ) - - - formula_list <- list( - mu = ~ x_fac3md - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) - ) - ) - - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - log_posterior <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - - marglik0 <- JAGS_bridgesampling( - fit = fit0, - log_posterior = log_posterior, - data = data, - prior_list = prior_list, - formula_list = formula_list, - formula_data_list = formula_data_list, - formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit = fit1, - log_posterior = log_posterior, - data = data, - prior_list = prior_list, - formula_list = formula_list, - formula_data_list = formula_data_list, - formula_prior_list = formula_prior_list1) - - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, fit_summary = runjags_estimates_table(fit0, remove_spike_0 = FALSE, transform_factors = TRUE), prior_weights = 1), - list(fit = fit1, marglik = marglik1, fit_summary = runjags_estimates_table(fit1, remove_spike_0 = FALSE, transform_factors = TRUE), prior_weights = 1) - ) - models <- models_inference(models) - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-s-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3md") - }) - vdiffr::expect_doppelganger("model-averaging-plot-models-formula-s-2", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 1)) - plot_models(model_list = models, samples = mixed_posteriors, inference = inference, parameter = "mu_x_fac3md", prior = TRUE) - }) - -}) - - -test_that("posterior plot model averaging based on simple single JAGS models (formulas)", { - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, -0.15 + 0.20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac2t + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(-1, 0.5), prior_weights = 1), - "x_cont1" = prior("normal", list(0, 1), prior_weights = 1), - "x_fac2t" = prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - "x_fac3t" = prior_factor("mnormal", list(0, 1), contrast = "meandif") - ) - ) - - attr(formula_prior_list1$mu$x_cont1, "multiply_by") <- "sigma" - prior_list1 <- list( - "sigma" = prior("lognormal", list(0, 1)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - # BayesTools::JAGS_estimates_table(fit1) - - mixed_posteriors <- as_mixed_posteriors( - mode = fit1, - parameters = names(attr(fit1, "prior_list")) - ) - - vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-intercept", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_intercept", prior = T, dots_prior = list(col = "grey")) - }) - - vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_cont1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_cont1", prior = T, dots_prior = list(col = "grey")) - }) - - vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_fac2t", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac2t", prior = T, dots_prior = list(col = "grey")) - }) - - vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_fac3t", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "mu_x_fac3t", prior = T, dots_prior = list(col = "grey")) - }) - - vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-sigma", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors, "sigma", prior = T, dots_prior = list(col = "grey")) - }) }) test_that("posterior plot model averaging based on complex single JAGS models (formulas + spike factors + mixture)", { - set.seed(1) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, -0.15 + 0.20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac2t + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior_mixture( - list( - prior("spike", list(0), prior_weights = 2), - prior("normal", list(-1, 0.5), prior_weights = 1), - prior("normal", list( 1, 0.5), prior_weights = 1) - ), - is_null = c(T, F, F) - ), - "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1), prior_weights = 1)), - "x_fac2t" = prior_mixture(list( - prior("spike", list(0), prior_weights = 1), - prior_factor("mnormal", list(0, 1), contrast = "orthonormal") - ), - is_null = c(T, F) - ), - "x_fac3t" = prior_mixture(list( - prior("spike", list(0), prior_weights = 1), - prior_factor("mnormal", list(0, 1), contrast = "orthonormal") - ), - is_null = c(T, F) - ) - ) - ) - - attr(formula_prior_list1$mu$x_cont1, "multiply_by") <- "sigma" - prior_list1 <- list( - "sigma" = prior_mixture( - list( - prior("normal", list(0, 1), truncation = list(0, Inf)), - prior("lognormal", list(0, 1)) - ), - components = c("normal", "lognormal") - ), - "bias" = prior_mixture(list( - prior_none(prior_weights = 1), - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/3), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.025, 0.05)), prior_weights = 1/3), - prior_PET("normal", list(0, 1), prior_weights = 1/3) - ), is_null = c(T, F, F, F)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - if("RoBMA" %in% rownames(installed.packages())){ - require("RoBMA") - }else{ - skip() - } - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) mixed_posteriors <- as_mixed_posteriors( mode = fit1, @@ -1965,21 +972,6 @@ test_that("posterior plot model averaging based on complex single JAGS models ( plot_posterior(mixed_posteriors_conditional6b, parameter = "weightfunction", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5))) }) -# # TODO: at some point -# vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PETPEESE", function(){ -# oldpar <- graphics::par(no.readonly = TRUE) -# on.exit(graphics::par(mar = oldpar[["mar"]])) -# par(mar = c(4, 4, 1, 4)) -# plot_posterior(mixed_posteriors_conditional5a, parameter = "PETPEESE", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5))) -# }) -# -# vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PETPEESE-con", function(){ -# oldpar <- graphics::par(no.readonly = TRUE) -# on.exit(graphics::par(mar = oldpar[["mar"]])) -# par(mar = c(4, 4, 1, 4)) -# plot_posterior(mixed_posteriors_conditional6b, parameter = "PETPEESE", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5))) -# }) - vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PET-con", function(){ oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) @@ -2006,7 +998,55 @@ test_that("posterior plot model averaging based on complex single JAGS models ( hist(mixed_posteriors_conditional6b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") }) +}) + +test_that("posterior plot model averaging based on simple single JAGS models (formulas)", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit1 <- readRDS(file.path(temp_fits_dir, "fit_simple_formula_mixed.RDS")) + + mixed_posteriors <- as_mixed_posteriors( + mode = fit1, + parameters = names(attr(fit1, "prior_list")) + ) + + vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-intercept", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "mu_intercept", prior = T, dots_prior = list(col = "grey")) + }) + + vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_cont1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "mu_x_cont1", prior = T, dots_prior = list(col = "grey")) + }) + vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_fac2t", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "mu_x_fac2t", prior = T, dots_prior = list(col = "grey")) + }) + vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-x_fac3t", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "mu_x_fac3t", prior = T, dots_prior = list(col = "grey")) + }) + vdiffr::expect_doppelganger("model-averaging-simple-plot-ss-posterior-sigma", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "sigma", prior = T, dots_prior = list(col = "grey")) + }) }) + + + diff --git a/tests/testthat/test-JAGS-ensemble-tables.R b/tests/testthat/test-JAGS-ensemble-tables.R index 6645330..3423366 100644 --- a/tests/testthat/test-JAGS-ensemble-tables.R +++ b/tests/testthat/test-JAGS-ensemble-tables.R @@ -1,6 +1,6 @@ -context("Summary tables functions") +context("JAGS ensemble tables functions") -REFERENCE_DIR <- testthat::test_path("..", "results", "JAGS-ensemble-tables") +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-ensemble-tables") source(testthat::test_path("common-functions.R")) # ============================================================================ # @@ -282,13 +282,14 @@ test_that("Summary table advanced features work correctly", { test_reference_table(inference_interaction_table, "interaction_ensemble_inference.txt") test_reference_table(summary_interaction_table, "interaction_ensemble_summary.txt") - # 6. Spike Factors + # 6. Spike Factors (using marginal distribution models) # -------------------------------------------------------------- # - fit_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_null.RDS")) - marglik_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_null_marglik.RDS")) + # Using fit_marginal_0 (spike) and fit_marginal_1 (normal) which have meandif factors + fit_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_marginal_0.RDS")) + marglik_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS")) - fit_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_alt.RDS")) - marglik_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_spike_factors_alt_marglik.RDS")) + fit_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) + marglik_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS")) models_spike_factors <- list( list(fit = fit_spike_factors_null, marglik = marglik_spike_factors_null, prior_weights = 1, fit_summary = runjags_estimates_table(fit_spike_factors_null)), @@ -340,3 +341,46 @@ test_that("Simplified interpret2 function", { ) }) + +test_that("as_mixed_posteriors works with ensemble tables", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # 1. Complex Mixed Model + fit_complex_mixed <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) + + mixed_posteriors_complex <- as_mixed_posteriors( + mode = fit_complex_mixed, + parameters = names(attr(fit_complex_mixed, "prior_list")) + ) + + # Generate estimates table + estimates_table_complex <- ensemble_estimates_table( + mixed_posteriors_complex, + parameters = names(attr(fit_complex_mixed, "prior_list")), + probs = c(.025, 0.95) + ) + + test_reference_table(estimates_table_complex, "as_mixed_posteriors_complex_estimates.txt") + + + # 2. Simple Formula Mixed Model + fit_simple_formula_mixed <- readRDS(file.path(temp_fits_dir, "fit_simple_formula_mixed.RDS")) + + mixed_posteriors_simple <- as_mixed_posteriors( + mode = fit_simple_formula_mixed, + parameters = names(attr(fit_simple_formula_mixed, "prior_list")) + ) + + # Generate estimates table + estimates_table_simple <- ensemble_estimates_table( + mixed_posteriors_simple, + parameters = names(attr(fit_simple_formula_mixed, "prior_list")), + probs = c(.025, 0.95) + ) + + test_reference_table(estimates_table_simple, "as_mixed_posteriors_simple_estimates.txt") + +}) + diff --git a/tests/testthat/test-JAGS-fit.R b/tests/testthat/test-JAGS-fit.R deleted file mode 100644 index ab65da4..0000000 --- a/tests/testthat/test-JAGS-fit.R +++ /dev/null @@ -1,1490 +0,0 @@ -context("JAGS fit functions") - -test_that("JAGS model functions work (simple)", { - - skip_if_not_installed("rjags") - model_syntax <- "model{}" - priors <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("normal", list(0, 1), list(1, Inf)), - p3 = prior("lognormal", list(0, .5)), - p4 = prior("t", list(0, .5, 5)), - p5 = prior("Cauchy", list(1, 0.1), list(-10, 0)), - p6 = prior("gamma", list(2, 1)), - p7 = prior("invgamma", list(3, 2), list(1, 3)), - p8 = prior("exp", list(1.5)), - p9 = prior("beta", list(3, 2)), - p10 = prior("uniform", list(1, 5)), - p11 = prior("point", list(1)), - PET = prior_PET("normal", list(0, 1)), - PEESE = prior_PEESE("gamma", list(1, 1)), - p12 = prior("bernoulli", list(0.75)) - ) - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - - for(i in seq_along(priors)){ - vdiffr::expect_doppelganger(paste0("JAGS-model-prior-",i), function(){ - if(is.prior.discrete(priors[[i]])){ - barplot(table(samples[,names(priors)[i]])/length(samples[,names(priors)[i]]), main = print(priors[[i]], plot = T), width = 1/(max(samples[,names(priors)[i]])+1), space = 0, xlim = c(-0.25, max(samples[,names(priors)[i]])+0.25)) - }else{ - hist(samples[,names(priors)[i]], breaks = 50, main = print(priors[[i]], plot = TRUE), freq = FALSE) - } - lines(priors[[i]], individual = TRUE) - }) - } -}) - -# skip the rest as it takes too long -skip_on_cran() - -test_that("JAGS model functions work (vector)", { - - skip_if_not_installed("rjags") - model_syntax <- "model{}" - priors <- list( - p1 = prior("mnormal", list(mean = 0, sd = 1, K = 3),), - p2 = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)), - p3 = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) - ) - - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - vdiffr::expect_doppelganger("JAGS-model-prior-vector-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p1[1]"], breaks = 50, main = print(priors[[1]], plot = TRUE), freq = FALSE) - lines(prior("normal", list(0, 1))) - - plot(samples[,"p1[1]"], samples[,"p1[2]"], pch = 19, xlim = c(-3, 3), ylim = c(-3, 3), asp = 1, - xlab = "X1", ylab = "X2", main = print(priors[[1]], plot = TRUE)) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-vector-2", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p2[1]"][abs(samples[,"p2[1]"]) < 5], breaks = 20, main = print(priors[[2]], plot = TRUE), freq = FALSE) - lines(prior("cauchy", list(0, 1.5))) - - plot(samples[,"p2[1]"], samples[,"p2[2]"], pch = 19, xlim = c(-5, 5), ylim = c(-5, 5), asp = 1, - xlab = "X1", ylab = "X2", main = print(priors[[2]], plot = TRUE)) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-vector-3", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p3[1]"], breaks = 50, main = print(priors[[3]], plot = TRUE), freq = FALSE) - lines(prior("t", list(2, 0.5, 5))) - - plot(samples[,"p3[1]"], samples[,"p3[2]"], pch = 19, xlim = c(-3, 7), ylim = c(-3, 7), asp = 1, - xlab = "X1", ylab = "X2", main = print(priors[[3]], plot = TRUE)) - }) - -}) - -test_that("JAGS model functions work (factor)", { - - skip_if_not_installed("rjags") - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - - model_syntax <- "model{}" - priors <- list( - p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal"), - p2 = prior_factor("beta", list(alpha = 1, beta = 1), contrast = "treatment"), - p3 = prior_factor("beta", list(alpha = 2, beta = 2), contrast = "treatment"), - p4 = prior_factor("gamma", list(shape = 2, rate = 3), contrast = "independent"), - p5 = prior_factor("uniform", list(a = -0.5, b = 1.5), contrast = "independent"), - p6 = prior_factor("mnorm", list(mean = 0, sd = 0.5), contrast = "meandif"), - p7 = prior_factor("spike", list(location = 1), contrast = "treatment"), - p8 = prior_factor("spike", list(location = 2), contrast = "independent"), - p9 = prior_factor("spike", list(location = 0), contrast = "orthonormal"), - p10 = prior_factor("spike", list(location = 0), contrast = "meandif") - ) - - # add levels - attr(priors[[1]], "levels") <- 3 - attr(priors[[2]], "levels") <- 2 - attr(priors[[3]], "levels") <- 3 - attr(priors[[4]], "levels") <- 1 - attr(priors[[5]], "levels") <- 3 - attr(priors[[6]], "levels") <- 3 - attr(priors[[7]], "levels") <- 2 - attr(priors[[8]], "levels") <- 3 - attr(priors[[9]], "levels") <- 3 - attr(priors[[10]], "levels") <- 3 - - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - expect_equal(colnames(samples), c("p1[1]", "p1[2]", "p10[1]", "p10[2]", "p2", "p3[1]", "p3[2]", "p4", "p5[1]", "p5[2]", "p5[3]", "p6[1]", "p6[2]", "p7", "p8[1]", "p8[2]", "p8[3]", "p9[1]", "p9[2]")) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p1[1]"], breaks = 50, main = print(priors[[1]], plot = TRUE), freq = FALSE) - lines(prior("normal", list(0, 1))) - - plot(samples[,"p1[1]"], samples[,"p1[2]"], pch = 19, xlim = c(-3, 3), ylim = c(-3, 3), asp = 1, - xlab = "X1", ylab = "X2", main = print(priors[[1]], plot = TRUE)) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-2", function(){ - - hist(samples[,"p2"], breaks = 20, main = print(priors[[2]], plot = TRUE), freq = FALSE) - lines(prior("beta", list(1, 1))) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-3", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p3[1]"], breaks = 50, main = print(priors[[3]], plot = TRUE), freq = FALSE) - lines(prior("beta", list(2, 2))) - - plot(samples[,"p3[1]"], samples[,"p3[2]"], pch = 19, xlim = c(0, 1), ylim = c(0, 1), asp = 1, - xlab = "X1", ylab = "X2", main = print(priors[[3]], plot = TRUE), cex = .25) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-4", function(){ - - hist(samples[,"p4"], breaks = 20, main = print(priors[[4]], plot = TRUE), freq = FALSE) - lines(prior("gamma", list(shape = 2, rate = 3))) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-5", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples[,"p5[1]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior("uniform", list(a = -0.5, b = 1.5))) - - hist(samples[,"p5[2]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior("uniform", list(a = -0.5, b = 1.5))) - - hist(samples[,"p5[3]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior("uniform", list(a = -0.5, b = 1.5))) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-6", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p6[1]"], breaks = 50, main = print(priors[[6]], plot = TRUE), freq = FALSE) - lines(prior("normal", list(mean = 0, sd = 0.5))) - - hist(samples[,"p6[2]"], breaks = 50, main = print(priors[[6]], plot = TRUE), freq = FALSE) - lines(prior("normal", list(mean = 0, sd = 0.5))) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-7", function(){ - - hist(samples[,"p7"], breaks = 50, main = print(priors[[7]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 1), contrast = "treatment")) - - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-8", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples[,"p8[1]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 2), contrast = "independent")) - - hist(samples[,"p8[2]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 2), contrast = "independent")) - - hist(samples[,"p8[3]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 2), contrast = "independent")) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-9", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p9[1]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 0), contrast = "orthonormal")) - - hist(samples[,"p9[2]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 0), contrast = "orthonormal")) - }) - - vdiffr::expect_doppelganger("JAGS-model-prior-factor-10", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 2)) - - hist(samples[,"p10[1]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 0), contrast = "meandif")) - - hist(samples[,"p10[2]"], breaks = 50, main = print(priors[[5]], plot = TRUE), freq = FALSE) - lines(prior_factor("spike", list(location = 0), contrast = "meandif")) - }) - -}) - -test_that("JAGS model functions work (weightfunctions)", { - - skip_if_not_installed("rjags") - priors <- list( - prior_weightfunction("one.sided", list(c(.05), c(1, 1))), - prior_weightfunction("one.sided", list(c(.05, 0.10), c(1, 2, 3))), - prior_weightfunction("one.sided", list(c(.05, 0.60), c(1, 1), c(1, 5))), - prior_weightfunction("two.sided", list(c(.05), c(1, 1))), - prior_weightfunction("one.sided.fixed", list(c(.05), c(1, .5))), - prior_weightfunction("two.sided.fixed", list(c(.05, 0.10), c(1, .2, .5))) - ) - - for(i in 1:length(priors)){ - model_syntax <- "model{}" - model_syntax <- JAGS_add_priors(model_syntax, priors[i]) - monitor <- JAGS_to_monitor(priors[i]) - inits <- JAGS_get_inits(priors[i], chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - - vdiffr::expect_doppelganger(paste0("JAGS-model-weightfunction-",i), function(){ - densities <- density(priors[[i]], individual = TRUE) - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, length(densities))) - for(j in seq_along(densities)){ - hist(samples[,paste0("omega[",j,"]")], breaks = 50, freq = FALSE) - lines(densities[[j]]) - } - }) - } -}) - -test_that("JAGS model functions work (spike and slab)", { - - skip_if_not_installed("rjags") - priors <- list( - "mu" = prior_spike_and_slab(prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1,1))), - "beta" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - prior_inclusion = prior("beta", list(1,1))) - ) - - # Set levels attribute on the variable component within the spike_and_slab mixture - components <- attr(priors$beta, "components") - alternative_idx <- which(components == "alternative") - attr(priors$beta[[alternative_idx]], "levels") <- 3 - - for(i in 1:length(priors)){ - model_syntax <- "model{}" - model_syntax <- JAGS_add_priors(model_syntax, priors[i]) - monitor <- JAGS_to_monitor(priors[i]) - inits <- JAGS_get_inits(priors[i], chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - - if(i == 1){ - vdiffr::expect_doppelganger(paste0("JAGS-model-prior_spike-and-slab-",i), function(){ - temp_samples <- samples[,names(priors)[i]] - hs <- hist(temp_samples[temp_samples != 0], breaks = 50, plot = FALSE) - hs$density <- hs$density * mean(temp_samples != 0) - plot(hs, main = print(priors[[i]], plot = TRUE), freq = FALSE, ylim = range(c(0, max(hs$density), mean(temp_samples == 0)))) - lines(priors[[i]], individual = TRUE) - }) - }else{ - vdiffr::expect_doppelganger(paste0("JAGS-model-prior_spike-and-slab-",i), function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 3)) - - temp_samples <- samples[,paste0(names(priors)[i], "[", 1:2, "]")] %*% t(contr.orthonormal(1:3)) - - hs1 <- hist(temp_samples[temp_samples[,1] != 0, 1], breaks = 50, plot = FALSE) - hs1$density <- hs1$density * mean(temp_samples[,1] != 0) - plot(hs1, main = print(priors[[i]], plot = TRUE), freq = FALSE, ylim = range(c(0, max(hs1$density), mean(temp_samples == 0)))) - lines(priors[[i]], individual = TRUE) - - hs2 <- hist(temp_samples[temp_samples[,2] != 0, 2], breaks = 50, plot = FALSE) - hs2$density <- hs2$density * mean(temp_samples[,1] != 0) - plot(hs2, main = print(priors[[i]], plot = TRUE), freq = FALSE, ylim = range(c(0, max(hs2$density), mean(temp_samples == 0)))) - lines(priors[[i]], individual = TRUE) - - hs3 <- hist(temp_samples[temp_samples[,3] != 0, 3], breaks = 50, plot = FALSE) - hs3$density <- hs3$density * mean(temp_samples[,1] != 0) - plot(hs3, main = print(priors[[i]], plot = TRUE), freq = FALSE, ylim = range(c(0, max(hs3$density), mean(temp_samples == 0)))) - lines(priors[[i]], individual = TRUE) - }) - } - } -}) - -test_that("JAGS model functions work (mixture)", { - - skip_if_not_installed("rjags") - priors <- list( - "mu" = prior_mixture( - list( - prior("normal", list(0, 1), prior_weights = 1), - prior("normal", list(-3, 1), prior_weights = 5), - prior("gamma", list(5, 10), prior_weights = 1) - ), - is_null = c(T, F, T) - ), - "beta" = prior_mixture( - list( - prior("normal", list(0, 1), prior_weights = 1), - prior("normal", list(-3, 1), prior_weights = 5) - ), - components = c("b", "a") - ), - "gamma" = prior_mixture( - list( - prior("spike", list(2)), - prior("normal", list(-3, 1)) - ) - ), - "bias" = prior_mixture(list( - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/12), - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.05, 0.10)), prior_weights = 1/12), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/12), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.025, 0.05)), prior_weights = 1/12), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.05, 0.5)), prior_weights = 1/12), - prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1, 1), steps = c(0.025, 0.05, 0.5)), prior_weights = 1/12), - prior_PET(distribution = "Cauchy", parameters = list(0,1), truncation = list(0, Inf), prior_weights = 1/4), - prior_PEESE(distribution = "Cauchy", parameters = list(0,5), truncation = list(0, Inf), prior_weights = 1/4) - )) - ) - - - - for(i in 1:length(priors)){ - model_syntax <- "model{}" - model_syntax <- JAGS_add_priors(model_syntax, priors[i]) - monitor <- JAGS_to_monitor(priors[i]) - inits <- JAGS_get_inits(priors[i], chains = 2, seed = 1) - - if(i == 4){ - if("RoBMA" %in% rownames(installed.packages())){ - require("RoBMA") - }else{ - next - } - } - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - - if(i != 4){ - vdiffr::expect_doppelganger(paste0("JAGS-model-prior_mixture-",i), function(){ - temp_samples <- samples[,names(priors)[i]] - hist(temp_samples, breaks = 100, freq = FALSE, main = print(priors[[i]], plot = TRUE)) - lines(density(rng(priors[[i]], 1000000))) - }) - }else{ - vdiffr::expect_doppelganger(paste0("JAGS-model-prior_mixture-",i), function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(3, 3)) - - samples_PET <- samples[,"PET"] - samples_PEESE <- samples[,"PEESE"] - samples_omega <- samples[,paste0("omega[",1:6,"]")] - samples_bias <- samples[,"bias_indicator"] - - barplot(table(samples_bias)/length(samples_bias), main = "Bias componenets") - - hist(samples_PET[samples_PET != 0 & samples_PET < 10], breaks = 50, main = "PET", freq = FALSE) - lines(priors$bias[[7]], individual = TRUE) - - hist(samples_PEESE[samples_PEESE != 0 & samples_PEESE < 20], breaks = 50, main = "PEESE", freq = FALSE) - lines(priors$bias[[8]], individual = TRUE) - - hist(samples_omega[samples_bias == 2, 1], breaks = 50, main = "omega[2:1]", freq = FALSE) - hist(samples_omega[samples_bias == 2, 2], breaks = 50, main = "omega[2:2]", freq = FALSE) - hist(samples_omega[samples_bias == 2, 3], breaks = 50, main = "omega[2:3]", freq = FALSE) - hist(samples_omega[samples_bias == 2, 4], breaks = 50, main = "omega[2:4]", freq = FALSE) - hist(samples_omega[samples_bias == 2, 5], breaks = 50, main = "omega[2:5]", freq = FALSE) - hist(samples_omega[samples_bias == 2, 6], breaks = 50, main = "omega[2:6]", freq = FALSE) - - }) - } - } -}) - -test_that("JAGS fit function works" , { - - set.seed(1) - data <- list( - x = rnorm(50, 0, .5), - N = 50 - ) - priors_list <- list( - m = prior("normal", list(0, 1)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - model_syntax <- - "model - { - for(i in 1:N){ - x[i] ~ dnorm(m, pow(s, -2)) - } - }" - - ### checking the default settings - set.seed(1) - fit <- JAGS_fit(model_syntax, data, priors_list) - expect_equal(length(fit$mcmc), 4) - expect_true(all(sapply(fit$mcmc, function(mcmc)dim(mcmc) == c(4000, 2)))) - vdiffr::expect_doppelganger("JAGS-fit-posterior", function(){ - samples <- do.call(rbind, fit$mcmc) - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - for(i in seq_along(priors_list)){ - hist(samples[,i], breaks = 50, freq = FALSE) - } - }) - - ### checking control the main control arguments - fit1 <- JAGS_fit(model_syntax, data, priors_list, chains = 1, adapt = 100, burnin = 150, sample = 175, thin = 3, seed = 2) - expect_equal(length(fit1$mcmc), 1) - expect_true(all(sapply(fit1$mcmc, function(mcmc)dim(mcmc) == c(175, 2)))) - expect_equal(fit1$burnin, 250) # adapt + burnin - expect_equal(fit1$sample, 175) - expect_equal(fit1$thin, 3) - - ### adding custom parameters - model_syntax3 <- - "model - { - g ~ dnorm(0, 1) - for(i in 1:N){ - x[i] ~ dnorm(m, pow(s, -2)) - } - }" - fit3 <- JAGS_fit(model_syntax3, data, priors_list, add_parameters = "g", - chains = 1, adapt = 100, burnin = 100, sample = 100, seed = 3) - expect_equal(colnames(fit3$mcmc[[1]]), c("m", "s", "g")) - - ### checking mcmc_error autofit - priors_list4 <- list( - m = prior("normal", list(0, 1)) - ) - data4 <- list( - x = c(-500), - N = 1 - ) - model_syntax4 <- - "model - { - l = 1 - for(i in 1:N){ - x[i] ~ dt(m, pow(.3, -2), 1) - } - }" - runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) - fit4 <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = FALSE, - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4 <- suppressWarnings(summary(fit4)) - expect_true(summary_4[1,"MCerr"] > 0.069) - expect_true(summary_4[1,"MC%ofSD"] > 8) - expect_true(summary_4[1,"SSeff"] < 150) - expect_true(summary_4[1,"psrf"] > 1.007) - - convergence <- JAGS_check_convergence(fit4, prior_list = priors_list4, max_Rhat = 1.001, min_ESS = 500, max_error = 0.01, max_SD_error = 0.05) - expect_true(!convergence) - expect_equal(attr(convergence, "errors")[1], "R-hat 1.053 is larger than the set target (1.001).") - expect_equal(attr(convergence, "errors")[2], "ESS 149 is lower than the set target (500).") - expect_equal(attr(convergence, "errors")[3], "MCMC error 0.07422 is larger than the set target (0.01).") - expect_equal(attr(convergence, "errors")[4], "MCMC SD error 0.087 is larger than the set target (0.05).") - - fit4b <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = TRUE, autofit_control = list(max_error = 0.05, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4b <- summary(fit4b) - expect_true(summary_4b[1,"MCerr"] < 0.05) - - fit4c <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = TRUE, autofit_control = list(max_Rhat = 1.001, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4c <- summary(fit4c) - expect_true(summary_4c[1,"psrf"] < 1.001) - - fit4d <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = TRUE, autofit_control = list(min_ESS = 200, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4d <- summary(fit4d) - expect_true(summary_4d[1,"SSeff"] > 200) - - fit4e <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = TRUE, autofit_control = list(max_SD_error = 0.06, sample_extend = 100), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4e <- summary(fit4e) - expect_true(summary_4e[1,"MC%ofSD"] < 6) - - fit4f <- JAGS_fit(model_syntax4, data4, priors_list4, autofit = TRUE, autofit_control = list(max_error = 0.0001, sample_extend = 100, max_time = list(time = 5, unit = "secs")), - chains = 2, adapt = 100, burnin = 50, sample = 100, seed = 4) - summary_4f <- summary(fit4f) - expect_true(summary_4f[1,"MCerr"] > 0.0001) - expect_true(fit4f$timetaken < 5) - - # test extending the fit - fite <- JAGS_extend(fit) - expect_equal(length(fite$mcmc), 4) - expect_true(all(sapply(fite$mcmc, function(mcmc)dim(mcmc) == c(5000, 2)))) -}) - -test_that("JAGS fit function integration with formula works" , { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - prior_list1 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - - posterior1 <- suppressWarnings(coda::as.mcmc(fit1)) - - lm_1 <- stats::lm(y ~ x_cont1 + x_fac3t, data = cbind(data_formula, y = data$y)) - - # verify against the frequentist fit - vdiffr::expect_doppelganger("JAGS-fit-formula-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 2)) - - hist(posterior1[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_1)["(Intercept)"], sd = summary(lm_1)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(posterior1[,"mu_x_cont1"], freq = FALSE, main = "mu_x_cont1") - curve(dnorm(x, mean = coef(lm_1)["x_cont1"], sd = summary(lm_1)$coefficients["x_cont1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(posterior1[,"mu_x_fac3t[1]"], freq = FALSE, main = "mu_x_fac3t") - curve(dnorm(x, mean = coef(lm_1)["x_fac3tB"], sd = summary(lm_1)$coefficients["x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(posterior1[,"mu_x_fac3t[2]"], freq = FALSE, main = "mu_x_fac3t") - curve(dnorm(x, mean = coef(lm_1)["x_fac3tC"], sd = summary(lm_1)$coefficients["x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - }) - - # create model with two formulas - formula_list2 <- list( - mu = ~ x_cont1 + x_fac3t, - sigma = ~ x_fac2t - ) - - formula_data_list2 <- list( - mu = data_formula, - sigma = data_formula - ) - - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ), - sigma = list( - "intercept" = prior("normal", list(0, 1)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - model_syntax2 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(exp(sigma[i]), 2))\n", - "}\n", - "}" - ) - - - fit2 <- JAGS_fit( - model_syntax = model_syntax2, data = data, prior_list = NULL, - formula_list = formula_list2, formula_data_list = formula_data_list2, formula_prior_list = formula_prior_list2) - - posterior2 <- suppressWarnings(coda::as.mcmc(fit2)) - - # verify against the true values - vdiffr::expect_doppelganger("JAGS-fit-formula-2", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - hist(posterior2[,"mu_intercept"], freq = FALSE, main = "Intercept") - abline(v = 0, lwd = 3, col = "blue") - - hist(posterior2[,"mu_x_cont1"], freq = FALSE, main = "mu_x_cont1") - abline(v = .4, lwd = 3, col = "blue") - - hist(posterior2[,"mu_x_fac3t[1]"], freq = FALSE, main = "mu_x_fac3t") - abline(v = -0.2, lwd = 3, col = "blue") - - hist(posterior2[,"mu_x_fac3t[2]"], freq = FALSE, main = "mu_x_fac3t") - abline(v = 0.4, lwd = 3, col = "blue") - - hist(exp(posterior2[,"sigma_intercept"]), freq = FALSE, main = "sigma_intercept") - abline(v = 0.5, lwd = 3, col = "blue") - - hist(exp(posterior2[,"sigma_intercept"] + posterior2[,"sigma_x_fac2t"]), freq = FALSE, main = "sigma_x_fac2t") - abline(v = 1, lwd = 3, col = "blue") - }) - -}) - -test_that("JAGS fit function integration with formula and spike and slab works" , { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, .20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1,1))), - "x_fac3t" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - prior_inclusion = prior("spike", list(0.5))) - ) - ) - attr(formula_prior_list1$mu$x_fac3t, "multiply_by") <- "sigma" - prior_list1 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - - posterior1 <- suppressWarnings(coda::as.mcmc(fit1)) - - vdiffr::expect_doppelganger("JAGS-fit-formula-spike-and-slab-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(1, 3)) - - hist(posterior1[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - - hist(posterior1[,"mu_x_cont1_variable"], freq = FALSE, main = "x_cont1_variable") - - hist(posterior1[,"mu_x_cont1_inclusion"], freq = FALSE, main = "x_cont1_inclusion") - }) - - vdiffr::expect_doppelganger("JAGS-fit-formula-spike-and-slab-2", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - temp_samples <- posterior1[,paste0("mu_x_fac3t[", 1:2, "]")] %*% t(contr.orthonormal(1:3)) - temp_samples_variable <- posterior1[,paste0("mu_x_fac3t_variable[", 1:2, "]")] %*% t(contr.orthonormal(1:3)) - - hist(temp_samples[,1], freq = FALSE, main = "x_fac3t[A]") - hist(temp_samples[,2], freq = FALSE, main = "x_fac3t[B]") - hist(temp_samples[,3], freq = FALSE, main = "x_fac3t[C]") - - hist(temp_samples_variable[,1], freq = FALSE, main = "x_fac3t_variable[A]") - hist(temp_samples_variable[,2], freq = FALSE, main = "x_fac3t_variable[B]") - hist(temp_samples_variable[,3], freq = FALSE, main = "x_fac3t_variable[C]") - }) - -}) - -test_that("JAGS fit function integration with formula, spike and slab works, and mixture works" , { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, -0.15 + 0.20 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.2)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior_mixture( - list( - prior("spike", list(0), prior_weights = 2), - prior("normal", list(-1, 0.5), prior_weights = 1), - prior("normal", list( 1, 0.5), prior_weights = 1) - ), - is_null = c(T, F, F) - ), - "x_cont1" = prior_mixture( - list( - prior("spike", list(0), prior_weights = 1), - prior("normal", list(0, 1), prior_weights = 1) - ), - is_null = c(T, F) - ), - "x_fac3t" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), - prior_inclusion = prior("spike", list(0.5))) - ) - ) - attr(formula_prior_list1$mu$x_cont1, "multiply_by") <- "sigma" - prior_list1 <- list( - "sigma" = prior_mixture( - list( - prior("normal", list(0, 1), truncation = list(0, Inf)), - prior("lognormal", list(0, 1)) - ), - is_null = c(T, F) - ) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - - posterior1 <- suppressWarnings(coda::as.mcmc(fit1)) - - vdiffr::expect_doppelganger("JAGS-fit-formula-mixture-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(3, 3)) - - barplot(table(posterior1[,"mu_intercept_indicator"]) / nrow(posterior1), main = "Intercept indicator") - barplot(table(posterior1[,"mu_x_cont1_indicator"]) / nrow(posterior1), main = "x_cont1 indicator") - barplot(table(posterior1[,"sigma_indicator"]) / nrow(posterior1), main = "sigma indicator") - - hist(posterior1[,"mu_intercept"], freq = FALSE, main = "mu_intercept") - hist(posterior1[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - hist(posterior1[,"sigma"], freq = FALSE, main = "sigma") - }) - - vdiffr::expect_doppelganger("JAGS-fit-formula-mixture-2", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - temp_samples <- posterior1[,paste0("mu_x_fac3t[", 1:2, "]")] %*% t(contr.orthonormal(1:3)) - temp_samples_variable <- posterior1[,paste0("mu_x_fac3t_variable[", 1:2, "]")] %*% t(contr.orthonormal(1:3)) - - hist(temp_samples[,1], freq = FALSE, main = "x_fac3t[A]") - hist(temp_samples[,2], freq = FALSE, main = "x_fac3t[B]") - hist(temp_samples[,3], freq = FALSE, main = "x_fac3t[C]") - - hist(temp_samples_variable[,1], freq = FALSE, main = "x_fac3t_variable[A]") - hist(temp_samples_variable[,2], freq = FALSE, main = "x_fac3t_variable[B]") - hist(temp_samples_variable[,3], freq = FALSE, main = "x_fac3t_variable[C]") - }) - -}) - -test_that("JAGS fit with priors expressions", { - - skip_if_not_installed("rjags") - - # a simple prior - model_syntax <- "model{}" - priors <- list( - x = prior("normal", list(0, expression(x_sigma))), - x_sigma = prior("invgamma", list(1/2, 1/2)) - ) - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - vdiffr::expect_doppelganger("JAGS-model-prior-e1", function(){ - x_samples <- samples[,"x"] - hist(x_samples[abs(x_samples) < 10], breaks = 50, main = print(priors[[1]], plot = TRUE), freq = FALSE) - lines(prior("Cauchy", list(0, 1), list(-10, 10))) - }) - - # a spike and slab prior - model_syntax <- "model{}" - priors <- list( - x = prior_spike_and_slab( - prior("normal", list(0, expression(x_sigma))) - ), - x_sigma = prior("invgamma", list(1/2, 1/2)) - ) - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - vdiffr::expect_doppelganger("JAGS-model-prior-e2", function(){ - x_samples <- samples[,"x"] - x_samples <- x_samples[x_samples != 0] - hist(x_samples[abs(x_samples) < 10], breaks = 50, main = print(priors[[1]], plot = TRUE), freq = FALSE) - lines(prior("Cauchy", list(0, 1), list(-10, 10))) - }) - - # a mixture prior - model_syntax <- "model{}" - priors <- list( - x = prior_mixture(list( - prior("normal", list(0, expression(x_sigma))), - prior("cauchy", list(0, 1)) - ), is_null = c(T, F)), - x_sigma = prior("invgamma", list(1/2, 1/2)) - ) - - model_syntax <- JAGS_add_priors(model_syntax, priors) - monitor <- JAGS_to_monitor(priors) - inits <- JAGS_get_inits(priors, chains = 2, seed = 1) - - set.seed(1) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples <- do.call(rbind, samples) - - vdiffr::expect_doppelganger("JAGS-model-prior-e3", function(){ - x_samples <- samples[,"x"] - hist(x_samples[abs(x_samples) < 10], breaks = 50, main = print(priors[[1]], plot = TRUE), freq = FALSE) - lines(prior("Cauchy", list(0, 1), list(-10, 10))) - }) - -}) - -test_that("JAGS fit function integration with formula and priors expressions", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_if_not_installed("rjags") - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(100), - x_fac2t = factor(rep(c("A", "B"), 50), levels = c("A", "B")) - ) - data <- list( - y = rnorm(100, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac2t == "A", 0.25, 0.50)), - N = 100 - ) - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont1 + x_fac2t - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac2t" = prior_spike_and_slab(prior_factor("cauchy", contrast = "treatment", list(0, 1))) - ) - ) - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac2t" = prior_spike_and_slab(prior_factor("normal", contrast = "treatment", list(0, expression(tau)))) - ) - ) - prior_list1 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - prior_list2 <- list( - sigma = prior("lognormal", list(0, 1)), - tau = prior("invgamma", list(1/2, 1/2)) - ) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - # fit1 <- JAGS_fit( - # model_syntax = model_syntax, data = data, prior_list = prior_list1, - # formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, adapt = 1000) - fit2 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list2, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2, adapt = 1000) - - # runjags_estimates_table(fit1) - # verified against the simpler model directly sampling cauchy - expect_equal(capture_output_lines(print(runjags_estimates_table(fit2, conditional = FALSE, remove_parameters = "tau")), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept 0.304 0.125 0.024 0.312 0.527 0.00197 0.016 4128 1.001", - "(mu) x_cont1 0.385 0.111 0.169 0.383 0.604 0.00091 0.008 14631 1.000", - "(mu) x_fac2t (inclusion) 0.280 NA NA NA NA NA NA NA NA", - "(mu) x_fac2t[B] 0.068 0.148 -0.002 0.000 0.494 0.00309 0.021 2299 1.002", - "sigma 0.980 0.071 0.854 0.975 1.133 0.00074 0.010 9500 1.001" - )) - -}) - -test_that("JAGS fit function integration with formula expressions", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_if_not_installed("rjags") - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(200), - x_fac2t = factor(rep(LETTERS[1:10], 20)) - ) - x_fac2t_values <- rnorm(10, 0, 0.3) - names(x_fac2t_values) <- LETTERS[1:10] - data <- list( - y = rnorm(200, .4 * data_formula$x_cont1 + x_fac2t_values[data_formula[["x_fac2t"]]]), - N = 200 - ) - - # add id mapping - data[["mapping_id"]] <- as.integer(data_formula$x_fac2t) - - # create model with mix of a formula and free parameters --- - formula_list <- list( - mu = ~ x_cont1 + expression(mu_id[mapping_id[i]]) - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)), - mu_id = prior_factor("normal", list(0, expression(tau)), contrast = "independent"), - tau = prior("normal", list(0, 10), list(0, Inf)) - ) - - attr(prior_list$mu_id, "levels") <- 10 - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_sumary <- runjags_estimates_table(fit, formula_prefix = FALSE) - expect_true(cor(fit_sumary[grepl("id", rownames(fit_sumary)),"Mean"], x_fac2t_values) > 0.8) - expect_equal(capture_output_lines(print(fit_sumary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept 0.179 0.173 -0.169 0.179 0.525 0.00476 0.028 1319 1.003", - "x_cont1 0.423 0.077 0.272 0.424 0.575 0.00064 0.008 14330 1.000", - "sigma 0.996 0.051 0.903 0.994 1.103 0.00055 0.011 8587 1.000", - "id[1] 0.107 0.246 -0.376 0.106 0.602 0.00470 0.019 2763 1.002", - "id[2] 0.359 0.250 -0.118 0.351 0.867 0.00479 0.019 2724 1.003", - "id[3] 0.213 0.250 -0.272 0.207 0.726 0.00466 0.019 2873 1.001", - "id[4] -0.340 0.249 -0.853 -0.331 0.127 0.00481 0.019 2699 1.001", - "id[5] -0.476 0.257 -1.001 -0.468 0.009 0.00492 0.019 2804 1.001", - "id[6] 0.643 0.260 0.152 0.634 1.180 0.00507 0.019 2692 1.002", - "id[7] -0.213 0.247 -0.723 -0.208 0.260 0.00462 0.019 2882 1.001", - "id[8] -0.069 0.245 -0.551 -0.069 0.413 0.00465 0.019 2781 1.001", - "id[9] -0.362 0.249 -0.873 -0.354 0.107 0.00489 0.020 2656 1.001", - "id[10] 0.125 0.245 -0.347 0.122 0.624 0.00446 0.018 3012 1.002", - "tau 0.474 0.172 0.229 0.444 0.903 0.00319 0.019 2915 1.001" - )) - -}) - -test_that("JAGS fit function with random effects", { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_if_not_installed("rjags") - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(200), - x_fac3 = as.factor(sample(LETTERS[1:3], 200, replace = TRUE)), - id = factor(rep(LETTERS[1:10], 20)) - ) - id_values <- rnorm(10, 0, 0.5) - names(id_values) <- LETTERS[1:10] - id_x_cont1_values <- rnorm(10, 0, 0.3) - names(id_x_cont1_values) <- LETTERS[1:10] - - data <- list( - y = rnorm(200, (0.4 + id_x_cont1_values[data_formula$id]) * data_formula$x_cont1 + id_values[data_formula$id]), - N = 200 - ) - - # # the full model correspond to this lme4 call - # summary(lme4::lmer(y ~ x_cont1 + (1 + x_cont1||id), data = cbind(y = data$y, data_formula))) - - # intercept only model ---- - formula_list <- list( - mu = ~ 1 + (1 ||id) - ) - formula_data_list <- list( - mu = data_formula - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "intercept|id" = prior("normal", list(0, 1), list(0, 1)) - ) - ) - prior_list <- list( - sigma = prior("lognormal", list(0, 1)) - ) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_summary <- runjags_estimates_table(fit, formula_prefix = FALSE) - - # summary(lme4::lmer(y ~ 1 + (1 | id), data = cbind(y = data$y, data_formula))) - expect_equal(capture_output_lines(print(fit_summary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept -0.044 0.156 -0.360 -0.044 0.272 0.00297 0.019 2785 1.004", - "sd(intercept|id) 0.377 0.161 0.090 0.361 0.745 0.00260 0.016 3832 1.001", - "sigma 1.231 0.064 1.114 1.228 1.364 0.00069 0.011 8608 1.000" - )) - - # random slope (no intercept) ---- - formula_list <- list( - mu = ~ 1 + (0 + x_cont1 ||id) - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1|id" = prior("normal", list(0, 1), list(0, 1)) - ) - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_summary <- runjags_estimates_table(fit, formula_prefix = FALSE) - - # summary(lme4::lmer(y ~ 1 + (0 + x_cont1 | id), data = cbind(y = data$y, data_formula))) - expect_equal(capture_output_lines(print(fit_summary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept -0.069 0.081 -0.227 -0.069 0.089 0.00067 0.008 14456 1.000", - "sd(x_cont1|id) 0.660 0.147 0.401 0.651 0.956 0.00271 0.019 2922 1.003", - "sigma 1.113 0.058 1.009 1.110 1.232 0.00061 0.011 8972 1.000" - )) - - # random factor slope ---- - formula_list <- list( - mu = ~ 1 + x_cont1 + (x_fac3 ||id) - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "intercept|id" = prior("normal", list(0, 1), list(0, 1)), - "x_fac3|id" = prior("normal", list(0, 1), list(0, 1)) - ) - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_summary <- runjags_estimates_table(fit, formula_prefix = FALSE) - - # this is probably the closest alternative - # summary(lme4::lmer(y ~ 1 + x_cont1 + (x_fac3 ||id), data = cbind(y = data$y, data_formula))) - expect_equal(capture_output_lines(print(fit_summary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept -0.050 0.127 -0.306 -0.050 0.203 0.00215 0.017 3485 1.001", - "x_cont1 0.544 0.089 0.367 0.544 0.718 0.00074 0.008 14246 1.000", - "sd(intercept|id) 0.243 0.148 0.016 0.229 0.578 0.00263 0.018 3196 1.002", - "sd(x_fac3[B]|id) 0.223 0.170 0.009 0.186 0.637 0.00210 0.012 6576 1.000", - "sd(x_fac3[C]|id) 0.277 0.192 0.014 0.247 0.729 0.00271 0.014 5047 1.000", - "sigma 1.130 0.059 1.020 1.127 1.254 0.00062 0.011 9075 1.000" - )) - - - # full spike and slab model ---- - formula_list <- list( - mu = ~ x_cont1 + x_fac3 + (x_cont1 + x_fac3||id) - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior_spike_and_slab(prior("normal", list(0, 5))), - "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1))), - "x_fac3" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1))), - "intercept|id" = prior_spike_and_slab(prior("normal", list(0, 1), list(0, 1))), - "x_cont1|id" = prior_mixture(list( - prior("normal", list(0, 1), list(0, 1)), - prior("beta", list(1, 2)) - ), is_null = c(TRUE, FALSE)), - "x_fac3|id" = prior_spike_and_slab(prior("normal", list(0, 1), list(0, 1))) - ) - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_summary <- runjags_estimates_table(fit, formula_prefix = FALSE, remove_inclusion = TRUE) - fit_inference <- runjags_inference_table(fit, formula_prefix = FALSE) - - expect_equal(capture_output_lines(print(fit_summary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept -0.002 0.019 0.000 0.000 0.000 0.00026 0.014 5629 1.004", - "x_cont1 0.471 0.201 0.000 0.498 0.797 0.00730 0.036 769 1.005", - "x_fac3[1] 0.001 0.026 0.000 0.000 0.010 0.00025 0.010 11328 1.000", - "x_fac3[2] 0.008 0.043 0.000 0.000 0.166 0.00064 0.015 4569 1.002", - "sd(intercept|id) 0.125 0.154 0.000 0.021 0.481 0.00381 0.025 1650 1.001", - "sd(x_cont1|id) 0.387 0.169 0.094 0.367 0.773 0.00404 0.024 1822 1.003", - "sd(x_fac3|id) 0.030 0.072 0.000 0.000 0.258 0.00116 0.016 3928 1.003", - "sigma 1.105 0.059 0.996 1.103 1.226 0.00070 0.012 7094 1.000" - )) - expect_equal(capture_output_lines(print(fit_inference), width = 150), c( - " Prior prob. Post. prob. Inclusion BF", - "intercept 0.500 0.023 0.024", - "x_cont1 0.500 0.923 11.924", - "x_fac3 0.500 0.043 0.045", - "sd(intercept|id) 0.500 0.512 1.050", - "sd(x_cont1|id) 0.500 0.521 1.089", - "sd(x_fac3|id) 0.500 0.217 0.278" - )) - - # independent factor priors ---- - formula_list <- list( - mu = ~ x_fac3 + (x_fac3||id) - ) - formula_prior_list <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3" = prior_factor("normal", list(0, 1), contrast = "independent"), - "intercept|id" = prior("normal", list(0, 1), list(0, 1)), - "x_fac3|id" = prior("normal", list(0, 1), list(0, 1)) - ) - ) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list) - - fit_summary <- runjags_estimates_table(fit, formula_prefix = FALSE, remove_inclusion = TRUE) - - expect_equal(capture_output_lines(print(fit_summary), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "intercept -0.168 0.582 -1.305 -0.158 0.968 0.04375 0.075 187 1.006", - "x_fac3[A] 0.227 0.580 -0.891 0.216 1.364 0.04318 0.074 207 1.004", - "x_fac3[B] 0.079 0.582 -1.050 0.068 1.221 0.04162 0.072 219 1.005", - "x_fac3[C] 0.007 0.580 -1.112 -0.001 1.161 0.03938 0.068 233 1.004", - "sd(intercept|id) 0.312 0.177 0.022 0.300 0.710 0.00348 0.020 2585 1.004", - "sd(x_fac3[A]|id) 0.410 0.226 0.027 0.399 0.883 0.00377 0.017 3632 1.000", - "sd(x_fac3[B]|id) 0.272 0.196 0.011 0.238 0.727 0.00260 0.013 5669 1.000", - "sd(x_fac3[C]|id) 0.330 0.216 0.016 0.304 0.827 0.00316 0.015 4694 1.000", - "sigma 1.213 0.065 1.096 1.210 1.349 0.00072 0.011 8195 1.001" - )) - -}) - -test_that("JAGS fit function integration with multiple formulas" , { - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2o = factor(rep(c("A", "B"), 150), levels = c("A", "B")) - ) - data_mu <- 0.20 * data_formula$x_cont1 - data_sigma <- 0.50 * exp(ifelse(data_formula$x_fac2o == "A", -0.5, 0.5)) - data <- list( - y = rnorm(300, data_mu, data_sigma), - N = 300 - ) - - - # create model with mix of a formula and free parameters --- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac2o, - sigma_exp = ~ x_cont1 + x_fac2o - ) - formula_data_list1 <- list( - mu = data_formula, - sigma_exp = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1))), - "x_fac2o" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "meandif")) - ), - sigma_exp = list( - "intercept" = prior("spike", list(0)), - "x_cont1" = prior_spike_and_slab(prior("normal", list(0, 1))), - "x_fac2o" = prior_spike_and_slab(prior_factor("mnormal", list(0, 1), contrast = "meandif")) - ) - ) - prior_list1 <- list( - "sigma" = prior("normal", list(0, 5), list(0, Inf)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma * exp(sigma_exp[i]), 2))\n", - "}\n", - "}" - ) - - fit1 <- suppressWarnings(JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1, - chains = 2, adapt = 500, burnin = 500, sample = 1000)) - - expect_equal(capture_output_lines(print(JAGS_estimates_table(fit1, remove_inclusion = TRUE)), width = 150), c( - " Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat", - "(mu) intercept -0.013 0.026 -0.063 -0.014 0.038 0.00066 0.025 1624 1.000", - "(mu) x_cont1 0.204 0.027 0.152 0.204 0.255 0.00059 0.022 2102 1.001", - "(mu) x_fac2o 0.001 0.009 0.000 0.000 0.017 0.00039 0.043 658 1.027", - "(sigma_exp) x_cont1 -0.001 0.009 -0.014 0.000 0.000 0.00028 0.031 1099 1.023", - "(sigma_exp) x_fac2o 0.436 0.041 0.348 0.433 0.520 0.00225 0.055 333 1.005", - "sigma 0.523 0.021 0.484 0.522 0.570 0.00067 0.032 1020 1.000" - )) - expect_equal(capture_output_lines(print(JAGS_inference_table(fit1)), width = 150), c( - " Prior prob. Post. prob. Inclusion BF", - "(mu) x_cont1 0.500 1.000 Inf", - "(mu) x_fac2o 0.500 0.040 0.042", - "(sigma_exp) x_cont1 0.500 0.045 0.047", - "(sigma_exp) x_fac2o 0.500 1.000 Inf" - )) - -}) - -test_that("JAGS parallel fit function works", { - - skip("requires parallel processing") - skip_on_cran() - skip_on_travis() - skip_on_ci() - - priors_list <- list( - m = prior("normal", list(0, 1)) - ) - data <- list( - x = c(-500), - N = 1 - ) - model_syntax <- - "model - { - l = 1 - for(i in 1:N){ - x[i] ~ dt(m, pow(.3, -2), 1) - } - }" - - - fit <- JAGS_fit(model_syntax, data, priors_list, autofit = FALSE, parallel = TRUE, - chains = 4, adapt = 100, burnin = 50, sample = 100, seed = 4) - expect_equal(length(fit$mcmc), 4) - expect_true(all(sapply(fit$mcmc, function(mcmc)dim(mcmc) == c(100, 1)))) - - - ### checking mcmc_error autofit - runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) - fit1 <- JAGS_fit(model_syntax, data, priors_list, parallel = TRUE, - autofit = TRUE, autofit_control = list(max_error = 0.05, sample_extend = 100), - chains = 4, adapt = 100, burnin = 50, sample = 100, seed = 4) - expect_equal(length(fit1$mcmc), 4) - expect_true(all(sapply(fit1$mcmc, function(mcmc)dim(mcmc) == c(200, 1)))) - -}) - -test_that("JAGS fit function with JASP works" , { - - set.seed(1) - data <- list( - x = rnorm(50, 0, .5), - N = 50 - ) - priors_list <- list( - m = prior("normal", list(0, 1)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - model_syntax <- - "model - { - for(i in 1:N){ - x[i] ~ dnorm(m, pow(s, -2)) - } - }" - - ### checking the default settings - set.seed(1) - - ### checking control the main control arguments - fit <- capture.output(JAGS_fit(model_syntax, data, priors_list, chains = 1, adapt = 100, burnin = 150, sample = 175, thin = 3, seed = 2, is_JASP = TRUE)) - expect_equal(fit, c( - "Adapting and burnin the model(1)" , - ".Sampling the model(5)" , - "....." , - "JAGS model with 176 samples (thin = 3; adapt+burnin = 250)" , - "" , - "Full summary statistics have not been pre-calculated - use either the summary method or add.summary to calculate summary statistics", - "" - )) - -}) diff --git a/tests/testthat/test-JAGS-formula.R b/tests/testthat/test-JAGS-formula.R index f399ecc..d48098f 100644 --- a/tests/testthat/test-JAGS-formula.R +++ b/tests/testthat/test-JAGS-formula.R @@ -1,546 +1,12 @@ context("JAGS formula") -test_that("JAGS formula works", { +# This file tests the JAGS formula functions +# - Helper functions for parameter naming and formula handling +# - JAGS_evaluate_formula function for prediction +# Uses pre-fitted models from test-00-model-fits.R per testing guidelines - # check the posterior distributions with weak priors against a maximum likelihood estimates with ML - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - df_all <- data.frame( - x_cont1 = rnorm(60), - x_cont2 = rnorm(60), - x_bin = rbinom(60, 1, .5), - x_fac2o = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac2t = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3t = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3i = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3md= factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - df_all$y <- rnorm(60, 0.1, 0.5) + 0.30 * df_all$x_cont1 - 0.15 * df_all$x_cont1 * df_all$x_cont2 + 0.2 * df_all$x_bin + - ifelse(df_all$x_fac3t == "A", 0.2, ifelse(df_all$x_fac3t == "B", -0.2, 0)) + - ifelse(df_all$x_fac3o == "A", 0.2, ifelse(df_all$x_fac3o == "B", -0.2, 0)) - prior_list_all <- list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_cont2" = prior("normal", list(0, 1)), - "x_cont1:x_cont2" = prior("normal", list(0, 1)), - "x_fac2o" = prior_factor("mcauchy", contrast = "orthonormal", list(0, 1)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), - "x_fac3t" = prior_factor("uniform", contrast = "treatment", list(-2, 2)), - "x_fac3i" = prior_factor("normal", contrast = "independent", list(0, 1)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 1)), - "x_fac2t:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 2)), - "x_fac2o:x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 2)), - "x_cont1:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 2)), - "x_cont1:x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 2)) - ) - prior_list2 <- list( - "sigma" = prior("cauchy", list(0, 1), list(0, 1)) - ) - model_syntax <- paste0( - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n" - ) - - - # simple linear regression ---- - formula_1 <- JAGS_formula(~ x_cont1, parameter = "mu", data = df_all[,"x_cont1", drop = FALSE], prior_list = prior_list_all[c("intercept", "x_cont1")]) - prior_list_1 <- c(formula_1$prior_list, prior_list2) - model_syntax_1 <- JAGS_add_priors(paste0("model{", formula_1$formula_syntax, model_syntax, "}"), prior_list_1) - data_1 <- c(formula_1$data, N = nrow(df_all), y = list(df_all$y)) - - model_1 <- rjags::jags.model(file = textConnection(model_syntax_1), inits = JAGS_get_inits(prior_list_1, chains = 2, seed = 1), data = data_1, n.chains = 2, quiet = TRUE) - samples_1 <- rjags::coda.samples(model = model_1, variable.names = JAGS_to_monitor(prior_list_1), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_1 <- do.call(rbind, samples_1) - - lm_1 <- stats::lm(y ~ x_cont1, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-1", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_1[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_1)["(Intercept)"], sd = summary(lm_1)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_1[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - curve(dnorm(x, mean = coef(lm_1)["x_cont1"], sd = summary(lm_1)$coefficients["x_cont1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_1[,"sigma"], freq = FALSE, main = "sigma") - abline(v = sigma(lm_1), lwd = 3) - }) - - - # linear regression with two continuous predictors and their interaction ---- - formula_2 <- JAGS_formula(~ x_cont1 * x_cont2, parameter = "mu", data = df_all[,c("x_cont1", "x_cont2")], prior_list = prior_list_all[c("intercept", "x_cont1", "x_cont2", "x_cont1:x_cont2")]) - prior_list_2 <- c(formula_2$prior_list, prior_list2) - model_syntax_2 <- JAGS_add_priors(paste0("model{", formula_2$formula_syntax, model_syntax, "}"), prior_list_2) - data_2 <- c(formula_2$data, N = nrow(df_all), y = list(df_all$y)) - - model_2 <- rjags::jags.model(file = textConnection(model_syntax_2), inits = JAGS_get_inits(prior_list_2, chains = 2, seed = 1), data = data_2, n.chains = 2, quiet = TRUE) - samples_2 <- rjags::coda.samples(model = model_2, variable.names = JAGS_to_monitor(prior_list_2), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_2 <- do.call(rbind, samples_2) - - lm_2 <- stats::lm(y ~ x_cont1 * x_cont2, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-2", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_2[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - curve(dnorm(x, mean = coef(lm_2)["x_cont1"], sd = summary(lm_2)$coefficients["x_cont1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_2[,"mu_x_cont2"], freq = FALSE, main = "x_cont2") - curve(dnorm(x, mean = coef(lm_2)["x_cont2"], sd = summary(lm_2)$coefficients["x_cont2", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_2[,"mu_x_cont1__xXx__x_cont2"], freq = FALSE, main = "x_cont1:x_cont2") - curve(dnorm(x, mean = coef(lm_2)["x_cont1:x_cont2"], sd = summary(lm_2)$coefficients["x_cont1:x_cont2", "Std. Error"]), add = TRUE, lwd = 2) - }) - - - # linear regression with a treatment factor (2 levels) ---- - formula_3 <- JAGS_formula(~ x_fac2t, parameter = "mu", data = df_all[,"x_fac2t",drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac2t")]) - prior_list_3 <- c(formula_3$prior_list, prior_list2) - model_syntax_3 <- JAGS_add_priors(paste0("model{", formula_3$formula_syntax, model_syntax, "}"), prior_list_3) - data_3 <- c(formula_3$data, N = nrow(df_all), y = list(df_all$y)) - - model_3 <- rjags::jags.model(file = textConnection(model_syntax_3), inits = JAGS_get_inits(prior_list_3, chains = 2, seed = 1), data = data_3, n.chains = 2, quiet = TRUE) - samples_3 <- rjags::coda.samples(model = model_3, variable.names = JAGS_to_monitor(prior_list_3), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_3 <- do.call(rbind, samples_3) - - lm_3 <- stats::lm(y ~ x_fac2t, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-3", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_3[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_3)["(Intercept)"], sd = summary(lm_3)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_3[,"mu_x_fac2t"], freq = FALSE, main = "x_fac2t") - curve(dnorm(x, mean = coef(lm_3)["x_fac2tB"], sd = summary(lm_3)$coefficients["x_fac2tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_3[,"sigma"], freq = FALSE, main = "sigma") - abline(v = sigma(lm_3), lwd = 3) - }) - - - # linear regression with an orthonormal factor (2 levels) ---- - formula_4 <- JAGS_formula(~ x_fac2o, parameter = "mu", data = df_all[,"x_fac2o",drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac2o")]) - prior_list_4 <- c(formula_4$prior_list, prior_list2) - model_syntax_4 <- JAGS_add_priors(paste0("model{", formula_4$formula_syntax, model_syntax, "}"), prior_list_4) - data_4 <- c(formula_4$data, N = nrow(df_all), y = list(df_all$y)) - - model_4 <- rjags::jags.model(file = textConnection(model_syntax_4), inits = JAGS_get_inits(prior_list_4, chains = 2, seed = 1), data = data_4, n.chains = 2, quiet = TRUE) - samples_4 <- rjags::coda.samples(model = model_4, variable.names = JAGS_to_monitor(prior_list_4), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_4 <- do.call(rbind, samples_4) - - df_4 <- df_all - contrasts(df_4$x_fac2o) <- contr.orthonormal(levels(df_4$x_fac2o)) - lm_4 <- stats::lm(y ~ x_fac2o, data = df_4) - - vdiffr::expect_doppelganger("JAGS-formula-lm-4", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_4[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_4)["(Intercept)"], sd = summary(lm_4)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_4[,"mu_x_fac2o"], freq = FALSE, main = "x_fac2o") - curve(dnorm(x, mean = coef(lm_4)["x_fac2o1"], sd = summary(lm_4)$coefficients["x_fac2o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_4[,"sigma"], freq = FALSE, main = "sigma") - abline(v = sigma(lm_4), lwd = 3) - }) - - - # linear regression with a treatment factor (3 levels) ---- - formula_5 <- JAGS_formula(~ x_fac3t, parameter = "mu", data = df_all[,"x_fac3t",drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac3t")]) - prior_list_5 <- c(formula_5$prior_list, prior_list2) - model_syntax_5 <- JAGS_add_priors(paste0("model{", formula_5$formula_syntax, model_syntax, "}"), prior_list_5) - data_5 <- c(formula_5$data, N = nrow(df_all), y = list(df_all$y)) - - model_5 <- rjags::jags.model(file = textConnection(model_syntax_5), inits = JAGS_get_inits(prior_list_5, chains = 2, seed = 1), data = data_5, n.chains = 2, quiet = TRUE) - samples_5 <- rjags::coda.samples(model = model_5, variable.names = JAGS_to_monitor(prior_list_5), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_5 <- do.call(rbind, samples_5) - - lm_5 <- stats::lm(y ~ x_fac3t, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-5", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_5[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_5)["(Intercept)"], sd = summary(lm_5)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_5[,"mu_x_fac3t[1]"], freq = FALSE, main = "x_fac3t[1]") - curve(dnorm(x, mean = coef(lm_5)["x_fac3tB"], sd = summary(lm_5)$coefficients["x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_5[,"mu_x_fac3t[2]"], freq = FALSE, main = "x_fac3t[2]") - curve(dnorm(x, mean = coef(lm_5)["x_fac3tC"], sd = summary(lm_5)$coefficients["x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - }) - - - # linear regression with an orthonormal factor (3 levels) ---- - formula_6 <- JAGS_formula(~ x_fac3o, parameter = "mu", data = df_all[,"x_fac3o",drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac3o")]) - prior_list_6 <- c(formula_6$prior_list, prior_list2) - model_syntax_6 <- JAGS_add_priors(paste0("model{", formula_6$formula_syntax, model_syntax, "}"), prior_list_6) - data_6 <- c(formula_6$data, N = nrow(df_all), y = list(df_all$y)) - - model_6 <- rjags::jags.model(file = textConnection(model_syntax_6), inits = JAGS_get_inits(prior_list_6, chains = 2, seed = 1), data = data_6, n.chains = 2, quiet = TRUE) - samples_6 <- rjags::coda.samples(model = model_6, variable.names = JAGS_to_monitor(prior_list_6), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_6 <- do.call(rbind, samples_6) - - df_6 <- df_all - contrasts(df_6$x_fac3o) <- contr.orthonormal(levels(df_6$x_fac3o)) - lm_6 <- stats::lm(y ~ x_fac3o, data = df_6) - - vdiffr::expect_doppelganger("JAGS-formula-lm-6", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_6[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_6)["(Intercept)"], sd = summary(lm_6)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_6[,"mu_x_fac3o[1]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_6)["x_fac3o1"], sd = summary(lm_6)$coefficients["x_fac3o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_6[,"mu_x_fac3o[2]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_6)["x_fac3o2"], sd = summary(lm_6)$coefficients["x_fac3o2", "Std. Error"]), add = TRUE, lwd = 2) - }) - - - # linear regression with an orthonormal interaction between factors ---- - formula_7 <- JAGS_formula(~ x_fac2t * x_fac3o, parameter = "mu", data = df_all[,c("x_fac2t", "x_fac3o")], prior_list = prior_list_all[c("intercept", "x_fac2t", "x_fac3o", "x_fac2t:x_fac3o")]) - prior_list_7 <- c(formula_7$prior_list, prior_list2) - model_syntax_7 <- JAGS_add_priors(paste0("model{", formula_7$formula_syntax, model_syntax, "}"), prior_list_7) - data_7 <- c(formula_7$data, N = nrow(df_all), y = list(df_all$y)) - - model_7 <- rjags::jags.model(file = textConnection(model_syntax_7), inits = JAGS_get_inits(prior_list_7, chains = 2, seed = 1), data = data_7, n.chains = 2, quiet = TRUE) - samples_7 <- rjags::coda.samples(model = model_7, variable.names = JAGS_to_monitor(prior_list_7), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_7 <- do.call(rbind, samples_7) - - df_7 <- df_all - contrasts(df_7$x_fac3o) <- contr.orthonormal(levels(df_7$x_fac3o)) - lm_7 <- stats::lm(y ~ x_fac2t * x_fac3o, data = df_7) - - vdiffr::expect_doppelganger("JAGS-formula-lm-7", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - hist(samples_7[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_7)["(Intercept)"], sd = summary(lm_7)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_7[,"mu_x_fac3o[1]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_7)["x_fac3o1"], sd = summary(lm_7)$coefficients["x_fac3o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_7[,"mu_x_fac3o[2]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_7)["x_fac3o2"], sd = summary(lm_7)$coefficients["x_fac3o2", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_7[,"mu_x_fac2t"], freq = FALSE, main = "x_fac2t") - curve(dnorm(x, mean = coef(lm_7)["x_fac2tB"], sd = summary(lm_7)$coefficients["x_fac2tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_7[,"mu_x_fac2t__xXx__x_fac3o[1]"], freq = FALSE, main = "x_fac2t:x_fac3o") - curve(dnorm(x, mean = coef(lm_7)["x_fac2tB:x_fac3o1"], sd = summary(lm_7)$coefficients["x_fac2tB:x_fac3o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_7[,"mu_x_fac2t__xXx__x_fac3o[2]"], freq = FALSE, main = "x_fac2t:x_fac3o") - curve(dnorm(x, mean = coef(lm_7)["x_fac2tB:x_fac3o2"], sd = summary(lm_7)$coefficients["x_fac2tB:x_fac3o2", "Std. Error"]), add = TRUE, lwd = 2) - - }) - - - # linear regression with a treatment interaction between factors ---- - formula_8 <- JAGS_formula(~ x_fac2o * x_fac3t, parameter = "mu", data = df_all[,c("x_fac2o", "x_fac3t")], prior_list = prior_list_all[c("intercept", "x_fac2o", "x_fac3t", "x_fac2o:x_fac3t")]) - prior_list_8 <- c(formula_8$prior_list, prior_list2) - model_syntax_8 <- JAGS_add_priors(paste0("model{", formula_8$formula_syntax, model_syntax, "}"), prior_list_8) - data_8 <- c(formula_8$data, N = nrow(df_all), y = list(df_all$y)) - - model_8 <- rjags::jags.model(file = textConnection(model_syntax_8), inits = JAGS_get_inits(prior_list_8, chains = 2, seed = 1), data = data_8, n.chains = 2, quiet = TRUE) - samples_8 <- rjags::coda.samples(model = model_8, variable.names = JAGS_to_monitor(prior_list_8), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_8 <- do.call(rbind, samples_8) - - df_8 <- df_all - contrasts(df_8$x_fac2o) <- contr.orthonormal(levels(df_8$x_fac2o)) - lm_8 <- stats::lm(y ~ x_fac2o * x_fac3t, data = df_8) - - vdiffr::expect_doppelganger("JAGS-formula-lm-8", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - hist(samples_8[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_8)["(Intercept)"], sd = summary(lm_8)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_8[,"mu_x_fac3t[1]"], freq = FALSE, main = "x_fac3t") - curve(dnorm(x, mean = coef(lm_8)["x_fac3tB"], sd = summary(lm_8)$coefficients["x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_8[,"mu_x_fac3t[2]"], freq = FALSE, main = "x_fac3t") - curve(dnorm(x, mean = coef(lm_8)["x_fac3tC"], sd = summary(lm_8)$coefficients["x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_8[,"mu_x_fac2o"], freq = FALSE, main = "x_fac2o") - curve(dnorm(x, mean = coef(lm_8)["x_fac2o1"], sd = summary(lm_8)$coefficients["x_fac2o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_8[,"mu_x_fac2o__xXx__x_fac3t[1]"], freq = FALSE, main = "x_fac2o:fac3t") - curve(dnorm(x, mean = coef(lm_8)["x_fac2o1:x_fac3tB"], sd = summary(lm_8)$coefficients["x_fac2o1:x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_8[,"mu_x_fac2o__xXx__x_fac3t[2]"], freq = FALSE, main = "x_fac2o:fac3t") - curve(dnorm(x, mean = coef(lm_8)["x_fac2o1:x_fac3tC"], sd = summary(lm_8)$coefficients["x_fac2o1:x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - - }) - # linear regression with an interaction between continuous variable and orthonormal factor ---- - formula_9 <- JAGS_formula(~ x_cont1 * x_fac3o , parameter = "mu", data = df_all[,c("x_cont1", "x_fac3o")], prior_list = prior_list_all[c("intercept", "x_cont1", "x_fac3o", "x_cont1:x_fac3o")]) - prior_list_9 <- c(formula_9$prior_list, prior_list2) - model_syntax_9 <- JAGS_add_priors(paste0("model{", formula_9$formula_syntax, model_syntax, "}"), prior_list_9) - data_9 <- c(formula_9$data, N = nrow(df_all), y = list(df_all$y)) - - model_9 <- rjags::jags.model(file = textConnection(model_syntax_9), inits = JAGS_get_inits(prior_list_9, chains = 2, seed = 1), data = data_9, n.chains = 2, quiet = TRUE) - samples_9 <- rjags::coda.samples(model = model_9, variable.names = JAGS_to_monitor(prior_list_9), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_9 <- do.call(rbind, samples_9) - - df_9 <- df_all - contrasts(df_9$x_fac3o) <- contr.orthonormal(levels(df_9$x_fac3o)) - lm_9 <- stats::lm(y ~ x_cont1 * x_fac3o, data = df_9) - - vdiffr::expect_doppelganger("JAGS-formula-lm-9", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - hist(samples_9[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_9)["(Intercept)"], sd = summary(lm_9)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_9[,"mu_x_fac3o[1]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_9)["x_fac3o1"], sd = summary(lm_9)$coefficients["x_fac3o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_9[,"mu_x_fac3o[2]"], freq = FALSE, main = "x_fac3o") - curve(dnorm(x, mean = coef(lm_9)["x_fac3o2"], sd = summary(lm_9)$coefficients["x_fac3o2", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_9[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - curve(dnorm(x, mean = coef(lm_9)["x_cont1"], sd = summary(lm_9)$coefficients["x_cont1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_9[,"mu_x_cont1__xXx__x_fac3o[1]"], freq = FALSE, main = "x_cont1:x_fac3o") - curve(dnorm(x, mean = coef(lm_9)["x_cont1:x_fac3o1"], sd = summary(lm_9)$coefficients["x_cont1:x_fac3o1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_9[,"mu_x_cont1__xXx__x_fac3o[2]"], freq = FALSE, main = "x_cont1:x_fac3o") - curve(dnorm(x, mean = coef(lm_9)["x_cont1:x_fac3o2"], sd = summary(lm_9)$coefficients["x_cont1:x_fac3o2", "Std. Error"]), add = TRUE, lwd = 2) - - }) - - - # linear regression with an interaction between continuous variable and orthonormal factor ---- - formula_10 <- JAGS_formula(~ x_cont1 * x_fac3t , parameter = "mu", data = df_all[,c("x_cont1", "x_fac3t")], prior_list = prior_list_all[c("intercept", "x_cont1", "x_fac3t", "x_cont1:x_fac3t")]) - prior_list_10 <- c(formula_10$prior_list, prior_list2) - model_syntax_10 <- JAGS_add_priors(paste0("model{", formula_10$formula_syntax, model_syntax, "}"), prior_list_10) - data_10 <- c(formula_10$data, N = nrow(df_all), y = list(df_all$y)) - - model_10 <- rjags::jags.model(file = textConnection(model_syntax_10), inits = JAGS_get_inits(prior_list_10, chains = 2, seed = 1), data = data_10, n.chains = 2, quiet = TRUE) - samples_10 <- rjags::coda.samples(model = model_10, variable.names = JAGS_to_monitor(prior_list_10), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_10 <- do.call(rbind, samples_10) - - lm_10 <- stats::lm(y ~ x_cont1 * x_fac3t, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-10", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfrow = c(2, 3)) - - hist(samples_10[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_10)["(Intercept)"], sd = summary(lm_10)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_10[,"mu_x_fac3t[1]"], freq = FALSE, main = "x_fac3t") - curve(dnorm(x, mean = coef(lm_10)["x_fac3tB"], sd = summary(lm_10)$coefficients["x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_10[,"mu_x_fac3t[2]"], freq = FALSE, main = "x_fac3t") - curve(dnorm(x, mean = coef(lm_10)["x_fac3tC"], sd = summary(lm_10)$coefficients["x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_10[,"mu_x_cont1"], freq = FALSE, main = "x_cont1") - curve(dnorm(x, mean = coef(lm_10)["x_cont1"], sd = summary(lm_10)$coefficients["x_cont1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_10[,"mu_x_cont1__xXx__x_fac3t[1]"], freq = FALSE, main = "x_cont1:x_fac3t") - curve(dnorm(x, mean = coef(lm_10)["x_cont1:x_fac3tB"], sd = summary(lm_10)$coefficients["x_cont1:x_fac3tB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_10[,"mu_x_cont1__xXx__x_fac3t[2]"], freq = FALSE, main = "x_cont1:x_fac3t") - curve(dnorm(x, mean = coef(lm_10)["x_cont1:x_fac3tC"], sd = summary(lm_10)$coefficients["x_cont1:x_fac3tC", "Std. Error"]), add = TRUE, lwd = 2) - - }) - - - # scaling formula parameters by another parameter works ---- - prior_list_1s <- prior_list_all[c("intercept", "x_cont1")] - attr(prior_list_1s$x_cont1, "multiply_by") <- "sigma" - formula_1s <- JAGS_formula(~ x_cont1, parameter = "mu", data = df_all[,"x_cont1", drop = FALSE], prior_list = prior_list_1s) - prior_list_1s <- c(formula_1s$prior_list, prior_list2) - model_syntax_1s<- JAGS_add_priors(paste0("model{", formula_1s$formula_syntax, model_syntax, "}"), prior_list_1s) - data_1 <- c(formula_1$data, N = nrow(df_all), y = list(df_all$y)) - - model_1s <- rjags::jags.model(file = textConnection(model_syntax_1s), inits = JAGS_get_inits(prior_list_1s, chains = 2, seed = 1), data = data_1, n.chains = 2, quiet = TRUE) - samples_1s <- rjags::coda.samples(model = model_1s, variable.names = JAGS_to_monitor(prior_list_1s), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_1s <- do.call(rbind, samples_1s) - - expect_equal(formula_1s$formula_syntax, "for(i in 1:N_mu){\n mu[i] = mu_intercept + sigma * mu_x_cont1 * mu_data_x_cont1[i]\n}\n") - - lm_1s <- stats::lm(y ~ I(sd(y) * x_cont1), data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-1s", function(){ - - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_1s[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_1s)["(Intercept)"], sd = summary(lm_1s)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_1s[,"mu_x_cont1"], freq = FALSE, main = "I(sd(y) * x_cont1)") - curve(dnorm(x, mean = coef(lm_1s)["I(sd(y) * x_cont1)"], sd = summary(lm_1s)$coefficients["I(sd(y) * x_cont1)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_1s[,"sigma"], freq = FALSE, main = "sigma") - abline(v = sigma(lm_1s), lwd = 3) - }) - - - # input checks work - expect_error(JAGS_formula(~ x_cont1 , parameter = "mu", data = df_all[,c("x_cont1"), drop = FALSE], prior_list = prior_list_all[c("x_cont1")]), - "The 'intercept' objects are missing in the 'prior_list' argument.") - expect_error(JAGS_formula(~ x_cont1 , parameter = "mu", data = df_all[,c("x_cont1"), drop = FALSE], prior_list = prior_list_all[c("intercept")]), - "The 'x_cont1' objects are missing in the 'prior_list' argument.") - expect_error(JAGS_formula(~ x_fac2t , parameter = "mu", data = df_all[,c("x_cont1"), drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac2t")]), - "The 'x_fac2t' predictor variable is missing in the data set.") - expect_error(JAGS_formula(~ x_fac2t , parameter = "mu", data = as.matrix(df_all), prior_list = prior_list_all[c("intercept", "x_fac2t")]), - "'data' must be a data.frame") - expect_error(JAGS_formula(~ x_fac2t , parameter = "mu", data = df_all, prior_list = list( - "intercept" = prior("normal", list(0, 1)), - "x_fac2t" = prior("normal", list(0, 1)) - )), "Unsupported prior distribution defined for 'x_fac2t' factor variable") - expect_error(JAGS_formula(~ x_cont1 , parameter = "mu", data = df_all, prior_list = list( - "intercept" = prior("normal", list(0, 1)), - "x_cont1" = prior_factor("normal", list(0, 1), contrast = "treatment") - )), "Unsupported prior distribution defined for 'x_cont1' continuous variable.") - - # linear regression with an independent factor (3 levels) ---- - formula_11 <- JAGS_formula(~ x_fac3i - 1, parameter = "mu", data = df_all[,"x_fac3i",drop = FALSE], prior_list = prior_list_all[c("x_fac3i")]) - prior_list_11 <- c(formula_11$prior_list, prior_list2) - model_syntax_11 <- JAGS_add_priors(paste0("model{", formula_11$formula_syntax, model_syntax, "}"), prior_list_11) - data_11 <- c(formula_11$data, N = nrow(df_all), y = list(df_all$y)) - - model_11 <- rjags::jags.model(file = textConnection(model_syntax_11), inits = JAGS_get_inits(prior_list_11, chains = 2, seed = 1), data = data_11, n.chains = 2, quiet = TRUE) - samples_11 <- rjags::coda.samples(model = model_11, variable.names = JAGS_to_monitor(prior_list_11), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_11 <- do.call(rbind, samples_11) - - lm_11 <- stats::lm(y ~ x_fac3i - 1, data = df_all) - - vdiffr::expect_doppelganger("JAGS-formula-lm-11", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_11[,"mu_x_fac3i[1]"], freq = FALSE, main = "x_fac3i[1]") - curve(dnorm(x, mean = coef(lm_11)["x_fac3iA"], sd = summary(lm_11)$coefficients["x_fac3iA", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_11[,"mu_x_fac3i[2]"], freq = FALSE, main = "x_fac3i[2]") - curve(dnorm(x, mean = coef(lm_11)["x_fac3iB"], sd = summary(lm_11)$coefficients["x_fac3iB", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_11[,"mu_x_fac3i[3]"], freq = FALSE, main = "x_fac3i[3]") - curve(dnorm(x, mean = coef(lm_11)["x_fac3iC"], sd = summary(lm_11)$coefficients["x_fac3iC", "Std. Error"]), add = TRUE, lwd = 2) - }) - - - # linear regression with a meandif factor (3 levels) ---- - formula_12 <- JAGS_formula(~ x_fac3md, parameter = "mu", data = df_all[,"x_fac3md",drop = FALSE], prior_list = prior_list_all[c("intercept", "x_fac3md")]) - prior_list_12 <- c(formula_12$prior_list, prior_list2) - model_syntax_12 <- JAGS_add_priors(paste0("model{", formula_12$formula_syntax, model_syntax, "}"), prior_list_12) - data_12 <- c(formula_12$data, N = nrow(df_all), y = list(df_all$y)) - - model_12 <- rjags::jags.model(file = textConnection(model_syntax_12), inits = JAGS_get_inits(prior_list_12, chains = 2, seed = 1), data = data_12, n.chains = 2, quiet = TRUE) - samples_12 <- rjags::coda.samples(model = model_12, variable.names = JAGS_to_monitor(prior_list_12), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_12 <- do.call(rbind, samples_12) - - df_12 <- df_all - contrasts(df_12$x_fac3md) <- contr.meandif(levels(df_12$x_fac3o)) - lm_12 <- stats::lm(y ~ x_fac3md, data = df_12) - - vdiffr::expect_doppelganger("JAGS-formula-lm-12", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_12[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_12)["(Intercept)"], sd = summary(lm_12)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_12[,"mu_x_fac3md[1]"], freq = FALSE, main = "x_fac3md") - curve(dnorm(x, mean = coef(lm_12)["x_fac3md1"], sd = summary(lm_12)$coefficients["x_fac3md1", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_12[,"mu_x_fac3md[2]"], freq = FALSE, main = "x_fac3md") - curve(dnorm(x, mean = coef(lm_12)["x_fac3md2"], sd = summary(lm_12)$coefficients["x_fac3md2", "Std. Error"]), add = TRUE, lwd = 2) - }) - - - # linear regression with a spike independent factor (3 levels) ---- - prior_list_13 <- list("x_fac3i" = prior_factor("spike", contrast = "independent", list(1.5))) - formula_13 <- JAGS_formula(~ x_fac3i - 1, parameter = "mu", data = df_all[,"x_fac3i",drop = FALSE], prior_list = prior_list_13) - prior_list_13 <- c(formula_13$prior_list, prior_list2) - model_syntax_13 <- JAGS_add_priors(paste0("model{", formula_13$formula_syntax, model_syntax, "}"), prior_list_13) - data_13 <- c(formula_13$data, N = nrow(df_all), y = list(df_all$y)) - - model_13 <- rjags::jags.model(file = textConnection(model_syntax_13), inits = JAGS_get_inits(prior_list_13, chains = 2, seed = 1), data = data_13, n.chains = 2, quiet = TRUE) - samples_13 <- rjags::coda.samples(model = model_13, variable.names = JAGS_to_monitor(prior_list_13), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_13 <- do.call(rbind, samples_13) - expect_equal(diag(3), contr.independent(1:3)) - - vdiffr::expect_doppelganger("JAGS-formula-lm-13", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_13[,"mu_x_fac3i[1]"], freq = FALSE, main = "x_fac3i[1]") - hist(samples_13[,"mu_x_fac3i[2]"], freq = FALSE, main = "x_fac3i[2]") - hist(samples_13[,"mu_x_fac3i[3]"], freq = FALSE, main = "x_fac3i[3]") - }) - - - # linear regression with a meandif spike factor (3 levels) ---- - prior_list_14 <- list("intercept" = prior_list_all$intercept, "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0))) - formula_14 <- JAGS_formula(~ x_fac3md, parameter = "mu", data = df_all[,"x_fac3md",drop = FALSE], prior_list = prior_list_14) - prior_list_14 <- c(formula_14$prior_list, prior_list2) - model_syntax_14 <- JAGS_add_priors(paste0("model{", formula_14$formula_syntax, model_syntax, "}"), prior_list_14) - data_14 <- c(formula_14$data, N = nrow(df_all), y = list(df_all$y)) - - model_14 <- rjags::jags.model(file = textConnection(model_syntax_14), inits = JAGS_get_inits(prior_list_14, chains = 2, seed = 1), data = data_14, n.chains = 2, quiet = TRUE) - samples_14 <- rjags::coda.samples(model = model_14, variable.names = JAGS_to_monitor(prior_list_14), n.iter = 5000, quiet = TRUE, progress.bar = "none") - samples_14 <- do.call(rbind, samples_14) - - df_14 <- df_all - contrasts(df_14$x_fac3md) <- contr.meandif(levels(df_14$x_fac3o)) - lm_14 <- stats::lm(y ~ 1, data = df_14) - - vdiffr::expect_doppelganger("JAGS-formula-lm-14", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, 3)) - - hist(samples_14[,"mu_intercept"], freq = FALSE, main = "Intercept") - curve(dnorm(x, mean = coef(lm_14)["(Intercept)"], sd = summary(lm_14)$coefficients["(Intercept)", "Std. Error"]), add = TRUE, lwd = 2) - - hist(samples_14[,"mu_x_fac3md[1]"], freq = FALSE, main = "x_fac3md") - hist(samples_14[,"mu_x_fac3md[2]"], freq = FALSE, main = "x_fac3md") - }) - -}) +# Load common test helpers +source(testthat::test_path("common-functions.R")) test_that("JAGS formula tools work", { @@ -571,11 +37,13 @@ test_that("JAGS formula tools work", { test_that("JAGS evaluate formula works", { - # check the posterior distributions with weak priors against a maximum likelihood estimates with ML + # Test JAGS_evaluate_formula by comparing against lm() predictions using ML estimates. + # This test constructs samples manually (from ML estimates) - no pre-fitted JAGS model needed. skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes skip_on_cran() + skip_if_not_installed("rjags") - # complex formula including scaling + # Setup: complex formula including scaling set.seed(1) df_all <- data.frame( x_cont1 = rnorm(60), @@ -597,19 +65,14 @@ test_that("JAGS evaluate formula works", { prior_list2 <- list( "sigma" = prior("cauchy", list(0, 1), list(0, 1)) ) - model_syntax <- paste0( - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n" - ) - formula <- JAGS_formula(~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, parameter = "mu", data = df_all, prior_list = prior_list_all) - prior_list <- c(formula$prior_list, prior_list2) - model_syntax <- JAGS_add_priors(paste0("model{", formula$formula_syntax, model_syntax, "}"), prior_list) - data <- c(formula$data, N = nrow(df_all), y = list(df_all$y)) + # Use JAGS_formula to process formula and get prior_list with correct parameter names + formula_result <- JAGS_formula(~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, parameter = "mu", data = df_all, prior_list = prior_list_all) + prior_list <- c(formula_result$prior_list, prior_list2) - model <- rjags::jags.model(file = textConnection(model_syntax), inits = JAGS_get_inits(prior_list, chains = 1, seed = 1), data = data, n.chains = 1, quiet = TRUE) - samples <- rjags::coda.samples(model = model, variable.names = JAGS_to_monitor(prior_list), n.iter = 10, quiet = TRUE, progress.bar = "none") + # Define expected column names for samples (must match what JAGS_formula produces) + col_names <- c("mu_intercept", "mu_x_cont1", "mu_x_cont1__xXx__x_fac3o[1]", "mu_x_cont1__xXx__x_fac3o[2]", + "mu_x_cont2", "mu_x_fac2t", "mu_x_fac3o[1]", "mu_x_fac3o[2]", "sigma") new_data <- data.frame( x_cont1 = c(0, 0, 1, 1), @@ -618,29 +81,30 @@ test_that("JAGS evaluate formula works", { x_fac3o = factor(c("A", "B", "C", "A"), levels = c("A", "B", "C")) ) - # test the results against the lm function (by passing the ML estimates) + # Test the results against the lm function (by passing the ML estimates) contrasts(df_all$x_fac3o) <- contr.orthonormal(levels(df_all$x_fac3o)) - fit_lm <- stats::lm(y~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, data = df_all) + fit_lm <- stats::lm(y ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, data = df_all) + # Create mock samples from ML estimates samples_new <- c(coef(fit_lm), sigma = sigma(fit_lm))[c("(Intercept)","x_cont1","x_cont1:x_fac3o1","x_cont1:x_fac3o2","x_cont2","x_fac2tB","x_fac3o1","x_fac3o2","sigma")] samples_new <- matrix(samples_new, nrow = 1) - colnames(samples_new) <- colnames(samples[[1]]) + colnames(samples_new) <- col_names samples_new <- coda::as.mcmc.list(coda::as.mcmc(samples_new)) expect_equal(predict(fit_lm, newdata = new_data), JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list)[,1]) - # for a posterior samples matrix + # For a posterior samples matrix (multiple rows) samples_new <- c(coef(fit_lm), sigma = sigma(fit_lm))[c("(Intercept)","x_cont1","x_cont1:x_fac3o1","x_cont1:x_fac3o2","x_cont2","x_fac2tB","x_fac3o1","x_fac3o2","sigma")] samples_new <- matrix(samples_new, nrow = 5, ncol = length(samples_new), byrow = TRUE) - colnames(samples_new) <- colnames(samples[[1]]) + colnames(samples_new) <- col_names samples_new <- coda::as.mcmc.list(coda::as.mcmc(samples_new)) expect_equal(matrix(predict(fit_lm, newdata = new_data), nrow = 4, ncol = 5), unname(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list))) - # check filling in missing or miss ordered factor levels + # Check filling in missing or miss-ordered factor levels samples_new <- c(coef(fit_lm), sigma = sigma(fit_lm))[c("(Intercept)","x_cont1","x_cont1:x_fac3o1","x_cont1:x_fac3o2","x_cont2","x_fac2tB","x_fac3o1","x_fac3o2","sigma")] samples_new <- matrix(samples_new, nrow = 1) - colnames(samples_new) <- colnames(samples[[1]]) + colnames(samples_new) <- col_names samples_new <- coda::as.mcmc.list(coda::as.mcmc(samples_new)) new_data2 <- new_data @@ -655,29 +119,22 @@ test_that("JAGS evaluate formula works", { new_data4$x_fac3o <- c("A", "B", "A", "B") expect_equal(predict(fit_lm, newdata = new_data3), JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data4, prior_list)[,1]) - # check scaling works (by multiplying be zero) - prior_list2 <- prior_list - attr(prior_list2$mu_x_cont2, "multiply_by") <- 0 - attr(prior_list2$mu_x_fac2t, "multiply_by") <- 0 + # Check scaling works (by multiplying by zero) + prior_list_scaled <- prior_list + attr(prior_list_scaled$mu_x_cont2, "multiply_by") <- 0 + attr(prior_list_scaled$mu_x_fac2t, "multiply_by") <- 0 samples_new2 <- c(coef(fit_lm), sigma = sigma(fit_lm))[c("(Intercept)","x_cont1","x_cont1:x_fac3o1","x_cont1:x_fac3o2","x_cont2","x_fac2tB","x_fac3o1","x_fac3o2","sigma")] samples_new2 <- matrix(samples_new2, nrow = 1) - colnames(samples_new2) <- colnames(samples[[1]]) - samples_new2[,"mu_x_cont2"] <- 0 + colnames(samples_new2) <- col_names + samples_new2[,"mu_x_cont2"] <- 0 samples_new2[,"mu_x_fac2t"] <- 0 samples_new2 <- coda::as.mcmc.list(coda::as.mcmc(samples_new2)) - expect_equal(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list2)[,1], + expect_equal(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list_scaled)[,1], JAGS_evaluate_formula(samples_new2, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list)[,1]) - # check scaling by another parameter works - prior_list2 <- prior_list - attr(prior_list2$mu_x_cont2, "multiply_by") <- "sigma" - - expect_equal(unname(unlist(JAGS_evaluate_formula(samples, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list2)[,1])), - c(0.4436353, -0.0658681, 0.1870391, 0.8548012), tolerance = 1e-5) - - ### test input tests + ### Test input validation expect_error(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data[,1:3], prior_list), "The 'x_fac3o' predictor variable is missing in the data.") expect_error(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", new_data, prior_list[-1]), @@ -694,83 +151,70 @@ test_that("JAGS evaluate formula works", { expect_error(JAGS_evaluate_formula(samples_new, ~ x_fac2t + x_cont2 + x_cont1 * x_fac3o, "mu", bad_data2, prior_list), "Levels specified in the 'x_fac2t' factor variable do not match the levels used for model specification.") +}) - # evaluate formula with spike prior distributions ---- - set.seed(1) - df_all <- data.frame( - x_fac2i = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(sample(c("A", "B", "C"), 60, replace = TRUE), levels = c("A", "B", "C")), - x_fac3t = factor(sample(c("A", "B", "C"), 60, replace = TRUE), levels = c("A", "B", "C")), - x_fac3md = factor(sample(c("A", "B", "C"), 60, replace = TRUE), levels = c("A", "B", "C")) - ) - df_all$y <- rnorm(60, 0.1, 0.5) - prior_list_all <- list( - "intercept" = prior("normal", list(0, 5)), - "x_fac2i" = prior_factor("spike", contrast = "independent", list(1)), - "x_fac3o" = prior_factor("spike", contrast = "orthonormal", list(0)), - "x_fac3t" = prior_factor("spike", contrast = "treatment", list(2)), - "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) - ) - prior_list2 <- list( - "sigma" = prior("cauchy", list(0, 1), list(0, 1)) - ) - model_syntax <- paste0( - "model{", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) +test_that("JAGS evaluate formula works with spike priors", { - fit1 <- JAGS_fit( - model_syntax = model_syntax, - formula_list = list(mu = ~ x_fac2i + x_fac3o + x_fac3t + x_fac3md), - data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list2, - formula_data_list = list(mu = df_all), - formula_prior_list = list(mu = prior_list_all)) + # Test JAGS_evaluate_formula with spike prior distributions using pre-fitted model + skip_on_os(c("mac", "linux", "solaris")) + skip_on_cran() + skip_if_not_installed("rjags") - new_data <- data.frame( + # Load pre-fitted model with spike factor priors (all 4 contrast types) + fit_spike <- readRDS(file.path(temp_fits_dir, "fit_spike_factors.RDS")) + + # New data for prediction + new_data <- data.frame( x_fac2i = factor(c("A", "B", "A"), levels = c("A", "B")), x_fac3o = factor(c("A", "A", "B"), levels = c("A", "B", "C")), x_fac3t = factor(c("A", "B", "C"), levels = c("A", "B", "C")), x_fac3md = factor(c("B", "B", "C"), levels = c("A", "B", "C")) ) - new_samples <- JAGS_evaluate_formula(fit1, ~ x_fac2i + x_fac3o + x_fac3t + x_fac3md, "mu", new_data, attr(fit1, "prior_list")) - new_samples <- apply(new_samples, 1, mean) - - intercept_estimate <- JAGS_estimates_table(fit1)["(mu) intercept", "Mean"] - - expect_equivalent(intercept_estimate + 1, new_samples[1]) - expect_equivalent(intercept_estimate + 1 + 2, new_samples[2]) - expect_equivalent(intercept_estimate + 1 + 2, new_samples[3]) - - - # dealing with spike and slab and mixture priors - prior_list_all2 <- list( - "intercept" = prior_spike_and_slab(prior("normal", list(0, 5))), - "x_fac2i" = prior_mixture(list( - prior("spike", list(1)), - prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ), is_null = c(T, F)), - "x_fac3o" = prior_spike_and_slab(prior_factor("mnormal", contrast = "orthonormal", list(0, 1))), - "x_fac3t" = prior_mixture(list( - prior_factor("normal", contrast = "treatment", list(0, 1)), - prior("spike", list(0)) - ), is_null = c(T, F)) + + # Note: fit_spike_factors uses formula ~ x_fac2i + x_fac3o + x_fac3t + x_fac3md - 1 + # with spike priors: independent(1), orthonormal(0), treatment(2), meandif(0) + prior_list <- attr(fit_spike, "prior_list") + new_samples <- JAGS_evaluate_formula(fit_spike, ~ x_fac2i + x_fac3o + x_fac3t + x_fac3md - 1, "mu", new_data, prior_list) + new_samples_mean <- apply(new_samples, 1, mean) + + # Verify spike values are correctly applied: + # - x_fac2i independent spike(1): each level gets value 1 + # - x_fac3o orthonormal spike(0): contrast coefficients are 0 + # - x_fac3t treatment spike(2): non-reference levels get value 2 + # - x_fac3md meandif spike(0): differences from mean are 0 + # Row 1: A(1) + A(0) + A(ref=0) + B(0) = 1 + # Row 2: B(1) + A(0) + B(2) + B(0) = 3 + # Row 3: A(1) + B(0) + C(2) + C(0) = 3 + expect_equivalent(new_samples_mean[1], 1, tolerance = 0.01) + expect_equivalent(new_samples_mean[2], 3, tolerance = 0.01) + expect_equivalent(new_samples_mean[3], 3, tolerance = 0.01) +}) + + +test_that("JAGS evaluate formula works with spike-and-slab and mixture priors", { + + # Test JAGS_evaluate_formula with spike-and-slab and mixture priors using pre-fitted model + skip_on_os(c("mac", "linux", "solaris")) + skip_on_cran() + skip_if_not_installed("rjags") + + # Load pre-fitted joint complex model (mixture intercept, spike-and-slab continuous, spike-and-slab factor) + fit_joint <- readRDS(file.path(temp_fits_dir, "fit_joint_complex.RDS")) + + # New data for prediction + new_data <- data.frame( + x_cont1 = c(0, 1, -1), + x_fac3t = factor(c("A", "B", "C"), levels = c("A", "B", "C")) ) - fit2 <- JAGS_fit( - model_syntax = model_syntax, - formula_list = list(mu = ~ x_fac2i + x_fac3o + x_fac3t), - data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list2, - formula_data_list = list(mu = df_all), - formula_prior_list = list(mu = prior_list_all2), chains = 1, adapt = 100, burnin = 100, sample = 200) - new_samples <- JAGS_evaluate_formula(fit2, ~ x_fac2i + x_fac3o + x_fac3t, "mu", new_data, attr(fit2, "prior_list")) - expect_equivalent(dim(new_samples), c(3, 200)) + # fit_joint_complex uses formula ~ x_cont1 + x_fac3t + prior_list <- attr(fit_joint, "prior_list") + new_samples <- JAGS_evaluate_formula(fit_joint, ~ x_cont1 + x_fac3t, "mu", new_data, prior_list) + # Should return samples for 3 new data points x number of posterior samples + expect_equal(nrow(new_samples), 3) + expect_equal(ncol(new_samples), 1000) }) test_that("Expression handling functions work", { @@ -859,21 +303,21 @@ test_that("-1 (no intercept) formula handling works correctly", { x_fac3i = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), x_cont = rnorm(60) ) - + # Test 1: Basic -1 formula functionality prior_list_basic <- list( "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 1)) ) - result_basic <- JAGS_formula(~ x_fac3md - 1, parameter = "mu", - data = df_test[, "x_fac3md", drop = FALSE], + result_basic <- JAGS_formula(~ x_fac3md - 1, parameter = "mu", + data = df_test[, "x_fac3md", drop = FALSE], prior_list = prior_list_basic) - + # The -1 should automatically add spike(0) intercept expect_true("mu_intercept" %in% names(result_basic$prior_list)) expect_true(is.prior.point(result_basic$prior_list$mu_intercept)) expect_equal(result_basic$prior_list$mu_intercept$parameters$location, 0) expect_true(grepl("mu_intercept", result_basic$formula_syntax)) - + # Test 2: Helper function test expect_equal(.add_intercept_to_formula(~ x - 1), ~ x) expect_equal(.add_intercept_to_formula(~ x + y - 1), ~ x + y) diff --git a/tests/testthat/test-marginal-distributions.R b/tests/testthat/test-JAGS-marginal-distributions.R similarity index 78% rename from tests/testthat/test-marginal-distributions.R rename to tests/testthat/test-JAGS-marginal-distributions.R index cac2232..ba064ae 100644 --- a/tests/testthat/test-marginal-distributions.R +++ b/tests/testthat/test-JAGS-marginal-distributions.R @@ -1,21 +1,28 @@ context("Marginal distributions") -set.seed(1) + +# This file tests marginal_posterior, ensemble_inference, mix_posteriors, +# and related functions. Uses pre-fitted models from test-00-model-fits.R. + +# Reference directory for table outputs +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-marginal-distributions") + +# Load common test helpers +source(testthat::test_path("common-functions.R")) test_that("Marginal distribution prior and posterior functions work", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes skip_on_cran() + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") - ### complex formula including scaling ---- - set.seed(1) - df_all <- data.frame( - x_cont1 = rnorm(180), - x_fac2t = factor(rep(c("A", "B"), 90), levels = c("A", "B")), - x_fac3md = factor(rep(c("A", "B", "C"), 60), levels = c("A", "B", "C")) - ) - df_all$y <- rnorm(180, 0.1, 0.5) + 0.5 + 0.20 * df_all$x_cont1 + - ifelse(df_all$x_fac3md == "A", 0.15, ifelse(df_all$x_fac3md == "B", -0.15, 0)) + # Load pre-fitted marginal distribution models + fit0 <- readRDS(file.path(temp_fits_dir, "fit_marginal_0.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) + marglik0 <- readRDS(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS")) + marglik1 <- readRDS(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS")) + # Define prior lists (needed for manual mixing validation and prior_samples) prior_list_0 <- list( "intercept" = prior("normal", list(0, 1)), "x_cont1" = prior("normal", list(0, 1)), @@ -35,46 +42,6 @@ test_that("Marginal distribution prior and posterior functions work", { ) attr(prior_list_0$x_cont1, "multiply_by") <- "sigma" attr(prior_list_1$x_cont1, "multiply_by") <- "sigma" - model_syntax <- paste0( - "model{", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - log_posterior <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - model_formula <- list(mu = ~ x_cont1 + x_fac2t + x_cont1*x_fac3md) - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list, - formula_list = model_formula, - formula_prior_list = list(mu = prior_list_0), - formula_data_list = list(mu = df_all)) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list, - formula_list = model_formula, - formula_prior_list = list(mu = prior_list_1), - formula_data_list = list(mu = df_all)) - marglik0 <- JAGS_bridgesampling( - fit = fit0, - log_posterior = log_posterior, - data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list, - formula_list = model_formula, - formula_prior_list = list(mu = prior_list_0), - formula_data_list = list(mu = df_all)) - marglik1 <- JAGS_bridgesampling( - fit = fit1, - log_posterior = log_posterior, - data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list, - formula_list = model_formula, - formula_prior_list = list(mu = prior_list_1), - formula_data_list = list(mu = df_all)) # make the mixing equal marglik1$logml <- marglik0$logml @@ -590,7 +557,7 @@ test_that("Marginal distribution prior and posterior functions work", { # simple factor BF.marg_post_x_fac2t <- suppressWarnings(Savage_Dickey_BF(marg_post_simple_x_fac2t)) - expect_equivalent(BF.marg_post_x_fac2t, list("A" = 1, "B" = 1.660692), tolerance = 1e-3) + expect_equivalent(BF.marg_post_x_fac2t, list("A" = 1, "B" = 0.1792675), tolerance = 1e-3) expect_equal(attr(BF.marg_post_x_fac2t[["A"]], "warnings"), c("There is a considerable cluster of posterior samples at the exact null hypothesis values. The Savage-Dickey density ratio is likely to be invalid.", "There is a considerable cluster of prior samples at the exact null hypothesis values. The Savage-Dickey density ratio is likely to be invalid.")) @@ -600,10 +567,10 @@ test_that("Marginal distribution prior and posterior functions work", { expect_equivalent(BF.marg_post_x_fac3md, list("A" = Inf, "B" = Inf, "C" = Inf)) BF2.marg_post_x_fac3md <- Savage_Dickey_BF(marg_post_x_fac3md, null_hypothesis = 0.5) - expect_equivalent(BF2.marg_post_x_fac3md, list("A" = 3.954431, "B" = 0.1405823, "C" = 0.1661251), tolerance = 1e-3) + expect_equivalent(BF2.marg_post_x_fac3md, list("A" = 4.498542, "B" = 0.1316045, "C" = 0.1651373), tolerance = 1e-3) BF2.marg_post_x_fac3md <- Savage_Dickey_BF(marg_post_x_fac3md, null_hypothesis = 0.5, normal_approximation = TRUE) - expect_equal(BF2.marg_post_x_fac3md, list("A" = 0.6342651, "B" = 0.1015235, "C" = 0.1267758), tolerance = 1e-3) + expect_equal(BF2.marg_post_x_fac3md, list("A" = 0.5917503, "B" = 0.09956232, "C" = 0.1266085), tolerance = 1e-3) ### marginal_inference ---- out <- marginal_inference( @@ -684,44 +651,11 @@ test_that("Marginal distribution prior and posterior functions work", { # the previous BFs were based on model-averaged posteriors so they won't match # test summary table - expect_equal( - capture_output_lines(marginal_estimates_table(out$conditional, out$inference, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_fac2t", "mu_x_fac3md", "mu_x_cont1__xXx__x_fac3md")), print = TRUE, width = 150), - c( " Mean Median 0.025 0.95 Inclusion BF" , - "(mu) intercept 0.616 0.616 0.518 0.691 Inf" , - "(mu) x_cont1[-1SD] 0.431 0.431 0.303 0.536 Inf" , - "(mu) x_cont1[0SD] 0.616 0.616 0.518 0.691 Inf" , - "(mu) x_cont1[1SD] 0.800 0.801 0.678 0.899 Inf" , - "(mu) x_fac2t[A] 0.613 0.614 0.503 0.700 Inf" , - "(mu) x_fac2t[B] 0.621 0.621 0.513 0.708 Inf" , - "(mu) x_fac3md[A] 0.770 0.772 0.618 0.893 Inf" , - "(mu) x_fac3md[B] 0.518 0.518 0.365 0.646 Inf" , - "(mu) x_fac3md[C] 0.550 0.551 0.405 0.674 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, A] 0.556 0.556 0.344 0.734 Inf" , - "(mu) x_cont1:x_fac3md[0SD, A] 0.770 0.772 0.618 0.893 Inf" , - "(mu) x_cont1:x_fac3md[1SD, A] 0.984 0.985 0.791 1.140 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, B] 0.372 0.372 0.159 0.556 10.816" , - "(mu) x_cont1:x_fac3md[0SD, B] 0.518 0.518 0.365 0.646 Inf" , - "(mu) x_cont1:x_fac3md[1SD, B] 0.665 0.664 0.464 0.830 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, C] 0.373 0.373 0.171 0.541 69.939" , - "(mu) x_cont1:x_fac3md[0SD, C] 0.550 0.551 0.405 0.674 Inf" , - "(mu) x_cont1:x_fac3md[1SD, C] 0.727 0.727 0.524 0.904 Inf" , - "\033[0;31mmu_intercept: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[-1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[0SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac2t[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac2t[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[-1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" - )) + test_reference_table( + marginal_estimates_table(out$conditional, out$inference, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_fac2t", "mu_x_fac3md", "mu_x_cont1__xXx__x_fac3md")), + "marginal_estimates_table_model_avg.txt", + info_msg = "marginal_estimates_table for model averaging" + ) # plots vdiffr::expect_doppelganger("plot_marginal-mu_x_fac2t-1", function(){plot_marginal(out$conditional, parameter = "mu_x_fac2t")}) @@ -822,17 +756,12 @@ test_that("Marginal distributions with spike and slab and mixture priors work", skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes skip_on_cran() + skip_if_not_installed("rjags") - ### complex formula including scaling ---- - set.seed(1) - df_all <- data.frame( - x_cont1 = rnorm(180), - x_fac2t = factor(rep(c("A", "B"), 90), levels = c("A", "B")), - x_fac3md = factor(rep(c("A", "B", "C"), 60), levels = c("A", "B", "C")) - ) - df_all$y <- rnorm(180, 0.1, 0.5) + 0.5 + 0.20 * df_all$x_cont1 + - ifelse(df_all$x_fac3md == "A", 0.15, ifelse(df_all$x_fac3md == "B", -0.15, 0)) + # Load pre-fitted spike-and-slab model + fit <- readRDS(file.path(temp_fits_dir, "fit_marginal_ss.RDS")) + # Define prior lists (needed for prior_samples validation in marginal_posterior) prior_pars <- list( "intercept" = prior("normal", list(0, 1)), "x_cont1" = prior_mixture(list( @@ -847,22 +776,6 @@ test_that("Marginal distributions with spike and slab and mixture priors work", "sigma" = prior("cauchy", list(0, 1), list(0, 5)) ) attr(prior_pars$x_cont1, "multiply_by") <- "sigma" - model_syntax <- paste0( - "model{", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - model_formula <- list(mu = ~ x_cont1 + x_fac2t + x_cont1*x_fac3md) - - fit <- JAGS_fit( - model_syntax = model_syntax, data = list(y = df_all$y, N = nrow(df_all)), - prior_list = prior_list, - formula_list = model_formula, - formula_prior_list = list(mu = prior_pars), - formula_data_list = list(mu = df_all)) mixed_posteriors <- as_mixed_posteriors( model = fit, @@ -1280,45 +1193,11 @@ test_that("Marginal distributions with spike and slab and mixture priors work", # the previous BFs were based on model-averaged posteriors so they won't match # test summary table (note that these differ from the first set of tests because of the different model settings) - expect_equal( - capture_output_lines(marginal_estimates_table(out$conditional, out$inference, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_fac2t", "mu_x_fac3md", "mu_x_cont1__xXx__x_fac3md")), print = TRUE, width = 150), - c(" Mean Median 0.025 0.95 Inclusion BF" , - "(mu) intercept 0.617 0.617 0.542 0.681 Inf" , - "(mu) x_cont1[-1SD] 0.435 0.434 0.320 0.531 Inf" , - "(mu) x_cont1[0SD] 0.617 0.617 0.542 0.681 Inf" , - "(mu) x_cont1[1SD] 0.800 0.799 0.691 0.890 Inf" , - "(mu) x_fac2t[A] 0.617 0.617 0.542 0.681 Inf" , - "(mu) x_fac2t[B] 0.618 0.617 0.542 0.682 Inf" , - "(mu) x_fac3md[A] 0.778 0.778 0.651 0.886 Inf" , - "(mu) x_fac3md[B] 0.518 0.518 0.390 0.625 Inf" , - "(mu) x_fac3md[C] 0.554 0.554 0.427 0.662 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, A] 0.590 0.592 0.407 0.729 Inf" , - "(mu) x_cont1:x_fac3md[0SD, A] 0.774 0.776 0.623 0.884 Inf" , - "(mu) x_cont1:x_fac3md[1SD, A] 0.958 0.959 0.802 1.084 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, B] 0.342 0.341 0.182 0.483 158.472" , - "(mu) x_cont1:x_fac3md[0SD, B] 0.521 0.520 0.392 0.631 Inf" , - "(mu) x_cont1:x_fac3md[1SD, B] 0.700 0.699 0.549 0.827 Inf" , - "(mu) x_cont1:x_fac3md[-1SD, C] 0.375 0.374 0.226 0.501 Inf" , - "(mu) x_cont1:x_fac3md[0SD, C] 0.556 0.556 0.428 0.663 Inf" , - "(mu) x_cont1:x_fac3md[1SD, C] 0.737 0.738 0.579 0.871 Inf" , - "\033[0;31mmu_intercept: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[-1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[0SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1[1SD]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac2t[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac2t[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_fac3md[C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[-1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, A]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, B]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[-1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m", - "\033[0;31mmu_x_cont1__xXx__x_fac3md[0SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" , - "\033[0;31mmu_x_cont1__xXx__x_fac3md[1SD, C]: Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.\033[0m" - )) + test_reference_table( + marginal_estimates_table(out$conditional, out$inference, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_fac2t", "mu_x_fac3md", "mu_x_cont1__xXx__x_fac3md")), + "marginal_estimates_table_spike_slab.txt", + info_msg = "marginal_estimates_table for spike-and-slab" + ) # plots vdiffr::expect_doppelganger("plot_marginal-ss-mu_x_fac2t-1", function(){plot_marginal(out$conditional, parameter = "mu_x_fac2t")}) diff --git a/tests/testthat/test-JAGS-marglik.R b/tests/testthat/test-JAGS-marglik.R index f47c0b0..fe57335 100644 --- a/tests/testthat/test-JAGS-marglik.R +++ b/tests/testthat/test-JAGS-marglik.R @@ -1,5 +1,10 @@ context("JAGS marginal likelihood functions") +# This file tests the JAGS marginal likelihood computation functions +# It uses simple models where the log marginal likelihood is known to be 0 +# (for prior samples, the marginal likelihood for any proper prior is 1, log(1) = 0) +# More complex consistency tests (e.g., including formulas etc part of `test-00-model-fits.R`) + test_that("JAGS model functions work (simple)", { skip_if_not_installed("rjags") @@ -209,361 +214,6 @@ test_that("JAGS model functions work (spikes)", { }) -test_that("JAGS model functions work (complex scenario)", { - - skip_if_not_installed("rjags") - # tests different model estimation techniques and passing additional arguments - set.seed(1) - data <- list( - x = rnorm(50, 0, .5), - N = 50 - ) - priors1 <- list( - m = prior("normal", list(0, 1)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - priors2 <- list( - m = prior("normal", list(0, 1)), - s = prior("spike", list(1)) - ) - log_posterior <- function(parameters, data, return3){ - if(return3){ - return(3) - }else{ - return(sum(stats::dnorm(data$x, mean = parameters[["m"]], sd = parameters[["s"]], log = TRUE))) - } - } - model_syntax <- - "model{ - for(i in 1:N){ - x[i] ~ dnorm(m, pow(s, -2)) - } - }" - - - - model1 <- rjags::jags.model( - file = textConnection(JAGS_add_priors(model_syntax, priors1)), - inits = JAGS_get_inits(priors1, chains = 2, seed = 1), - n.chains = 2, - data = data, - quiet = TRUE) - samples1 <- rjags::jags.samples( - model = model1, - variable.names = JAGS_to_monitor(priors1), - data = data, - n.iter = 5000, - quiet = TRUE, - progress.bar = "none") - marglik1 <- JAGS_bridgesampling( - samples1, - prior_list = priors1, - data = data, - log_posterior = log_posterior, - return3 = FALSE) - - runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) - fit2 <- runjags::run.jags( - model = JAGS_add_priors(model_syntax, priors2), - data = data, - inits = JAGS_get_inits(priors2, chains = 2, seed = 1), - monitor = JAGS_to_monitor(priors2), - n.chains = 2, - sample = 5000, - burnin = 1000, - adapt = 500, - summarise = FALSE - ) - marglik2 <- JAGS_bridgesampling( - fit2, - data = data, - prior_list = priors2, - log_posterior = log_posterior, - return3 = FALSE) - - marglik3 <- JAGS_bridgesampling( - fit2, - data = data, - prior_list = priors2, - log_posterior = log_posterior, - return3 = TRUE) - - - expect_equal(marglik1$logml, -31.944, tolerance = 1e-2) - expect_equal(marglik2$logml, -52.148, tolerance = 1e-2) - expect_equal(marglik3$logml, 1.489, tolerance = 1e-2) -}) - -test_that("JAGS model functions work (formula)",{ - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(300), - x_fac2t = factor(rep(c("A", "B"), 150), levels = c("A", "B")), - x_fac3t = factor(rep(c("A", "B", "C"), 100), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(300, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), ifelse(data_formula$x_fac2t == "A", 0.5, 1)), - N = 300 - ) - - # create an empty model ---- - formula_list0 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list0 <- list( - mu = data_formula - ) - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - prior_list0 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax0 <- "model{}" - - fit0 <- JAGS_fit( - model_syntax = model_syntax0, data = list(), prior_list = prior_list0, - formula_list = formula_list0, formula_data_list = formula_data_list0, formula_prior_list = formula_prior_list0) - - log_posterior0 <- function(parameters, data){ - return(0) - } - - marglik0 <- JAGS_bridgesampling( - fit = fit0, - log_posterior = log_posterior0, - data = list(), - prior_list = prior_list0, - formula_list = formula_list0, - formula_data_list = formula_data_list0, - formula_prior_list = formula_prior_list0 - ) - - expect_equal(marglik0$logml, 0, tolerance = 1e-3) - - - # create model with mix of a formula and free parameters ---- - formula_list1 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_data_list1 <- list( - mu = data_formula - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - prior_list1 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax1 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit1 <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1) - - log_posterior1 <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - - marglik1 <- JAGS_bridgesampling( - fit = fit1, - log_posterior = log_posterior1, - data = data, - prior_list = prior_list1, - formula_list = formula_list1, - formula_data_list = formula_data_list1, - formula_prior_list = formula_prior_list1) - - # more of a consistency test - expect_equal(marglik1$logml, -370.87, tolerance = 1e-2) - - - # create model with mix of a formula and free scaled parameters ---- - prior_list1s <- prior_list1 - prior_list1s$scale3 <- prior("point", parameters = list(location = 1/3)) - formula_prior_list1s <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1/2)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1*3)) - ) - ) - attr(formula_prior_list1s$mu$x_cont1, "multiply_by") <- 2 - attr(formula_prior_list1s$mu$x_fac3t, "multiply_by") <- "scale3" - - fit1s <- JAGS_fit( - model_syntax = model_syntax1, data = data, prior_list = prior_list1s, - formula_list = formula_list1, formula_data_list = formula_data_list1, formula_prior_list = formula_prior_list1s) - - log_posterior1s <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - - marglik1s <- JAGS_bridgesampling( - fit = fit1s, - log_posterior = log_posterior1s, - data = data, - prior_list = prior_list1s, - formula_list = formula_list1, - formula_data_list = formula_data_list1, - formula_prior_list = formula_prior_list1s) - - # more of a consistency test - expect_equal(marglik1$logml, marglik1s$logml, tolerance = 1e-2) - - - # create model with two formulas ---- - formula_list2 <- list( - mu = ~ x_cont1 + x_fac3t, - sigma = ~ x_fac2t - ) - - formula_data_list2 <- list( - mu = data_formula, - sigma = data_formula - ) - - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ), - sigma = list( - "intercept" = prior("normal", list(0, 1)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - model_syntax2 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(exp(sigma[i]), 2))\n", - "}\n", - "}" - ) - - fit2 <- JAGS_fit( - model_syntax = model_syntax2, data = data, prior_list = NULL, - formula_list = formula_list2, formula_data_list = formula_data_list2, formula_prior_list = formula_prior_list2) - - log_posterior2 <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = exp(parameters[["sigma"]]), log = TRUE))) - } - - marglik2 <- JAGS_bridgesampling( - fit = fit2, - log_posterior = log_posterior2, - data = data, - prior_list = NULL, - formula_list = formula_list2, - formula_data_list = formula_data_list2, - formula_prior_list = formula_prior_list2) - - # more of a consistency test - expect_equal(marglik2$logml, -351.43, tolerance = 1e-2) - - # create a model with spike factor priors ---- - formula_list3 <- list( - mu = ~ x_cont1 + x_fac3t - ) - formula_list3c <- list( - mu = ~ x_cont1 - ) - formula_data_list3 <- list( - mu = data_formula - ) - formula_prior_list3a <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("spike", contrast = "treatment", list(0)) - ) - ) - formula_prior_list3b <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("spike", contrast = "meandif", list(0)) - ) - ) - formula_prior_list3c <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)) - ) - ) - prior_list3 <- list( - sigma = prior("lognormal", list(0, 1)) - ) - model_syntax3 <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - fit3a <- JAGS_fit( - model_syntax = model_syntax3, data = data, prior_list = prior_list3, - formula_list = formula_list3, formula_data_list = formula_data_list3, formula_prior_list = formula_prior_list3a) - fit3b <- JAGS_fit( - model_syntax = model_syntax3, data = data, prior_list = prior_list3, - formula_list = formula_list3, formula_data_list = formula_data_list3, formula_prior_list = formula_prior_list3b) - fit3c <- JAGS_fit( - model_syntax = model_syntax3, data = data, prior_list = prior_list3, - formula_list = formula_list3c, formula_data_list = formula_data_list3, formula_prior_list = formula_prior_list3c) - - log_posterior3 <- function(parameters, data){ - return(sum(stats::dnorm(data$y, mean = parameters[["mu"]], sd = parameters[["sigma"]], log = TRUE))) - } - - marglik3a <- JAGS_bridgesampling( - fit = fit3a, - log_posterior = log_posterior3, - data = data, - prior_list = prior_list3, - formula_list = formula_list3, - formula_data_list = formula_data_list3, - formula_prior_list = formula_prior_list3a) - marglik3b <- JAGS_bridgesampling( - fit = fit3b, - log_posterior = log_posterior3, - data = data, - prior_list = prior_list3, - formula_list = formula_list3, - formula_data_list = formula_data_list3, - formula_prior_list = formula_prior_list3b) - marglik3c <- JAGS_bridgesampling( - fit = fit3c, - log_posterior = log_posterior3, - data = data, - prior_list = prior_list3, - formula_list = formula_list3c, - formula_data_list = formula_data_list3, - formula_prior_list = formula_prior_list3c) - - # more of a consistency test - expect_equal(marglik3a$logml, marglik3c$logml, tolerance = 1e-2) - expect_equal(marglik3b$logml, marglik3c$logml, tolerance = 1e-2) - -}) - test_that("bridge sampling object function works",{ marglik0 <- bridgesampling_object() diff --git a/tests/testthat/test-JAGS-model-averaging.R b/tests/testthat/test-JAGS-model-averaging.R deleted file mode 100644 index 65f3443..0000000 --- a/tests/testthat/test-JAGS-model-averaging.R +++ /dev/null @@ -1,498 +0,0 @@ -context("JAGS model-averaging functions") - -test_that("JAGS model-averaging functions work (simple)",{ - - set.seed(1) - data <- list( - x = rnorm(20, 0, 1), - N = 20 - ) - priors_list0 <- list( - m = prior("spike", list(0)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - priors_list1 <- list( - m = prior("normal", list(0, .3)), - s = prior("normal", list(0, 1), list(0, Inf)) - ) - model_syntax <- - "model - { - for(i in 1:N){ - x[i] ~ dnorm(m, pow(s, -2)) - } - }" - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$x, parameters[["m"]], parameters[["s"]], log = TRUE)) - } - # fit the models - fit0 <- JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 0) - fit1 <- JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - # get marginal likelihoods - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) - - # make parameter inference - inference_m <- compute_inference(c(1, 1), c(marglik0$logml, marglik1$logml), c(T, F)) - inference_m_conditional <- compute_inference(c(1, 1), c(marglik0$logml, marglik1$logml), c(T, F), conditional = T) - - # manually mix posteriors - mixed_posterior <- BayesTools:::.mix_posteriors.simple(list(fit0, fit1), list(priors_list0[["m"]], priors_list1[["m"]]), "m", inference_m$post_prob) - mixed_posterior_conditional <- BayesTools:::.mix_posteriors.simple(list(fit0, fit1), list(priors_list0[["m"]], priors_list1[["m"]]), "m", inference_m_conditional$post_prob) - - expect_equal(mean(mixed_posterior == 0), inference_m$post_probs[1], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posterior, "models_ind") == 1), inference_m$post_probs[1], tolerance = 1e-4) - - vdiffr::expect_doppelganger("JAGS-model-averaging-1", function(){ - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) - par(mfrow = c(1, 2)) - hist(mixed_posterior, main = "model-averaged") - hist(mixed_posterior_conditional, main = "conditional") - }) - - # automatically mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - inference <- ensemble_inference(model_list = models, parameters = c("m", "s"), is_null_list = list("m" = 1, "s" = 0), conditional = FALSE) - inference_conditional <- ensemble_inference(model_list = models, parameters = c("m", "s"), is_null_list = list("m" = 1, "s" = 0), conditional = TRUE) - - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "s"), is_null_list = list("m" = 1, "s" = 0), seed = 1) - mixed_posteriors_conditional <- mix_posteriors(model_list = models, parameters = c("m", "s"), is_null_list = list("m" = 1, "s" = 0), conditional = TRUE) - - inference_s <- compute_inference(c(1, 1), c(marglik0$logml, marglik1$logml), c(F, F)) - inference_s_conditional <- compute_inference(c(1, 1), c(marglik0$logml, marglik1$logml), c(F, F), conditional = T) - - expect_equal(inference$m[c("prior_probs", "post_probs", "BF")], inference_m[c("prior_probs", "post_probs", "BF")]) - expect_equal(inference_conditional$m[c("prior_probs", "post_probs", "BF")], inference_m_conditional[c("prior_probs", "post_probs", "BF")]) - expect_equal(inference$s[c("prior_probs", "post_probs", "BF")], inference_s[c("prior_probs", "post_probs", "BF")]) - expect_equal(inference_conditional$s[c("prior_probs", "post_probs", "BF")], inference_s_conditional[c("prior_probs", "post_probs", "BF")]) - expect_equal(mean(mixed_posteriors$m == 0), inference_m$post_probs[1], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posteriors$m, "models_ind") == 1), inference_m$post_probs[1], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posteriors$s, "models_ind") == 1), inference_m$post_probs[1], tolerance = 1e-4) - expect_true(all(attr(mixed_posteriors_conditional$m, "models_ind") == 2)) - expect_equal(mean(attr(mixed_posteriors_conditional$s, "models_ind") == 1), inference_m$post_probs[1], tolerance = 1e-4) - vdiffr::expect_doppelganger("JAGS-model-averaging-2", function(){ - par(mfrow = c(2, 2)) - hist(mixed_posteriors$m, main = "model-averaged (m)") - hist(mixed_posteriors_conditional$m, main = "conditional (m)") - hist(mixed_posteriors$s, main = "model-averaged (s)") - hist(mixed_posteriors_conditional$s, main = "conditional = conditional (s)") - }) - - # dealing with missing unspecified null priors - models2 <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - mixed_posteriors2 <- mix_posteriors(model_list = models2, parameters = c("m", "s"), is_null_list = list("m" = 1, "s" = 0), seed = 1) - expect_equal(mixed_posteriors, mixed_posteriors2) -}) - -# skip the rest as it takes too long -skip_on_cran() - -test_that("JAGS model-averaging functions work (weightfunctions)",{ - - set.seed(1) - data <- list( - x = rnorm(20, 0, 1), - N = 20 - ) - priors_list0 <- list( - m =prior("normal", list(0, 1)), - omega = prior_none() - ) - priors_list1 <- list( - m = prior("normal", list(0, .5)), - omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - ) - priors_list2 <- list( - m = prior("normal", list(0, .3)), - omega = prior_weightfunction("one.sided", list(c(0.05, 0.50), c(1, 1, 1))) - ) - model_syntax <- - "model - { - for(i in 1:N){ - x[i] ~ dnorm(m, 1) - } - }" - log_posterior <- function(parameters, data){ - return(0) - } - # fit the models - fit0 <- JAGS_fit(model_syntax, data, priors_list0, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 0) - fit1 <- JAGS_fit(model_syntax, data, priors_list1, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - fit2 <- JAGS_fit(model_syntax, data, priors_list2, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - # get marginal likelihoods - marglik0 <- JAGS_bridgesampling(fit0, log_posterior = log_posterior, data = data, prior_list = priors_list0) - marglik1 <- JAGS_bridgesampling(fit1, log_posterior = log_posterior, data = data, prior_list = priors_list1) - marglik2 <- JAGS_bridgesampling(fit2, log_posterior = log_posterior, data = data, prior_list = priors_list2) - - # check coefficient mapping - expect_equal(weightfunctions_mapping(list(priors_list0$omega, priors_list1$omega, priors_list2$omega)), list(NULL, c(2, 1, 1), c(3, 2, 1))) - expect_equal(weightfunctions_mapping(list( - prior_weightfunction("two.sided", list(c(0.05), c(1, 1))), - prior_weightfunction("one.sided", list(c(0.05, 0.50), c(1, 1, 1))) - )), list( - c(2, 1, 1, 1, 2), - c(3, 3, 2, 1, 1)) - ) - expect_equal(weightfunctions_mapping(list( - prior_weightfunction("two.sided", list(c(0.05), c(1, 1))), - prior_weightfunction("one.sided", list(c(0.05, 0.50, .975), c(1, 1, 1), c(1, 1))) - )), list( - c(2, 1, 1, 1, 2), - c(4, 4, 3, 2, 1)) - ) - - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1), - list(fit = fit2, marglik = marglik2, prior_weights = 1) - ) - - # get models inference & mix posteriors - models <- models_inference(models) - inference <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), conditional = FALSE) - inference_conditional <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), conditional = TRUE) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1) - mixed_posteriors_conditional <-mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1, conditional = TRUE) - - # checking posteriors and inferences - expect_equal(names(models[[1]]$inference), c("m_number", "marglik", "prior_prob", "post_prob", "inclusion_BF")) - expect_equal(unname(unlist(models[[1]]$inference)), c(1.0000000, -1.1023042, 0.3333333, 0.1998118, 0.4994120), tolerance = 1e-4) - expect_equal(mean(mixed_posteriors$omega[,-1] == 1), inference$omega$post_probs[1], tolerance = 1e-4) - expect_true(all(mixed_posteriors$omega[1,] == 1)) - expect_true(all(colnames(mixed_posteriors$omega[1,]) == c("omega[0,0.05]", "omega[0.05,0.5]", "omega[0.5,1]"))) - expect_equal(mean(attr(mixed_posteriors$omega, "models_ind") == 2), inference$omega$post_probs[2], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posteriors$omega, "models_ind") == 3), inference$omega$post_probs[3], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posteriors_conditional$omega, "models_ind") == 2), inference_conditional$omega$post_probs[2], tolerance = 1e-4) - expect_equal(mean(attr(mixed_posteriors_conditional$omega, "models_ind") == 3), inference_conditional$omega$post_probs[3], tolerance = 1e-4) - vdiffr::expect_doppelganger("JAGS-model-averaging-weightfunctions-1", function(){ - par(mfrow = c(2, 3)) - sapply(1:3, function(i)hist(mixed_posteriors$omega[,i], main = "model-averaged (omega)", xlab = colnames(mixed_posteriors$omega)[i])) - sapply(1:3, function(i)hist(mixed_posteriors_conditional$omega[,i], main = "conditional (omega)", xlab = colnames(mixed_posteriors$omega)[i])) - }) - - - ### checking fixed weightfunctions - priors_list3 <- list( - m = prior("normal", list(0, .3)), - omega = prior_weightfunction("two.sided.fixed", list(0.20, c(.3, 1))) - ) - fit3 <- JAGS_fit(model_syntax, data, priors_list3, chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1) - marglik3 <- JAGS_bridgesampling(fit3, log_posterior = log_posterior, data = data, prior_list = priors_list3) - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1), - list(fit = fit2, marglik = marglik2, prior_weights = 1), - list(fit = fit3, marglik = marglik3, prior_weights = 1) - ) - - inference <- ensemble_inference(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), conditional = FALSE) - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1) - mixed_posteriors_conditional <- mix_posteriors(model_list = models, parameters = c("m", "omega"), is_null_list = list("m" = 0, "omega" = 1), seed = 1, conditional = TRUE) - - expect_equal(mean(mixed_posteriors$omega[,1] == .3), inference$omega$post_probs[4], tolerance = 1e-4) - expect_equal(mean(mixed_posteriors$omega[,3] == 1), inference$omega$post_probs[4] + inference$omega$post_probs[1], tolerance = 1e-4) - vdiffr::expect_doppelganger("JAGS-model-averaging-weightfunctions-2", function(){ - par(mfrow = c(2, 5)) - sapply(1:5, function(i)hist(mixed_posteriors$omega[,i], main = "model-averaged (omega)", xlab = colnames(mixed_posteriors$omega)[i])) - sapply(1:5, function(i)hist(mixed_posteriors_conditional$omega[,i], main = "conditional (omega)", xlab = colnames(mixed_posteriors$omega)[i])) - }) -}) - -test_that("JAGS model-averaging functions work (formula + factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_cont1 = rnorm(60), - x_fac2t = factor(rep(c("A", "B"), 30), levels = c("A", "B")), - x_fac3o = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), - x_fac3t = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(60, .4 * data_formula$x_cont1 + ifelse(data_formula$x_fac3t == "A", 0.0, ifelse(data_formula$x_fac3t == "B", -0.2, 0.4)), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0 <- list(mu = ~ x_fac2t) - formula_list1 <- list(mu = ~ x_cont1 + x_fac3t) - formula_list2 <- list(mu = ~ x_fac3o) - formula_list3 <- list(mu = ~ x_cont1 * x_fac3o) - - formula_prior_list0 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac2t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3t" = prior_factor("normal", contrast = "treatment", list(0, 1)) - ) - ) - formula_prior_list2 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - formula_prior_list3 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_cont1" = prior("normal", list(0, 1)), - "x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)), - "x_cont1:x_fac3o" = prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0, seed = 1) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 2) - fit2 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2, seed = 3) - fit3 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3, seed = 4) - - marglik0 <- JAGS_bridgesampling( - fit0, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - marglik2 <- JAGS_bridgesampling( - fit2, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list2, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list2) - marglik3 <- JAGS_bridgesampling( - fit3, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list3, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list3) - - - # mix posteriors - models <- list( - list(fit = fit0, marglik = marglik0, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1), - list(fit = fit2, marglik = marglik2, prior_weights = 1), - list(fit = fit3, marglik = marglik3, prior_weights = 1) - ) - - - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1:x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1:x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - mixed_posteriors_c <- mix_posteriors( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3t", "mu_x_fac3o", "mu_x_cont1__xXx__x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(TRUE, FALSE, TRUE, FALSE), - "mu_x_fac2t" = c(FALSE, TRUE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE, TRUE), - "mu_x_fac2t" = c(TRUE, TRUE, FALSE, FALSE), - "mu_x_cont1:x_fac3o" = c(TRUE, TRUE, TRUE, FALSE) - ), - seed = 1, n_samples = 10000, conditional = TRUE) - - - expect_true(is.numeric(inference$mu_x_cont1$BF)) - expect_true(is.numeric(inference$mu_x_fac2t$BF)) - expect_true(is.numeric(inference$mu_x_fac3t$BF)) - expect_true(is.numeric(inference$mu_x_fac3o$BF)) - expect_true(is.numeric(inference$mu_x_cont1__xXx__x_fac3o$BF)) - - expect_equal(length(mixed_posteriors$mu_x_cont1), 10000) - expect_equal(length(mixed_posteriors$mu_x_fac2t), 10000) - expect_equal(dim(mixed_posteriors$mu_x_fac3t), c(10000, 2)) - expect_equal(dim(mixed_posteriors$mu_x_fac3o), c(10000, 2)) - expect_equal(dim(mixed_posteriors$mu_x_cont1__xXx__x_fac3o), c(10000, 2)) - - vdiffr::expect_doppelganger("JAGS-model-averaging-3", function(){ - par(mfrow = c(2, 3)) - hist(mixed_posteriors$mu_x_fac2t, main = "averaged x_fac2t") - hist(mixed_posteriors_c$mu_x_fac2t, main = "conditiona x_fac2t") - hist(mixed_posteriors_c$mu_x_fac3t[,1], main = "conditional mu_x_fac3t[1]") - hist(mixed_posteriors_c$mu_x_fac3t[,2], main = "conditional mu_x_fac3t[2]") - hist(mixed_posteriors_c$mu_x_cont1__xXx__x_fac3o[,1], main = "conditional mu_x_cont1__xXx__x_fac3o[1]") - hist(mixed_posteriors_c$mu_x_cont1__xXx__x_fac3o[,2], main = "conditional mu_x_cont1__xXx__x_fac3o[2]") - }) - -}) - -test_that("JAGS model-averaging functions work (formula + spike factors)",{ - - skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - - set.seed(1) - - data_formula <- data.frame( - x_fac3md = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) - ) - data <- list( - y = rnorm(60, ifelse(data_formula$x_fac3md == "A", 0.0, ifelse(data_formula$x_fac3md == "B", -0.2, 0.4)), 1), - N = 60 - ) - - # create model with mix of a formula and free parameters --- - formula_list0a <- list(mu = ~ 1) - formula_list0b <- list(mu = ~ x_fac3md) - formula_list1 <- list(mu = ~ x_fac3md) - - - formula_prior_list0a <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)) - ) - ) - formula_prior_list0b <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("spike", contrast = "meandif", list(0)) - ) - ) - formula_prior_list1 <- list( - mu = list( - "intercept" = prior("normal", list(0, 5)), - "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 0.25)) - ) - ) - - prior_list <- list(sigma = prior("lognormal", list(0, 1))) - formula_data_list <- list(mu = data_formula) - - model_syntax <- paste0( - "model{\n", - "for(i in 1:N){\n", - " y[i] ~ dnorm(mu[i], 1/pow(sigma, 2))\n", - "}\n", - "}" - ) - - log_posterior <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - - fit0a <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0a, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0a, seed = 1) - fit0b <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list0b, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0b, seed = 2) - fit1 <- JAGS_fit( - model_syntax = model_syntax, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1, seed = 3) - - - marglik0a <- JAGS_bridgesampling( - fit0a, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0a, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0a) - marglik0b <- JAGS_bridgesampling( - fit0b, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list0b, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list0b) - marglik1 <- JAGS_bridgesampling( - fit1, log_posterior = log_posterior, data = data, prior_list = prior_list, - formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) - - - # mix posteriors - modelsA <- list( - list(fit = fit0a, marglik = marglik0a, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - modelsB <- list( - list(fit = fit0b, marglik = marglik0b, prior_weights = 1), - list(fit = fit1, marglik = marglik1, prior_weights = 1) - ) - - - inferenceA <- ensemble_inference( - model_list = modelsA, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - conditional = FALSE) - inferenceB <- ensemble_inference( - model_list = modelsB, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - conditional = FALSE) - - mixed_posteriorsA <- mix_posteriors( - model_list = modelsA, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - mixed_posteriorsB <- mix_posteriors( - model_list = modelsB, - parameters = c("mu_x_fac3md"), - is_null_list = list( - "mu_x_fac3md" = c(TRUE, FALSE) - ), - seed = 1, n_samples = 10000) - - - expect_equivalent(inferenceA, inferenceB, tolerance = 1e-2) - - common_attributes <- names(attributes(mixed_posteriorsB$mu_x_fac3md)) - common_attributes <- common_attributes[!common_attributes %in% c("sample_ind", "models_ind", "prior_list")] - - expect_equal(attributes(mixed_posteriorsA$mu_x_fac3md)[common_attributes], attributes(mixed_posteriorsB$mu_x_fac3md)[common_attributes]) - -}) diff --git a/tests/testthat/test-posterior-extraction.R b/tests/testthat/test-JAGS-posterior-extraction.R similarity index 100% rename from tests/testthat/test-posterior-extraction.R rename to tests/testthat/test-JAGS-posterior-extraction.R diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index f4476a9..0c6ab55 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -1,6 +1,6 @@ -context("Summary tables functions") +context("JAGS summary tables functions") -REFERENCE_DIR <- testthat::test_path("..", "results", "JAGS-summary-tables") +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-summary-tables") source(testthat::test_path("common-functions.R")) # ============================================================================ # diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R deleted file mode 100644 index 3a272ca..0000000 --- a/tests/testthat/test-model-averaging.R +++ /dev/null @@ -1,218 +0,0 @@ -context("Model-averaging functions") - -# ============================================================================== -# SECTION 1: BASIC MODEL-AVERAGING FUNCTIONS (NO JAGS FITS) -# ============================================================================== -test_that("Model-averaging functions work", { - - expect_equal(compute_inference(c(1,1), c(1, 1))$prior_probs, c(0.5, 0.5)) - expect_equal(compute_inference(c(1,1), c(1, 1))$post_probs, c(0.5, 0.5)) - expect_equal(compute_inference(c(1,1), c(1, 1))$BF, Inf) - expect_equal(attr(compute_inference(c(1,1), c(1, 1)), "is_null"), c(FALSE, FALSE)) - - expect_equal(compute_inference(c(1,4), c(1, 1))$prior_probs, c(0.2, 0.8)) - expect_equal(compute_inference(c(1,1,3), c(1, 1, 1))$prior_probs, c(0.2, 0.2, 0.6)) - expect_equal(compute_inference(c(1,1,4), c(1, 1, 1), c(F, T, F), conditional = TRUE)$prior_probs, c(0.2, 0, 0.8)) - - expect_equal(compute_inference(c(1,4), c(1, 1))$post_probs, c(0.2, 0.8)) - expect_equal(compute_inference(c(1,1,3), c(1, 1, 1))$post_probs, c(0.2, 0.2, 0.6)) - expect_equal(compute_inference(c(1,1,4), c(1, 1, 1), c(F, T, F), conditional = TRUE)$post_probs, c(0.2, 0, 0.8)) - expect_equal(attr(compute_inference(c(1,1,4), c(1, 1, 1), c(2)), "is_null"), c(F, T, F)) - - # automatically tests inclusion_bf as well - expect_equal(compute_inference(c(1,1), c(1, 1), 1)$BF, 1) - expect_equal(compute_inference(c(1,1), c(1, 2), c(F, T))$BF, exp(1-2)) - expect_equal(compute_inference(c(1,1,1), c(1, 1, 1), c(F, T, F))$BF, 1) - expect_equal(compute_inference(c(1,1,1), c(1, 2, 1), c(F, T, F))$BF, exp(1-2)) - - # and check BF formatting - expect_equivalent(format_BF(c(0, 1, 2, Inf)), c(0, 1, 2, Inf)) - expect_equivalent(format_BF(c(0, 1, 2, Inf), BF01 = TRUE), 1/c(0, 1, 2, Inf)) - expect_equivalent(format_BF(c(0, 1, 2, Inf), logBF = TRUE), log(c(0, 1, 2, Inf))) - expect_equivalent(format_BF(c(0, 1, 2, Inf), BF01 = TRUE, logBF = TRUE), log(1/c(0, 1, 2, Inf))) - expect_equal(attr(format_BF(1), "name"), "BF") - expect_equal(attr(format_BF(1, logBF = TRUE), "name"), "log(BF)") - expect_equal(attr(format_BF(1, BF01 = TRUE, logBF = TRUE), "name"), "log(1/BF)") - - # additional BF checks - expect_equal(inclusion_BF(prior_probs = c(.5, .5), post_probs = c(.5, .5), is_null = c(T, F)), 1) - expect_equal(inclusion_BF(prior_probs = c(.5, .5), post_probs = c(.75, .25), is_null = c(T, F)), 1/3) - expect_equal(inclusion_BF(prior_probs = c(.25, .25, .25, .25), post_probs = c(.75, 0, .25, 0), is_null = c(T, T, F, F)), 1/3) - expect_equal(inclusion_BF(prior_probs = c(.25, .25, .25, .25), post_probs = c(.65, .10, .20, 0.05), is_null = c(T, T, F, F)), 1/3) - expect_equal(inclusion_BF(prior_probs = c(1, 0), post_probs = c(1, 0), is_null = c(T, F)), 0) - expect_equal(inclusion_BF(prior_probs = c(1, 0), post_probs = c(1, 0), is_null = c(F, T)), Inf) - - # test the marglik versions of BF - temp_prior_probs <- 1:6/sum(1:6) - temp_margliks <- -2:3 - temp_post_probs <- bridgesampling::post_prob(temp_margliks, prior_prob = temp_prior_probs) - expect_equal( - inclusion_BF(prior_probs = temp_prior_probs, post_probs = temp_post_probs, is_null = rep(c(T, F), 3)), - inclusion_BF(prior_probs = temp_prior_probs, margliks = temp_margliks, is_null = rep(c(T, F), 3)) - ) - - # check for over/underflow - temp_prior_probs <- 1:6/sum(1:6) - temp_margliks <- c(-2:2, 100) - temp_post_probs <- bridgesampling::post_prob(temp_margliks, prior_prob = temp_prior_probs) - expect_true(is.infinite(inclusion_BF(prior_probs = temp_prior_probs, post_probs = temp_post_probs, is_null = rep(c(T, F), 3)))) - expect_false(is.infinite(inclusion_BF(prior_probs = temp_prior_probs, margliks = temp_margliks, is_null = rep(c(T, F), 3)))) - - # additional omega mapping checks - expect_equal(weightfunctions_mapping(prior_list = list( - prior_none(), - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/2), - prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.05, 0.10)), prior_weights = 1/2) - )), list(NULL, c(2, 1, 1), c(3, 2, 1))) -}) - - -# ============================================================================== -# SECTION 2: JAGS MODEL-AVERAGING WITH PREFITTED MODELS -# ============================================================================== -# Skip on CRAN as these tests use pre-fitted models -skip_on_cran() - -# Get the directory where prefitted models are stored -# First check environment variable, then fall back to standard temp directory -temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") -if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { - temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") -} -if (!dir.exists(temp_fits_dir)) { - skip("Pre-fitted models not available. Run test-00-model-fits.R first.") -} - -test_that("JAGS model-averaging with simple priors", { - - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") - - # Load pre-fitted models and their marginal likelihoods - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) - - fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) - - # Create model list - models <- list( - list(fit = fit_simple_spike, marglik = marglik_spike, prior_weights = 1), - list(fit = fit_simple_normal, marglik = marglik_normal, prior_weights = 1) - ) - - # Test ensemble inference - inference <- ensemble_inference(model_list = models, parameters = c("m", "s"), - is_null_list = list("m" = 1, "s" = 0), conditional = FALSE) - inference_conditional <- ensemble_inference(model_list = models, parameters = c("m", "s"), - is_null_list = list("m" = 1, "s" = 0), conditional = TRUE) - - # Test mix posteriors - mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("m", "s"), - is_null_list = list("m" = 1, "s" = 0), seed = 1) - mixed_posteriors_conditional <- mix_posteriors(model_list = models, parameters = c("m", "s"), - is_null_list = list("m" = 1, "s" = 0), conditional = TRUE, seed = 1) - - # Checks - expect_true(is.list(inference)) - expect_true(all(c("m", "s") %in% names(inference))) - expect_true(is.numeric(inference$m$BF)) - expect_true(is.numeric(inference$s$BF)) - expect_equal(length(mixed_posteriors$m), length(mixed_posteriors$s)) - expect_true(mean(mixed_posteriors$m == 0) > 0) # Some spike samples - - # Visual check - vdiffr::expect_doppelganger("model-averaging-simple-priors", function(){ - par(mfrow = c(2, 2)) - hist(mixed_posteriors$m, main = "model-averaged (m)") - hist(mixed_posteriors_conditional$m, main = "conditional (m)") - hist(mixed_posteriors$s, main = "model-averaged (s)") - hist(mixed_posteriors_conditional$s, main = "conditional (s)") - }) -}) - -test_that("JAGS model-averaging with weightfunction priors - coefficient mapping", { - - skip_if_not_installed("rjags") - - # Test coefficient mapping with weightfunctions (doesn't require actual model averaging) - priors_none <- prior_none() - priors_onesided2 <- prior_weightfunction("one.sided", list(c(.05), c(1, 1))) - priors_onesided3 <- prior_weightfunction("one.sided", list(c(.05, 0.10), c(1, 2, 3))) - priors_twosided <- prior_weightfunction("two.sided", list(c(.05), c(1, 1))) - - # Test coefficient mapping - expect_equal( - weightfunctions_mapping(list(priors_none, priors_onesided2, priors_onesided3)), - list(NULL, c(2, 1, 1), c(3, 2, 1)) - ) - - expect_equal( - weightfunctions_mapping(list(priors_twosided, priors_onesided3)), - list(c(2, 1, 1, 1, 2), c(3, 3, 2, 1, 1)) - ) -}) - -test_that("JAGS model-averaging with formula models", { - - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") - - # Load pre-fitted formula models with their marginal likelihoods - fit_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple.RDS")) - fit_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment.RDS")) - fit_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS")) - - marglik_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple_marglik.RDS")) - marglik_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment_marglik.RDS")) - marglik_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal_marglik.RDS")) - - # Create model list - models <- list( - list(fit = fit_formula_simple, marglik = marglik_simple, prior_weights = 1), - list(fit = fit_formula_treatment, marglik = marglik_treatment, prior_weights = 1), - list(fit = fit_formula_orthonormal, marglik = marglik_orthonormal, prior_weights = 1) - ) - - # Test ensemble inference - inference <- ensemble_inference( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(FALSE, FALSE, FALSE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE), - "mu_x_fac3o" = c(TRUE, TRUE, FALSE) - ), - conditional = FALSE) - - # Test mix posteriors - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o"), - is_null_list = list( - "mu_x_cont1" = c(FALSE, FALSE, FALSE), - "mu_x_fac2t" = c(TRUE, FALSE, TRUE), - "mu_x_fac3o" = c(TRUE, TRUE, FALSE) - ), - seed = 1, n_samples = 1000) - - # Checks - expect_true(is.list(inference)) - expect_true(all(c("mu_x_cont1", "mu_x_fac2t", "mu_x_fac3o") %in% names(inference))) - expect_true(is.numeric(inference$mu_x_cont1$BF)) - expect_true(is.numeric(inference$mu_x_fac2t$BF)) - expect_true(is.numeric(inference$mu_x_fac3o$BF)) - # Allow for small difference in sample size due to spike samples - expect_true(abs(length(mixed_posteriors$mu_x_cont1) - 1000) <= 1) - - # Visual check - vdiffr::expect_doppelganger("model-averaging-formulas", function(){ - par(mfrow = c(2, 2)) - hist(mixed_posteriors$mu_x_cont1, main = "mu_x_cont1") - hist(mixed_posteriors$mu_x_fac2t, main = "mu_x_fac2t") - if(is.matrix(mixed_posteriors$mu_x_fac3o)) { - hist(mixed_posteriors$mu_x_fac3o[,1], main = "mu_x_fac3o[1]") - hist(mixed_posteriors$mu_x_fac3o[,2], main = "mu_x_fac3o[2]") - } - }) -}) From c5ca9b4b48d6654056571bc634bb55ee113b442b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 10 Dec 2025 22:32:02 +0100 Subject: [PATCH 07/38] improve coverage --- .../JAGS_add_priors_factor.txt | 14 + .../JAGS_add_priors_point.txt | 4 + .../JAGS_add_priors_simple.txt | 5 + .../JAGS_add_priors_truncated.txt | 4 + .../JAGS_add_priors_weightfunction.txt | 9 + .../JAGS_to_monitor_factor.txt | 1 + .../JAGS_to_monitor_point.txt | 1 + .../JAGS_to_monitor_simple.txt | 1 + .../ensemble_diagnostics_basic.txt | 3 + .../ensemble_diagnostics_no_spike.txt | 3 + .../ensemble_diagnostics_short_name.txt | 3 + .../ensemble_estimates_basic.txt | 4 + .../ensemble_estimates_custom_probs.txt | 4 + .../ensemble_estimates_transform_factors.txt | 4 + .../ensemble_inference_BF01.txt | 3 + .../ensemble_inference_basic.txt | 3 + .../ensemble_inference_both.txt | 3 + .../ensemble_inference_logBF.txt | 3 + .../ensemble_summary_basic.txt | 3 + .../ensemble_summary_bf_options.txt | 3 + .../ensemble_summary_no_spike.txt | 3 + .../ensemble_summary_short_name.txt | 3 + .../marginal_estimates_BF01.txt | 2 + .../marginal_estimates_basic.txt | 2 + .../marginal_estimates_logBF.txt | 2 + .../model_summary_basic.txt | 6 + .../model_summary_no_spike.txt | 6 + .../model_summary_short_name.txt | 6 + .../runjags_estimates_conditional.txt | 4 + .../runjags_estimates_factor.txt | 3 + .../runjags_estimates_factor_transform.txt | 4 + .../runjags_estimates_param_m.txt | 2 + .../runjags_estimates_remove_inclusion.txt | 3 + .../runjags_estimates_simple.txt | 3 + .../runjags_estimates_spike_slab.txt | 4 + .../runjags_estimates_weightfunction.txt | 3 + .../JAGS-fit-edge-cases/update_table_BF01.txt | 3 + .../update_table_footnotes.txt | 4 + .../update_table_logBF.txt | 3 + .../update_table_new_title.txt | 4 + .../update_table_warnings.txt | 4 + .../model_summary_empty.txt | 6 + .../runjags_factor_conditional.txt | 3 + ...runjags_factor_conditional_transformed.txt | 4 + .../runjags_formula_inference.txt | 2 + .../runjags_formula_mixture_inference.txt | 2 + .../runjags_inference_empty.txt | 2 + .../runjags_joint_complex_inference.txt | 5 + .../runjags_mixture_conditional.txt | 3 + .../runjags_mixture_inference.txt | 2 + .../runjags_mixture_spike_inference.txt | 2 + .../runjags_pub_bias_conditional.txt | 3 + .../runjags_spike_slab_conditional.txt | 3 + .../stan_estimates_basic.txt | 8 + tests/results/interpret/interpret2_basic.txt | 1 + .../interpret/interpret2_conditional.txt | 1 + .../interpret/interpret2_evidence_against.txt | 1 + .../interpret/interpret2_inference_only.txt | 1 + .../results/interpret/interpret2_multiple.txt | 1 + .../interpret/interpret2_no_method.txt | 1 + .../interpret/interpret2_weak_evidence.txt | 1 + .../interpret_BF_moderate_against1.txt | 1 + .../interpret_BF_moderate_against2.txt | 1 + .../interpret/interpret_BF_moderate_favor.txt | 1 + .../interpret/interpret_BF_strong_against.txt | 1 + .../interpret/interpret_BF_strong_favor.txt | 1 + .../interpret/interpret_BF_weak_against.txt | 1 + .../interpret/interpret_BF_weak_favor.txt | 1 + .../interpret/interpret_par_conditional.txt | 1 + .../interpret_par_model_averaged.txt | 1 + .../interpret_par_model_averaged_null.txt | 1 + .../interpret/interpret_par_with_units.txt | 1 + .../as_mixed_posteriors_info.txt | 4 + .../ensemble_inference_conditional.txt | 2 + .../ensemble_inference_int_spec.txt | 4 + .../inclusion_BF_edge_cases.txt | 4 + .../mix_posteriors_conditional_info.txt | 3 + .../mix_posteriors_factor_info.txt | 3 + .../mix_posteriors_simple_info.txt | 4 + .../mix_posteriors_weightfunction_info.txt | 4 + .../models_inference_output.txt | 9 + .../weightfunctions_mapping_info.txt | 4 + .../ensemble_diagnostics_basic.txt | 3 + .../ensemble_diagnostics_no_spike.txt | 3 + .../ensemble_diagnostics_short_name.txt | 3 + .../ensemble_estimates_basic.txt | 4 + .../ensemble_estimates_custom_probs.txt | 4 + ...nsemble_estimates_formula_prefix_false.txt | 3 + ...ensemble_estimates_formula_prefix_true.txt | 3 + .../ensemble_estimates_transform_factors.txt | 4 + .../ensemble_inference_BF01.txt | 3 + .../ensemble_inference_basic.txt | 3 + .../ensemble_inference_both.txt | 3 + .../ensemble_inference_logBF.txt | 3 + .../ensemble_summary_basic.txt | 3 + .../ensemble_summary_bf_options.txt | 3 + .../ensemble_summary_no_spike.txt | 3 + .../ensemble_summary_params_list.txt | 3 + .../ensemble_summary_short_name.txt | 3 + .../marginal_estimates_BF01.txt | 2 + .../marginal_estimates_basic.txt | 2 + .../marginal_estimates_logBF.txt | 2 + .../model_summary_basic.txt | 6 + .../model_summary_no_spike.txt | 6 + .../model_summary_short_name.txt | 6 + .../update_table_BF01.txt | 3 + .../update_table_footnotes.txt | 4 + .../update_table_logBF.txt | 3 + .../update_table_new_title.txt | 4 + .../update_table_warnings.txt | 4 + .../summary-tables-helpers/add_column_end.txt | 3 + .../add_column_position1.txt | 3 + .../add_column_position2.txt | 3 + .../add_column_probability.txt | 3 + .../add_column_string.txt | 3 + .../ensemble_diagnostics_empty.txt | 2 + .../ensemble_estimates_empty.txt | 2 + .../ensemble_inference_empty.txt | 2 + .../ensemble_summary_empty.txt | 2 + .../remove_column_last.txt | 3 + .../remove_column_position2.txt | 3 + .../model-averaging-plot-prior-petpeese-1.svg | 28 +- ...model-averaging-plot-prior-petpeese-11.svg | 8 +- .../model-averaging-plot-prior-petpeese-2.svg | 40 +- .../model-averaging-plot-prior-petpeese-5.svg | 24 +- .../model-averaging-plot-prior-petpeese-7.svg | 26 +- .../model-averaging-plot-prior-petpeese-9.svg | 22 +- .../model-averaging-plot-prior-wf-1.svg | 4 +- .../model-averaging-plot-prior-wf-11.svg | 8 +- .../model-averaging-plot-prior-wf-2.svg | 4 +- .../model-averaging-plot-prior-wf-5.svg | 4 +- .../model-averaging-plot-prior-wf-7.svg | 8 +- .../model-averaging-plot-prior-wf-9.svg | 4 +- .../geom-prior-list-add.svg | 60 +++ .../lines-prior-list-add.svg | 55 +++ .../lines-prior-list-xlim.svg | 59 +++ .../plot-models-basic.svg | 73 +++ .../plot-models-ggplot.svg | 87 ++++ .../plot-posterior-ggplot.svg | 77 +++ .../plot-posterior-omega.svg | 55 +++ .../plot-posterior-simple.svg | 51 ++ .../plot-posterior-with-prior.svg | 54 +++ .../plot-posterior-xlim.svg | 53 +++ .../plot-prior-list-dual-axis-ggplot.svg | 97 ++++ .../plot-prior-list-dual-axis.svg | 73 +++ .../plot-prior-list-gamma.svg | 57 +++ .../plot-prior-list-meandif-base.svg | 57 +++ .../plot-prior-list-meandif-ggplot.svg | 81 ++++ .../plot-prior-list-multi.svg | 53 +++ .../plot-prior-list-orthonormal-base.svg | 59 +++ .../plot-prior-list-orthonormal-ggplot.svg | 85 ++++ .../plot-prior-list-single-normal.svg | 57 +++ .../plot-prior-list-weightfunction-ggplot.svg | 77 +++ .../plot-prior-list-weightfunction.svg | 55 +++ tests/testthat/common-functions.R | 9 + tests/testthat/test-JAGS-fit-edge-cases.R | 214 +++++++++ .../test-JAGS-marginal-distributions.R | 2 +- tests/testthat/test-JAGS-summary-tables.R | 125 +++++ tests/testthat/test-distributions-tools.R | 94 ++++ tests/testthat/test-interpret.R | 219 +++++++++ .../test-model-averaging-edge-cases.R | 385 +++++++++++++++ .../test-model-averaging-plots-edge-cases.R | 350 ++++++++++++++ tests/testthat/test-model-averaging.R | 174 +++++++ tests/testthat/test-priors-print.R | 90 ++++ tests/testthat/test-priors-tools.R | 303 ++++++++++++ .../testthat/test-summary-tables-edge-cases.R | 446 ++++++++++++++++++ tests/testthat/test-summary-tables-helpers.R | 233 +++++++++ tests/testthat/test-tools.R | 77 +++ 168 files changed, 4564 insertions(+), 93 deletions(-) create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt create mode 100644 tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt create mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt create mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt create mode 100644 tests/results/JAGS-fit-edge-cases/model_summary_basic.txt create mode 100644 tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt create mode 100644 tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt create mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt create mode 100644 tests/results/JAGS-fit-edge-cases/update_table_BF01.txt create mode 100644 tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt create mode 100644 tests/results/JAGS-fit-edge-cases/update_table_logBF.txt create mode 100644 tests/results/JAGS-fit-edge-cases/update_table_new_title.txt create mode 100644 tests/results/JAGS-fit-edge-cases/update_table_warnings.txt create mode 100644 tests/results/JAGS-summary-tables/model_summary_empty.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_factor_conditional.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_formula_inference.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_formula_mixture_inference.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_inference_empty.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_joint_complex_inference.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_mixture_inference.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_mixture_spike_inference.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt create mode 100644 tests/results/JAGS-summary-tables/stan_estimates_basic.txt create mode 100644 tests/results/interpret/interpret2_basic.txt create mode 100644 tests/results/interpret/interpret2_conditional.txt create mode 100644 tests/results/interpret/interpret2_evidence_against.txt create mode 100644 tests/results/interpret/interpret2_inference_only.txt create mode 100644 tests/results/interpret/interpret2_multiple.txt create mode 100644 tests/results/interpret/interpret2_no_method.txt create mode 100644 tests/results/interpret/interpret2_weak_evidence.txt create mode 100644 tests/results/interpret/interpret_BF_moderate_against1.txt create mode 100644 tests/results/interpret/interpret_BF_moderate_against2.txt create mode 100644 tests/results/interpret/interpret_BF_moderate_favor.txt create mode 100644 tests/results/interpret/interpret_BF_strong_against.txt create mode 100644 tests/results/interpret/interpret_BF_strong_favor.txt create mode 100644 tests/results/interpret/interpret_BF_weak_against.txt create mode 100644 tests/results/interpret/interpret_BF_weak_favor.txt create mode 100644 tests/results/interpret/interpret_par_conditional.txt create mode 100644 tests/results/interpret/interpret_par_model_averaged.txt create mode 100644 tests/results/interpret/interpret_par_model_averaged_null.txt create mode 100644 tests/results/interpret/interpret_par_with_units.txt create mode 100644 tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt create mode 100644 tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt create mode 100644 tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt create mode 100644 tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt create mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt create mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt create mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt create mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt create mode 100644 tests/results/model-averaging-edge-cases/models_inference_output.txt create mode 100644 tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_both.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt create mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt create mode 100644 tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt create mode 100644 tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt create mode 100644 tests/results/summary-tables-edge-cases/model_summary_basic.txt create mode 100644 tests/results/summary-tables-edge-cases/model_summary_no_spike.txt create mode 100644 tests/results/summary-tables-edge-cases/model_summary_short_name.txt create mode 100644 tests/results/summary-tables-edge-cases/update_table_BF01.txt create mode 100644 tests/results/summary-tables-edge-cases/update_table_footnotes.txt create mode 100644 tests/results/summary-tables-edge-cases/update_table_logBF.txt create mode 100644 tests/results/summary-tables-edge-cases/update_table_new_title.txt create mode 100644 tests/results/summary-tables-edge-cases/update_table_warnings.txt create mode 100644 tests/results/summary-tables-helpers/add_column_end.txt create mode 100644 tests/results/summary-tables-helpers/add_column_position1.txt create mode 100644 tests/results/summary-tables-helpers/add_column_position2.txt create mode 100644 tests/results/summary-tables-helpers/add_column_probability.txt create mode 100644 tests/results/summary-tables-helpers/add_column_string.txt create mode 100644 tests/results/summary-tables-helpers/ensemble_diagnostics_empty.txt create mode 100644 tests/results/summary-tables-helpers/ensemble_estimates_empty.txt create mode 100644 tests/results/summary-tables-helpers/ensemble_inference_empty.txt create mode 100644 tests/results/summary-tables-helpers/ensemble_summary_empty.txt create mode 100644 tests/results/summary-tables-helpers/remove_column_last.txt create mode 100644 tests/results/summary-tables-helpers/remove_column_position2.txt create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg create mode 100644 tests/testthat/test-JAGS-fit-edge-cases.R create mode 100644 tests/testthat/test-distributions-tools.R create mode 100644 tests/testthat/test-interpret.R create mode 100644 tests/testthat/test-model-averaging-edge-cases.R create mode 100644 tests/testthat/test-model-averaging-plots-edge-cases.R create mode 100644 tests/testthat/test-model-averaging.R create mode 100644 tests/testthat/test-summary-tables-edge-cases.R create mode 100644 tests/testthat/test-summary-tables-helpers.R diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt new file mode 100644 index 0000000..675529f --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt @@ -0,0 +1,14 @@ +model{ + prior_par1_p1 = rep(0,2) +for(i in 1:2){ + prior_par2_p1[i,i] <- 1 + for(j in 1:(i-1)){ + prior_par2_p1[i,j] <- 0 + } + for (j in (i+1):2){ + prior_par2_p1[i,j] <- 0 + } +} +p1 ~ dmnorm(prior_par1_p1,prior_par2_p1) + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt new file mode 100644 index 0000000..ce1c63f --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt @@ -0,0 +1,4 @@ +model{ + mu = 0 + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt new file mode 100644 index 0000000..2a3fead --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt @@ -0,0 +1,5 @@ +model{ + mu ~ dnorm(0,1) + sigma ~ dgamma(2,1) + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt new file mode 100644 index 0000000..c0b3005 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt @@ -0,0 +1,4 @@ +model{ + mu ~ dnorm(0,1)T(0,) + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt new file mode 100644 index 0000000..f2abcf7 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt @@ -0,0 +1,9 @@ +model{ + eta[1] ~ dgamma(1, 1) +eta[2] ~ dgamma(1, 1) +for(j in 1:2){ + std_eta[j] = eta[j] / sum(eta) + omega[j] = sum(std_eta[1:j]) +} + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt new file mode 100644 index 0000000..171d04e --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt @@ -0,0 +1 @@ +p1 diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt new file mode 100644 index 0000000..d3e80ff --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt @@ -0,0 +1 @@ +mu, sigma diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt new file mode 100644 index 0000000..bd3e5ce --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt @@ -0,0 +1 @@ +mu,sigma diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt new file mode 100644 index 0000000..9f9f098 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt new file mode 100644 index 0000000..4dff192 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 Spike(0) Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt new file mode 100644 index 0000000..a4332ca --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 N(0, 1) N(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 N(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt new file mode 100644 index 0000000..8410bd5 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt @@ -0,0 +1,4 @@ + Mean Median 0.025 0.95 +m 0.173 0.179 -0.221 0.494 +omega[0,0.05] 1.000 1.000 1.000 1.000 +omega[0.05,1] 0.692 0.834 0.031 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt new file mode 100644 index 0000000..43c9431 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt @@ -0,0 +1,4 @@ + Mean Median 0.1 0.5 0.9 +m 0.173 0.179 -0.107 0.179 0.427 +omega[0,0.05] 1.000 1.000 1.000 1.000 1.000 +omega[0.05,1] 0.692 0.834 0.137 0.834 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt new file mode 100644 index 0000000..0fd1795 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt @@ -0,0 +1,4 @@ + Mean Median 0.025 0.95 +(mu) x_fac3o [dif: A] 0.023 0.020 -0.185 0.188 +(mu) x_fac3o [dif: B] -0.306 -0.322 -0.520 0.000 +(mu) x_fac3o [dif: C] 0.282 0.289 0.000 0.476 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt b/tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt new file mode 100644 index 0000000..2e884ef --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Exclusion BF +m 2/2 1.000 1.000 0.000 +omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt b/tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt new file mode 100644 index 0000000..218ac8c --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt b/tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt new file mode 100644 index 0000000..f02847b --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Exclusion BF) +m 2/2 1.000 1.000 -Inf +omega 1/2 0.500 0.638 -0.565 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt b/tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt new file mode 100644 index 0000000..f4dd627 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Inclusion BF) +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt b/tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt new file mode 100644 index 0000000..b5b3576 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt b/tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt new file mode 100644 index 0000000..0dd2bec --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. log(Exclusion BF) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 2.461 + 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 -2.461 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt b/tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt new file mode 100644 index 0000000..c5be715 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 Spike(0) Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt b/tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt new file mode 100644 index 0000000..9043a08 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 N(0, 1) N(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 N(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt new file mode 100644 index 0000000..aec9b32 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 0.400 diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt new file mode 100644 index 0000000..340696f --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 2.500 diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt new file mode 100644 index 0000000..64ea4ce --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 0.916 diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_basic.txt b/tests/results/JAGS-fit-edge-cases/model_summary_basic.txt new file mode 100644 index 0000000..acc0bb8 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/model_summary_basic.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt b/tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt new file mode 100644 index 0000000..acc0bb8 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt b/tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt new file mode 100644 index 0000000..ef7083e --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ N(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt new file mode 100644 index 0000000..e4f1345 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI +beta (inclusion) 0.527 NA NA NA NA +beta[1] 0.064 1.028 -2.061 0.077 1.948 +beta[2] 0.010 0.994 -1.967 0.012 1.998 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt new file mode 100644 index 0000000..52e0bfe --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.017 0.977 -1.862 0.031 1.936 0.03092 0.032 1000 1.000 +p1[2] 0.050 1.002 -1.998 0.074 1.966 0.03171 0.032 1000 1.001 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt new file mode 100644 index 0000000..cff708f --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 0.02589 0.032 1000 1.001 +p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 0.02517 0.032 1000 0.999 +p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 0.02565 0.032 1000 1.002 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt new file mode 100644 index 0000000..b059b16 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt @@ -0,0 +1,2 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt new file mode 100644 index 0000000..a3f7134 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt new file mode 100644 index 0000000..7d673c6 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt new file mode 100644 index 0000000..c8bb523 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion) 0.527 NA NA NA NA NA NA NA NA +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt new file mode 100644 index 0000000..dcfb027 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.510 0.283 0.037 0.525 0.968 0.00894 0.032 1000 0.999 diff --git a/tests/results/JAGS-fit-edge-cases/update_table_BF01.txt b/tests/results/JAGS-fit-edge-cases/update_table_BF01.txt new file mode 100644 index 0000000..2e884ef --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/update_table_BF01.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Exclusion BF +m 2/2 1.000 1.000 0.000 +omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt b/tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt new file mode 100644 index 0000000..54a6071 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 +This is a footnote diff --git a/tests/results/JAGS-fit-edge-cases/update_table_logBF.txt b/tests/results/JAGS-fit-edge-cases/update_table_logBF.txt new file mode 100644 index 0000000..f4dd627 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/update_table_logBF.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Inclusion BF) +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/JAGS-fit-edge-cases/update_table_new_title.txt b/tests/results/JAGS-fit-edge-cases/update_table_new_title.txt new file mode 100644 index 0000000..3103bf8 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/update_table_new_title.txt @@ -0,0 +1,4 @@ +Updated Title + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/JAGS-fit-edge-cases/update_table_warnings.txt b/tests/results/JAGS-fit-edge-cases/update_table_warnings.txt new file mode 100644 index 0000000..70b177c --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/update_table_warnings.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 +This is a warning diff --git a/tests/results/JAGS-summary-tables/model_summary_empty.txt b/tests/results/JAGS-summary-tables/model_summary_empty.txt new file mode 100644 index 0000000..33949d6 --- /dev/null +++ b/tests/results/JAGS-summary-tables/model_summary_empty.txt @@ -0,0 +1,6 @@ + + Model Parameter prior distributions + Prior prob. + log(marglik) + Post. prob. + Inclusion BF diff --git a/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt b/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt new file mode 100644 index 0000000..ba1be3e --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI +p1[1] 0.017 0.977 -1.862 0.031 1.936 +p1[2] 0.050 1.002 -1.998 0.074 1.966 diff --git a/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt b/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt new file mode 100644 index 0000000..1625dee --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI +p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 +p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 +p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 diff --git a/tests/results/JAGS-summary-tables/runjags_formula_inference.txt b/tests/results/JAGS-summary-tables/runjags_formula_inference.txt new file mode 100644 index 0000000..4601b45 --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_formula_inference.txt @@ -0,0 +1,2 @@ +[1] Prior prob. Post. prob. Inclusion BF +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/runjags_formula_mixture_inference.txt b/tests/results/JAGS-summary-tables/runjags_formula_mixture_inference.txt new file mode 100644 index 0000000..6566f87 --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_formula_mixture_inference.txt @@ -0,0 +1,2 @@ + Prior prob. Post. prob. Inclusion BF +(mu) x_fac3t 0.500 0.398 0.661 diff --git a/tests/results/JAGS-summary-tables/runjags_inference_empty.txt b/tests/results/JAGS-summary-tables/runjags_inference_empty.txt new file mode 100644 index 0000000..4601b45 --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_inference_empty.txt @@ -0,0 +1,2 @@ +[1] Prior prob. Post. prob. Inclusion BF +<0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/runjags_joint_complex_inference.txt b/tests/results/JAGS-summary-tables/runjags_joint_complex_inference.txt new file mode 100644 index 0000000..fe29dbf --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_joint_complex_inference.txt @@ -0,0 +1,5 @@ + Prior prob. Post. prob. Inclusion BF +(mu) intercept 0.500 0.027 0.028 +(mu) x_cont1 0.500 0.363 0.570 +(mu) x_fac3t 0.500 0.066 0.071 +sigma 0.500 0.495 0.980 diff --git a/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt b/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt new file mode 100644 index 0000000..06c9e01 --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI +mu (inclusion) 0.721 NA NA NA NA +mu -3.003 0.951 -4.813 -2.981 -1.128 diff --git a/tests/results/JAGS-summary-tables/runjags_mixture_inference.txt b/tests/results/JAGS-summary-tables/runjags_mixture_inference.txt new file mode 100644 index 0000000..1805e8a --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_mixture_inference.txt @@ -0,0 +1,2 @@ + Prior prob. Post. prob. Inclusion BF +mu 0.714 0.721 1.034 diff --git a/tests/results/JAGS-summary-tables/runjags_mixture_spike_inference.txt b/tests/results/JAGS-summary-tables/runjags_mixture_spike_inference.txt new file mode 100644 index 0000000..78cc12a --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_mixture_spike_inference.txt @@ -0,0 +1,2 @@ + Prior prob. Post. prob. Inclusion BF +gamma 1.000 1.000 Inf diff --git a/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt b/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt new file mode 100644 index 0000000..88747a6 --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI +PET 0.819 0.625 0.041 0.671 2.263 +PEESE 1.031 1.020 0.034 0.735 3.787 diff --git a/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt b/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt new file mode 100644 index 0000000..a5a5ceb --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI +mu (inclusion) 0.504 NA NA NA NA +mu -0.006 0.939 -2.015 0.013 1.900 diff --git a/tests/results/JAGS-summary-tables/stan_estimates_basic.txt b/tests/results/JAGS-summary-tables/stan_estimates_basic.txt new file mode 100644 index 0000000..76d4fc3 --- /dev/null +++ b/tests/results/JAGS-summary-tables/stan_estimates_basic.txt @@ -0,0 +1,8 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 +pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 diff --git a/tests/results/interpret/interpret2_basic.txt b/tests/results/interpret/interpret2_basic.txt new file mode 100644 index 0000000..4b3f1f9 --- /dev/null +++ b/tests/results/interpret/interpret2_basic.txt @@ -0,0 +1 @@ +RoBMA found moderate evidence in favor of the Effect, BF10 = 3.50, with mean model-averaged estimate mu = 0.298 kg, 95% CI [-0.020, 0.601]. diff --git a/tests/results/interpret/interpret2_conditional.txt b/tests/results/interpret/interpret2_conditional.txt new file mode 100644 index 0000000..78c3d31 --- /dev/null +++ b/tests/results/interpret/interpret2_conditional.txt @@ -0,0 +1 @@ +Test found strong evidence in favor of the Effect, BF10 = 15.00, with mean conditional estimate mu = 0.498, 95% CI [0.300, 0.704]. diff --git a/tests/results/interpret/interpret2_evidence_against.txt b/tests/results/interpret/interpret2_evidence_against.txt new file mode 100644 index 0000000..8b9d194 --- /dev/null +++ b/tests/results/interpret/interpret2_evidence_against.txt @@ -0,0 +1 @@ +Method found moderate evidence against the Effect, BF01 = 0.100, with mean model-averaged estimate mu = 0.001, 95% CI [-0.103, 0.099]. diff --git a/tests/results/interpret/interpret2_inference_only.txt b/tests/results/interpret/interpret2_inference_only.txt new file mode 100644 index 0000000..586ae14 --- /dev/null +++ b/tests/results/interpret/interpret2_inference_only.txt @@ -0,0 +1 @@ +RoBMA found moderate evidence in favor of the Bias, BF_pb = 5.00. diff --git a/tests/results/interpret/interpret2_multiple.txt b/tests/results/interpret/interpret2_multiple.txt new file mode 100644 index 0000000..424a99c --- /dev/null +++ b/tests/results/interpret/interpret2_multiple.txt @@ -0,0 +1 @@ +Test found moderate evidence in favor of the Effect, BF10 = 10.00, with mean model-averaged estimate mu = 0.298, 95% CI [0.109, 0.499]. Test found weak evidence against the Bias, BF_pb = 0.500. diff --git a/tests/results/interpret/interpret2_no_method.txt b/tests/results/interpret/interpret2_no_method.txt new file mode 100644 index 0000000..06ebd1d --- /dev/null +++ b/tests/results/interpret/interpret2_no_method.txt @@ -0,0 +1 @@ + found weak evidence in favor of the Effect, BF = 2.00. diff --git a/tests/results/interpret/interpret2_weak_evidence.txt b/tests/results/interpret/interpret2_weak_evidence.txt new file mode 100644 index 0000000..48c5623 --- /dev/null +++ b/tests/results/interpret/interpret2_weak_evidence.txt @@ -0,0 +1 @@ +Test found weak evidence in favor of the Effect, BF = 1.50, with mean model-averaged estimate delta = 0.102, 95% CI [-0.105, 0.305]. diff --git a/tests/results/interpret/interpret_BF_moderate_against1.txt b/tests/results/interpret/interpret_BF_moderate_against1.txt new file mode 100644 index 0000000..67ea16f --- /dev/null +++ b/tests/results/interpret/interpret_BF_moderate_against1.txt @@ -0,0 +1 @@ +moderate evidence against the effect, BF = 0.100 diff --git a/tests/results/interpret/interpret_BF_moderate_against2.txt b/tests/results/interpret/interpret_BF_moderate_against2.txt new file mode 100644 index 0000000..8f1cd6e --- /dev/null +++ b/tests/results/interpret/interpret_BF_moderate_against2.txt @@ -0,0 +1 @@ +moderate evidence against the effect, BF = 0.200 diff --git a/tests/results/interpret/interpret_BF_moderate_favor.txt b/tests/results/interpret/interpret_BF_moderate_favor.txt new file mode 100644 index 0000000..12350a8 --- /dev/null +++ b/tests/results/interpret/interpret_BF_moderate_favor.txt @@ -0,0 +1 @@ +moderate evidence in favor of the effect, BF = 5.00 diff --git a/tests/results/interpret/interpret_BF_strong_against.txt b/tests/results/interpret/interpret_BF_strong_against.txt new file mode 100644 index 0000000..5f7c4dd --- /dev/null +++ b/tests/results/interpret/interpret_BF_strong_against.txt @@ -0,0 +1 @@ +strong evidence against the effect, BF01 = 0.050 diff --git a/tests/results/interpret/interpret_BF_strong_favor.txt b/tests/results/interpret/interpret_BF_strong_favor.txt new file mode 100644 index 0000000..a48058c --- /dev/null +++ b/tests/results/interpret/interpret_BF_strong_favor.txt @@ -0,0 +1 @@ +strong evidence in favor of the effect, BF10 = 15.00 diff --git a/tests/results/interpret/interpret_BF_weak_against.txt b/tests/results/interpret/interpret_BF_weak_against.txt new file mode 100644 index 0000000..c16222c --- /dev/null +++ b/tests/results/interpret/interpret_BF_weak_against.txt @@ -0,0 +1 @@ +weak evidence against the effect, BF = 0.500 diff --git a/tests/results/interpret/interpret_BF_weak_favor.txt b/tests/results/interpret/interpret_BF_weak_favor.txt new file mode 100644 index 0000000..74cb86e --- /dev/null +++ b/tests/results/interpret/interpret_BF_weak_favor.txt @@ -0,0 +1 @@ +weak evidence in favor of the effect, BF = 1.50 diff --git a/tests/results/interpret/interpret_par_conditional.txt b/tests/results/interpret/interpret_par_conditional.txt new file mode 100644 index 0000000..7a128d7 --- /dev/null +++ b/tests/results/interpret/interpret_par_conditional.txt @@ -0,0 +1 @@ +with mean conditional estimate mu = 0.499, 95% CI [0.302, 0.696] diff --git a/tests/results/interpret/interpret_par_model_averaged.txt b/tests/results/interpret/interpret_par_model_averaged.txt new file mode 100644 index 0000000..99f1399 --- /dev/null +++ b/tests/results/interpret/interpret_par_model_averaged.txt @@ -0,0 +1 @@ +with mean model-averaged estimate mu = 0.499, 95% CI [0.302, 0.696] diff --git a/tests/results/interpret/interpret_par_model_averaged_null.txt b/tests/results/interpret/interpret_par_model_averaged_null.txt new file mode 100644 index 0000000..1f56942 --- /dev/null +++ b/tests/results/interpret/interpret_par_model_averaged_null.txt @@ -0,0 +1 @@ +with mean model-averaged estimate delta = 0.499, 95% CI [0.302, 0.696] diff --git a/tests/results/interpret/interpret_par_with_units.txt b/tests/results/interpret/interpret_par_with_units.txt new file mode 100644 index 0000000..6d97e5a --- /dev/null +++ b/tests/results/interpret/interpret_par_with_units.txt @@ -0,0 +1 @@ +with mean model-averaged estimate weight = 0.499 kg, 95% CI [0.302, 0.696] diff --git a/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt b/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt new file mode 100644 index 0000000..67b8a14 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt @@ -0,0 +1,4 @@ +Class: list, as_mixed_posteriors, mixed_posteriors +Parameters: m, s +Has prior_list for m: TRUE +Has prior_list for s: TRUE diff --git a/tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt b/tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt new file mode 100644 index 0000000..bbcf71e --- /dev/null +++ b/tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt @@ -0,0 +1,2 @@ +Conditional: TRUE +BF: 0.0853 diff --git a/tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt b/tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt new file mode 100644 index 0000000..3cf75cd --- /dev/null +++ b/tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt @@ -0,0 +1,4 @@ +BF: 0.0853 +is_null: FALSE, TRUE +prior_probs: 0.5, 0.5 +post_probs: 0.0786, 0.9214 diff --git a/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt b/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt new file mode 100644 index 0000000..a990970 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt @@ -0,0 +1,4 @@ +All null models BF: 0 +All alternative models BF: Inf +Single alternative model BF: Inf +Equal margliks BF: 1 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt new file mode 100644 index 0000000..c74ff0b --- /dev/null +++ b/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt @@ -0,0 +1,3 @@ +Class: list, mixed_posteriors +Parameters: m +Sample size m: 1000 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt new file mode 100644 index 0000000..5f1edf7 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt @@ -0,0 +1,3 @@ +Class: list, mixed_posteriors +Parameter: mu_x_fac3o +Sample size: 2000 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt new file mode 100644 index 0000000..0055972 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt @@ -0,0 +1,4 @@ +Class: list, mixed_posteriors +Parameters: m, s +Sample size m: 1000 +Sample size s: 1000 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt new file mode 100644 index 0000000..e74301f --- /dev/null +++ b/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt @@ -0,0 +1,4 @@ +Class: list, mixed_posteriors +Parameters: m, omega +Sample size m: 1000 +Sample size omega: 3000 diff --git a/tests/results/model-averaging-edge-cases/models_inference_output.txt b/tests/results/model-averaging-edge-cases/models_inference_output.txt new file mode 100644 index 0000000..c126062 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/models_inference_output.txt @@ -0,0 +1,9 @@ +Model 1 inference: + m_number: 1 + prior_prob: 0.333333 + post_prob: 0.040927 +Model 2 inference: + m_number: 2 + prior_prob: 0.666667 + post_prob: 0.959073 +Total post_prob: 1 diff --git a/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt b/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt new file mode 100644 index 0000000..6ce45a5 --- /dev/null +++ b/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt @@ -0,0 +1,4 @@ +One-sided mapping length: 1 +Two-sided mapping length: 1 +Two-sided with one_sided=TRUE length: 1 +Cuts: 0, 0.05, 1 diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt new file mode 100644 index 0000000..9f9f098 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt new file mode 100644 index 0000000..4dff192 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 Spike(0) Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt new file mode 100644 index 0000000..a4332ca --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) + 1 N(0, 1) N(0, 1)[0, Inf] 0.00199 0.043 540 1.005 + 2 N(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt new file mode 100644 index 0000000..8410bd5 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt @@ -0,0 +1,4 @@ + Mean Median 0.025 0.95 +m 0.173 0.179 -0.221 0.494 +omega[0,0.05] 1.000 1.000 1.000 1.000 +omega[0.05,1] 0.692 0.834 0.031 1.000 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt new file mode 100644 index 0000000..43c9431 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt @@ -0,0 +1,4 @@ + Mean Median 0.1 0.5 0.9 +m 0.173 0.179 -0.107 0.179 0.427 +omega[0,0.05] 1.000 1.000 1.000 1.000 1.000 +omega[0.05,1] 0.692 0.834 0.137 0.834 1.000 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt new file mode 100644 index 0000000..c2511e9 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt @@ -0,0 +1,3 @@ + Mean Median 0.025 0.95 +intercept 0.514 0.512 0.355 0.650 +sigma 0.886 0.885 0.783 0.982 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt new file mode 100644 index 0000000..7aa34c5 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt @@ -0,0 +1,3 @@ + Mean Median 0.025 0.95 +(mu) intercept 0.514 0.512 0.355 0.650 +sigma 0.886 0.885 0.783 0.982 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt new file mode 100644 index 0000000..0fd1795 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt @@ -0,0 +1,4 @@ + Mean Median 0.025 0.95 +(mu) x_fac3o [dif: A] 0.023 0.020 -0.185 0.188 +(mu) x_fac3o [dif: B] -0.306 -0.322 -0.520 0.000 +(mu) x_fac3o [dif: C] 0.282 0.289 0.000 0.476 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt new file mode 100644 index 0000000..2e884ef --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Exclusion BF +m 2/2 1.000 1.000 0.000 +omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt new file mode 100644 index 0000000..218ac8c --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt new file mode 100644 index 0000000..f02847b --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Exclusion BF) +m 2/2 1.000 1.000 -Inf +omega 1/2 0.500 0.638 -0.565 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt new file mode 100644 index 0000000..f4dd627 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Inclusion BF) +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt new file mode 100644 index 0000000..b5b3576 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt new file mode 100644 index 0000000..0dd2bec --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. log(Exclusion BF) + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 2.461 + 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 -2.461 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt new file mode 100644 index 0000000..c5be715 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 Spike(0) Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt new file mode 100644 index 0000000..6183166 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt @@ -0,0 +1,3 @@ + Model Prior m Prior renamed 2 Prior prob. log(marglik) Post. prob. Inclusion BF + 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt new file mode 100644 index 0000000..9043a08 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt @@ -0,0 +1,3 @@ + Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF + 1 N(0, 1) N(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 + 2 N(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt new file mode 100644 index 0000000..aec9b32 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 0.400 diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt new file mode 100644 index 0000000..340696f --- /dev/null +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 2.500 diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt new file mode 100644 index 0000000..64ea4ce --- /dev/null +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt @@ -0,0 +1,2 @@ + Mean Median 0.025 0.95 Inclusion BF +mu[] -0.936 -0.936 -0.936 -0.936 0.916 diff --git a/tests/results/summary-tables-edge-cases/model_summary_basic.txt b/tests/results/summary-tables-edge-cases/model_summary_basic.txt new file mode 100644 index 0000000..acc0bb8 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/model_summary_basic.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt b/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt new file mode 100644 index 0000000..acc0bb8 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/model_summary_short_name.txt b/tests/results/summary-tables-edge-cases/model_summary_short_name.txt new file mode 100644 index 0000000..ef7083e --- /dev/null +++ b/tests/results/summary-tables-edge-cases/model_summary_short_name.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 s ~ N(0, 1)[0, Inf] + log(marglik) -29.49 + Post. prob. 1.000 + Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/update_table_BF01.txt b/tests/results/summary-tables-edge-cases/update_table_BF01.txt new file mode 100644 index 0000000..2e884ef --- /dev/null +++ b/tests/results/summary-tables-edge-cases/update_table_BF01.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. Exclusion BF +m 2/2 1.000 1.000 0.000 +omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/summary-tables-edge-cases/update_table_footnotes.txt b/tests/results/summary-tables-edge-cases/update_table_footnotes.txt new file mode 100644 index 0000000..54a6071 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/update_table_footnotes.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 +This is a footnote diff --git a/tests/results/summary-tables-edge-cases/update_table_logBF.txt b/tests/results/summary-tables-edge-cases/update_table_logBF.txt new file mode 100644 index 0000000..f4dd627 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/update_table_logBF.txt @@ -0,0 +1,3 @@ + Models Prior prob. Post. prob. log(Inclusion BF) +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/summary-tables-edge-cases/update_table_new_title.txt b/tests/results/summary-tables-edge-cases/update_table_new_title.txt new file mode 100644 index 0000000..3103bf8 --- /dev/null +++ b/tests/results/summary-tables-edge-cases/update_table_new_title.txt @@ -0,0 +1,4 @@ +Updated Title + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/summary-tables-edge-cases/update_table_warnings.txt b/tests/results/summary-tables-edge-cases/update_table_warnings.txt new file mode 100644 index 0000000..70b177c --- /dev/null +++ b/tests/results/summary-tables-edge-cases/update_table_warnings.txt @@ -0,0 +1,4 @@ + Models Prior prob. Post. prob. Inclusion BF +m 2/2 1.000 1.000 Inf +omega 1/2 0.500 0.638 1.759 +This is a warning diff --git a/tests/results/summary-tables-helpers/add_column_end.txt b/tests/results/summary-tables-helpers/add_column_end.txt new file mode 100644 index 0000000..c52bce4 --- /dev/null +++ b/tests/results/summary-tables-helpers/add_column_end.txt @@ -0,0 +1,3 @@ + Mean Median SD CI_lower +mu 0.500 0.400 0.100 -0.500 +sigma 1.200 1.100 0.200 0.800 diff --git a/tests/results/summary-tables-helpers/add_column_position1.txt b/tests/results/summary-tables-helpers/add_column_position1.txt new file mode 100644 index 0000000..886a035 --- /dev/null +++ b/tests/results/summary-tables-helpers/add_column_position1.txt @@ -0,0 +1,3 @@ + ID Mean Median SD +mu 1 0.500 0.400 0.100 +sigma 2 1.200 1.100 0.200 diff --git a/tests/results/summary-tables-helpers/add_column_position2.txt b/tests/results/summary-tables-helpers/add_column_position2.txt new file mode 100644 index 0000000..cdd93b8 --- /dev/null +++ b/tests/results/summary-tables-helpers/add_column_position2.txt @@ -0,0 +1,3 @@ + Mean CI_lower Median SD +mu 0.500 -0.500 0.400 0.100 +sigma 1.200 0.800 1.100 0.200 diff --git a/tests/results/summary-tables-helpers/add_column_probability.txt b/tests/results/summary-tables-helpers/add_column_probability.txt new file mode 100644 index 0000000..6538b82 --- /dev/null +++ b/tests/results/summary-tables-helpers/add_column_probability.txt @@ -0,0 +1,3 @@ + Mean Median SD Prob +mu 0.500 0.400 0.100 0.500 +sigma 1.200 1.100 0.200 0.800 diff --git a/tests/results/summary-tables-helpers/add_column_string.txt b/tests/results/summary-tables-helpers/add_column_string.txt new file mode 100644 index 0000000..af2cf31 --- /dev/null +++ b/tests/results/summary-tables-helpers/add_column_string.txt @@ -0,0 +1,3 @@ + Mean Median SD Category +mu 0.500 0.400 0.100 A +sigma 1.200 1.100 0.200 B diff --git a/tests/results/summary-tables-helpers/ensemble_diagnostics_empty.txt b/tests/results/summary-tables-helpers/ensemble_diagnostics_empty.txt new file mode 100644 index 0000000..7332672 --- /dev/null +++ b/tests/results/summary-tables-helpers/ensemble_diagnostics_empty.txt @@ -0,0 +1,2 @@ +[1] Model max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) +<0 rows> (or 0-length row.names) diff --git a/tests/results/summary-tables-helpers/ensemble_estimates_empty.txt b/tests/results/summary-tables-helpers/ensemble_estimates_empty.txt new file mode 100644 index 0000000..2d49d4b --- /dev/null +++ b/tests/results/summary-tables-helpers/ensemble_estimates_empty.txt @@ -0,0 +1,2 @@ +[1] Mean Median 0.025 0.95 +<0 rows> (or 0-length row.names) diff --git a/tests/results/summary-tables-helpers/ensemble_inference_empty.txt b/tests/results/summary-tables-helpers/ensemble_inference_empty.txt new file mode 100644 index 0000000..a6e4ded --- /dev/null +++ b/tests/results/summary-tables-helpers/ensemble_inference_empty.txt @@ -0,0 +1,2 @@ +[1] Models Prior prob. Post. prob. Inclusion BF +<0 rows> (or 0-length row.names) diff --git a/tests/results/summary-tables-helpers/ensemble_summary_empty.txt b/tests/results/summary-tables-helpers/ensemble_summary_empty.txt new file mode 100644 index 0000000..c836eff --- /dev/null +++ b/tests/results/summary-tables-helpers/ensemble_summary_empty.txt @@ -0,0 +1,2 @@ +[1] Model Prior prob. log(marglik) Post. prob. Inclusion BF +<0 rows> (or 0-length row.names) diff --git a/tests/results/summary-tables-helpers/remove_column_last.txt b/tests/results/summary-tables-helpers/remove_column_last.txt new file mode 100644 index 0000000..01a1f10 --- /dev/null +++ b/tests/results/summary-tables-helpers/remove_column_last.txt @@ -0,0 +1,3 @@ + Mean Median +mu 0.500 0.400 +sigma 1.200 1.100 diff --git a/tests/results/summary-tables-helpers/remove_column_position2.txt b/tests/results/summary-tables-helpers/remove_column_position2.txt new file mode 100644 index 0000000..a0eb98e --- /dev/null +++ b/tests/results/summary-tables-helpers/remove_column_position2.txt @@ -0,0 +1,3 @@ + Mean SD +mu 0.500 0.100 +sigma 1.200 0.200 diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg index 4c16580..a5c35c4 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-1.svg @@ -31,19 +31,19 @@ 0.6 0.8 1.0 - + - - - - - + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 +0.2 +0.4 +0.6 +0.8 +1.0 PET-PEESE Standard error Effect size @@ -54,9 +54,9 @@ - + - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg index 7ed62ca..9b5eb74 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-11.svg @@ -54,9 +54,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg index 2d78ed7..7b630b1 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-2.svg @@ -27,21 +27,19 @@ - - - - - + + + + - - - - + + + @@ -49,23 +47,21 @@ - - - - + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 +0.5 +1.0 +1.5 +2.0 - - - - + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg index 5891bbd..b69c5b4 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-5.svg @@ -31,17 +31,17 @@ 0.6 0.8 1.0 - + - - - - + + + + 0.0 -0.2 -0.4 -0.6 -0.8 +0.2 +0.4 +0.6 +0.8 PET-PEESE Standard error Effect size @@ -52,9 +52,9 @@ - + - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg index 1e2739b..42efcc5 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-7.svg @@ -31,17 +31,17 @@ 0.6 0.8 1.0 - + - - - - + + + + 0.0 -0.5 -1.0 -1.5 -2.0 +0.5 +1.0 +1.5 +2.0 PET-PEESE Standard error Effect size @@ -52,9 +52,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg index b4eaea2..d4b62ac 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-9.svg @@ -31,17 +31,17 @@ 0.6 0.8 1.0 - + - - - - + + + + 0.0 -0.5 -1.0 -1.5 -2.0 +0.5 +1.0 +1.5 +2.0 main xlab ylab @@ -52,7 +52,7 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg index 24c01eb..267edc4 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg index b39f79c..d509dd1 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg @@ -49,9 +49,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg index 7549e37..49950e5 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg @@ -49,8 +49,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg index 5e0787c..17f353b 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg index 6843601..6b7d372 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg @@ -53,9 +53,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg index 0903d40..6a4a2ee 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg @@ -50,7 +50,7 @@ - - + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg new file mode 100644 index 0000000..da74c30 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + +-4 +-2 +0 +2 +4 +x +y +geom-prior-list-add + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg new file mode 100644 index 0000000..875b98c --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg new file mode 100644 index 0000000..74df3e2 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg new file mode 100644 index 0000000..cdad4f0 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 +m + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +0.17 [-0.22, 0.59] +0.20 [-0.20, 0.63] +BF = 0.57 [0.50 -> 0.36] +0.16 [-0.25, 0.50] +BF = 1.76 [0.50 -> 0.64] + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg new file mode 100644 index 0000000..edf0336 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Model-Averaged +Model 1 +Model 2 +0.17 [-0.22, 0.59] +0.20 [-0.20, 0.63] +0.16 [-0.25, 0.50] +BF = 0.57 [0.50 -> 0.36] +BF = 1.76 [0.50 -> 0.64] + + + + + + + +-0.4 +-0.2 +0 +0.2 +0.4 +0.6 +0.8 +m +plot-models-ggplot + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg new file mode 100644 index 0000000..b10fd44 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +Density + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg new file mode 100644 index 0000000..aa9a2fd --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +0.05 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg new file mode 100644 index 0000000..12569e6 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + +-0.5 +0.0 +0.5 +1.0 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg new file mode 100644 index 0000000..e989342 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg new file mode 100644 index 0000000..990f8b8 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg new file mode 100644 index 0000000..7c97b64 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density +Probability + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg new file mode 100644 index 0000000..f39519e --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + +Density + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg new file mode 100644 index 0000000..10b1215 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + +0.0 +0.1 +0.2 +0.3 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg new file mode 100644 index 0000000..8c76f64 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + +-1.5 +-1.0 +-0.5 +0.0 +0.5 +1.0 +1.5 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg new file mode 100644 index 0000000..e650d3b --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 + + + + + + + + + + + + +-1.5 +-1.0 +-0.5 +0.0 +0.5 +1.0 +1.5 +Density + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg new file mode 100644 index 0000000..5d32a29 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + +-40 +-20 +0 +20 +40 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg new file mode 100644 index 0000000..c15cf95 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg new file mode 100644 index 0000000..cc920d0 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg new file mode 100644 index 0000000..dea16d7 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg new file mode 100644 index 0000000..32360e2 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.05 +1 +p +-value +Probability +Selection Models + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg new file mode 100644 index 0000000..02d7f77 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +0.05 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index 4e1dec8..e2d5db9 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -54,9 +54,18 @@ test_reference_text <- function(text, filename, info_msg = NULL, ref_file <- file.path(print_dir, filename) if (file.exists(ref_file)) { expected_output <- readLines(ref_file, warn = FALSE) + expected_output <- paste0(expected_output, collapse = "\n") expect_equal(text, expected_output, info = info_msg) } else { skip(paste("Reference file", filename, "not found.")) } } } + +# Skip if pre-fitted models are not available +skip_if_no_fits <- function() { + model_registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + if (!file.exists(model_registry_file)) { + skip("Pre-fitted models not found. Run test-00-model-fits.R first.") + } +} diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R new file mode 100644 index 0000000..057d2af --- /dev/null +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -0,0 +1,214 @@ +context("JAGS fit edge cases and comprehensive tests") + +# Reference directory for text output comparisons +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-fit-edge-cases") + +source(testthat::test_path("common-functions.R")) + + +# ============================================================================ # +# SECTION 1: JAGS_add_priors tests +# ============================================================================ # +test_that("JAGS_add_priors handles various prior types", { + + skip_if_not_installed("rjags") + + # Test with simple priors + syntax_simple <- "model{}" + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + result_simple <- JAGS_add_priors(syntax_simple, priors_simple) + test_reference_text(result_simple, "JAGS_add_priors_simple.txt") + + # Test with truncated priors + priors_truncated <- list( + mu = prior("normal", list(0, 1), list(0, Inf)) + ) + + result_truncated <- JAGS_add_priors(syntax_simple, priors_truncated) + test_reference_text(result_truncated, "JAGS_add_priors_truncated.txt") + + # Test with point prior + priors_point <- list( + mu = prior("point", list(0)) + ) + + result_point <- JAGS_add_priors(syntax_simple, priors_point) + test_reference_text(result_point, "JAGS_add_priors_point.txt") + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + result_factor <- JAGS_add_priors(syntax_simple, priors_factor) + test_reference_text(result_factor, "JAGS_add_priors_factor.txt") + + # Test with weightfunction priors + priors_wf <- list( + omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + ) + + result_wf <- JAGS_add_priors(syntax_simple, priors_wf) + test_reference_text(result_wf, "JAGS_add_priors_weightfunction.txt") + +}) + + +# ============================================================================ # +# SECTION 2: JAGS_get_inits tests +# ============================================================================ # +test_that("JAGS_get_inits handles various prior types", { + + skip_if_not_installed("rjags") + + # Test with simple priors + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + inits1 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) + expect_equal(length(inits1), 2) + expect_true("mu" %in% names(inits1[[1]])) + expect_true("sigma" %in% names(inits1[[1]])) + + # Same seed should give same results + inits2 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) + expect_equal(inits1, inits2) + + # Different seeds should give different results + inits3 <- JAGS_get_inits(priors_simple, chains = 2, seed = 123) + expect_false(isTRUE(all.equal(inits1, inits3))) + + # Test with truncated priors + priors_truncated <- list( + mu = prior("normal", list(0, 1), list(0, Inf)) + ) + + inits_truncated <- JAGS_get_inits(priors_truncated, chains = 2, seed = 1) + expect_true(all(sapply(inits_truncated, function(i) i$mu >= 0))) + + # Test with point prior + priors_point <- list( + mu = prior("point", list(5)) + ) + + inits_point <- JAGS_get_inits(priors_point, chains = 2, seed = 1) + # Point priors should not generate inits (they're fixed) + expect_true(!("mu" %in% names(inits_point[[1]])) || all(sapply(inits_point, function(i) i$mu == 5))) + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + inits_factor <- JAGS_get_inits(priors_factor, chains = 2, seed = 1) + expect_true("p1" %in% names(inits_factor[[1]])) + +}) + + +# ============================================================================ # +# SECTION 3: JAGS_check_convergence tests +# ============================================================================ # +test_that("JAGS_check_convergence works with fitted models", { + + skip_if_not_installed("rjags") + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + prior_list <- attr(fit_simple, "prior_list") + + # Test convergence check with prior_list + convergence <- JAGS_check_convergence(fit_simple, prior_list = prior_list) + expect_true(is.logical(convergence) || is.list(convergence)) + + # Test with NULL prior_list + convergence_null <- JAGS_check_convergence(fit_simple, prior_list = NULL) + expect_true(is.logical(convergence_null) || is.list(convergence_null)) + +}) + + +# ============================================================================ # +# SECTION 4: JAGS_to_monitor tests +# ============================================================================ # +test_that("JAGS_to_monitor generates correct monitor strings", { + + skip_if_not_installed("rjags") + + # Test with simple priors + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + monitor <- JAGS_to_monitor(priors_simple) + test_reference_text(paste(sort(monitor), collapse = ","), "JAGS_to_monitor_simple.txt") + + # Test with point prior + priors_with_point <- list( + mu = prior("normal", list(0, 1)), + fixed = prior("point", list(0)) + ) + + monitor_point <- JAGS_to_monitor(priors_with_point) + test_reference_text(paste(sort(monitor), collapse = ", "), "JAGS_to_monitor_point.txt") + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + monitor_factor <- JAGS_to_monitor(priors_factor) + test_reference_text(paste(sort(monitor_factor), collapse = ","), "JAGS_to_monitor_factor.txt") + +}) + + +# ============================================================================ # +# SECTION 5: JAGS_fit attribute preservation +# ============================================================================ # +test_that("JAGS_fit preserves attributes", { + + skip_if_not_installed("rjags") + skip_on_cran() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Check that prior_list attribute is preserved + prior_list <- attr(fit_simple, "prior_list") + expect_true(!is.null(prior_list)) + expect_true(is.list(prior_list)) + + # Check class + expect_true(inherits(fit_simple, "BayesTools_fit") || inherits(fit_simple, "runjags")) + +}) + + +# ============================================================================ # +# SECTION 6: runjags_estimates_table tests (diagnostics via summary-tables) +# ============================================================================ # +test_that("runjags_estimates_table works with fitted models", { + + skip_if_not_installed("rjags") + skip_on_cran() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Test basic estimates table + estimates_table <- runjags_estimates_table(fit_simple) + test_reference_table(estimates_table, "runjags_estimates_simple.txt") + + # Test without specific parameters + estimates_table_param <- runjags_estimates_table(fit_simple, remove_parameters = "m") + test_reference_table(estimates_table_param, "runjags_estimates_param_m.txt") + +}) diff --git a/tests/testthat/test-JAGS-marginal-distributions.R b/tests/testthat/test-JAGS-marginal-distributions.R index ba064ae..12e4ed8 100644 --- a/tests/testthat/test-JAGS-marginal-distributions.R +++ b/tests/testthat/test-JAGS-marginal-distributions.R @@ -1,4 +1,4 @@ -context("Marginal distributions") +context("JAGS marginal distributions") # This file tests marginal_posterior, ensemble_inference, mix_posteriors, # and related functions. Uses pre-fitted models from test-00-model-fits.R. diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 0c6ab55..22d48c5 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -25,6 +25,7 @@ test_that("Summary table advanced features work correctly", { skip_if_not_installed("rjags") skip_if_not_installed("bridgesampling") + skip_if_no_fits() # Use fit_formula_interaction_cont for testing advanced features # This model has continuous interactions and formulas @@ -122,6 +123,7 @@ test_that("Summary tables for all saved models", { skip_if_not_installed("rjags") skip_if_not_installed("bridgesampling") + skip_if_no_fits() runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) @@ -163,3 +165,126 @@ test_that("Summary tables for all saved models", { } }) + + +# ============================================================================ # +# SECTION 4: Test runjags_estimates_table with conditional=TRUE on various priors +# ============================================================================ # +test_that("runjags_estimates_table with conditional=TRUE on various prior types", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + skip_on_cran() + skip_if_no_fits() + + # Test with publication bias priors + fit_pub_bias <- readRDS(file.path(temp_fits_dir, "fit_simple_pub_bias.RDS")) + runjags_pub_bias_conditional <- runjags_estimates_table(fit_pub_bias, conditional = TRUE) + test_reference_table(runjags_pub_bias_conditional, "runjags_pub_bias_conditional.txt") + + # Test with factor priors + fit_factor <- readRDS(file.path(temp_fits_dir, "fit_factor_orthonormal.RDS")) + runjags_factor_conditional <- runjags_estimates_table(fit_factor, conditional = TRUE) + test_reference_table(runjags_factor_conditional, "runjags_factor_conditional.txt") + + runjags_factor_conditional_transformed <- runjags_estimates_table(fit_factor, conditional = TRUE, transform_factors = TRUE) + test_reference_table(runjags_factor_conditional_transformed, "runjags_factor_conditional_transformed.txt") + + # Test with mixture priors + fit_mixture <- readRDS(file.path(temp_fits_dir, "fit_mixture_simple.RDS")) + runjags_mixture_conditional <- runjags_estimates_table(fit_mixture, conditional = TRUE) + test_reference_table(runjags_mixture_conditional, "runjags_mixture_conditional.txt") + + # Test with spike and slab priors + fit_spike_slab <- readRDS(file.path(temp_fits_dir, "fit_spike_slab_simple.RDS")) + runjags_spike_slab_conditional <- runjags_estimates_table(fit_spike_slab, conditional = TRUE) + test_reference_table(runjags_spike_slab_conditional, "runjags_spike_slab_conditional.txt") + +}) + + +# ============================================================================ # +# SECTION 5: Test runjags_inference_table with mixture and formula priors +# ============================================================================ # +test_that("runjags_inference_table with mixture priors", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + skip_on_cran() + skip_if_no_fits() + + # Test with mixture priors + fit_mixture <- readRDS(file.path(temp_fits_dir, "fit_mixture_simple.RDS")) + runjags_mixture_inference <- runjags_inference_table(fit_mixture) + test_reference_table(runjags_mixture_inference, "runjags_mixture_inference.txt") + + # Test with mixture containing spike + fit_mixture_spike <- readRDS(file.path(temp_fits_dir, "fit_mixture_spike.RDS")) + runjags_mixture_spike_inference <- runjags_inference_table(fit_mixture_spike) + test_reference_table(runjags_mixture_spike_inference, "runjags_mixture_spike_inference.txt") + +}) + + +test_that("runjags_inference_table with formula priors", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + skip_on_cran() + skip_if_no_fits() + + # Test with formula + mixture priors (mixture on factor predictor) + fit_formula_mixture <- readRDS(file.path(temp_fits_dir, "fit_formula_factor_mixture.RDS")) + runjags_formula_mixture_inference <- runjags_inference_table(fit_formula_mixture) + test_reference_table(runjags_formula_mixture_inference, "runjags_formula_mixture_inference.txt") + + # Test with joint complex model (formula + mixture + spike-and-slab) + fit_joint <- readRDS(file.path(temp_fits_dir, "fit_joint_complex.RDS")) + runjags_joint_inference <- runjags_inference_table(fit_joint) + test_reference_table(runjags_joint_inference, "runjags_joint_complex_inference.txt") + +}) + + +# ============================================================================ # +# SECTION 6: Test empty tables +# ============================================================================ # +test_that("model_summary_empty_table works correctly", { + + empty_table <- model_summary_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_true(nrow(empty_table) > 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "model_summary_empty.txt") + +}) + + +test_that("runjags_inference_empty_table works correctly", { + + empty_table <- runjags_inference_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_equal(nrow(empty_table), 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "runjags_inference_empty.txt") + +}) + + +# ============================================================================ # +# SECTION 7: Test stan_estimates_table with stored RDS file +# ============================================================================ # +test_that("stan_estimates_table works with stored fit", { + + skip_if_not_installed("rstan") + + # Load stored stan fit from tests/results/fits + stan_fit_file <- testthat::test_path("..", "results", "fits", "fit_RoBTT.RDS") + + fit_stan <- readRDS(stan_fit_file) + + # Test basic stan_estimates_table + stan_summary <- stan_estimates_table(fit_stan) + test_reference_table(stan_summary, "stan_estimates_basic.txt") + +}) diff --git a/tests/testthat/test-distributions-tools.R b/tests/testthat/test-distributions-tools.R new file mode 100644 index 0000000..0aea7c5 --- /dev/null +++ b/tests/testthat/test-distributions-tools.R @@ -0,0 +1,94 @@ +context("Distribution tools helpers") + + +test_that(".check_log works", { + + expect_null(BayesTools:::.check_log(TRUE)) + expect_null(BayesTools:::.check_log(FALSE)) + + expect_error(BayesTools:::.check_log("TRUE"), "must be a logical") + expect_error(BayesTools:::.check_log(1), "must be a logical") + expect_error(BayesTools:::.check_log(NULL), "cannot be NULL") + +}) + + +test_that(".check_log.p works", { + + expect_null(BayesTools:::.check_log.p(TRUE)) + expect_null(BayesTools:::.check_log.p(FALSE)) + + expect_error(BayesTools:::.check_log.p("TRUE"), "must be a logical") + expect_error(BayesTools:::.check_log.p(1), "must be a logical") + +}) + + +test_that(".check_lower.tail works", { + + expect_null(BayesTools:::.check_lower.tail(TRUE)) + expect_null(BayesTools:::.check_lower.tail(FALSE)) + + expect_error(BayesTools:::.check_lower.tail("TRUE"), "must be a logical") + expect_error(BayesTools:::.check_lower.tail(1), "must be a logical") + +}) + + +test_that(".check_x works", { + + expect_null(BayesTools:::.check_x(0.5)) + expect_null(BayesTools:::.check_x(c(0, 0.5, 1))) + expect_null(BayesTools:::.check_x(0.5, lower = 0, upper = 1)) + + expect_error(BayesTools:::.check_x(-1, lower = 0), "must be equal or higher than 0") + expect_error(BayesTools:::.check_x(2, upper = 1), "must be equal or lower than 1") + expect_error(BayesTools:::.check_x("a"), "must be a numeric") + +}) + + +test_that(".check_n works", { + + expect_null(BayesTools:::.check_n(1)) + expect_null(BayesTools:::.check_n(100)) + + expect_error(BayesTools:::.check_n(0), "must be equal or higher than 1") + expect_error(BayesTools:::.check_n(-1), "must be equal or higher than 1") + expect_error(BayesTools:::.check_n(c(1, 2)), "must have length '1'") + expect_error(BayesTools:::.check_n("a"), "must be a numeric") + +}) + + +test_that(".check_q works", { + + expect_null(BayesTools:::.check_q(0.5)) + expect_null(BayesTools:::.check_q(c(-1, 0, 1))) + expect_null(BayesTools:::.check_q(0.5, lower = 0, upper = 1)) + + expect_error(BayesTools:::.check_q(-1, lower = 0), "must be equal or higher than 0") + expect_error(BayesTools:::.check_q(2, upper = 1), "must be equal or lower than 1") + expect_error(BayesTools:::.check_q("a"), "must be a numeric") + +}) + + +test_that(".check_p works", { + + # Standard probability checks (log.p = FALSE) + expect_null(BayesTools:::.check_p(0.5, FALSE)) + expect_null(BayesTools:::.check_p(c(0, 0.5, 1), FALSE)) + + expect_error(BayesTools:::.check_p(-0.1, FALSE), "must be equal or higher than 0") + expect_error(BayesTools:::.check_p(1.1, FALSE), "must be equal or lower than 1") + expect_error(BayesTools:::.check_p("a", FALSE), "must be a numeric") + + # Log probability checks (log.p = TRUE) + expect_null(BayesTools:::.check_p(-1, TRUE)) + expect_null(BayesTools:::.check_p(c(-2, -1, 0), TRUE)) + + expect_error(BayesTools:::.check_p(0.1, TRUE), "must be equal or lower than 0") + expect_error(BayesTools:::.check_p("a", TRUE), "must be a numeric") + +}) diff --git a/tests/testthat/test-interpret.R b/tests/testthat/test-interpret.R new file mode 100644 index 0000000..6f6893f --- /dev/null +++ b/tests/testthat/test-interpret.R @@ -0,0 +1,219 @@ +context("Interpret functions") + +REFERENCE_DIR <<- testthat::test_path("..", "results", "interpret") +source(testthat::test_path("common-functions.R")) + + +test_that("interpret2 function works", { + + set.seed(1) + + # Test basic interpret2 with all fields + info1 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF10", + inference_BF = 3.5, + estimate_name = "mu", + estimate_samples = rnorm(1000, 0.3, 0.15), + estimate_units = "kg", + estimate_conditional = FALSE + ) + ) + + result1 <- interpret2(info1, "RoBMA") + test_reference_text(result1, "interpret2_basic.txt") + expect_match(result1, "RoBMA found moderate evidence in favor of the Effect") + expect_match(result1, "BF10 = 3.50") + expect_match(result1, "model-averaged") + expect_match(result1, "kg") + + # Test with conditional = TRUE + info2 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF10", + inference_BF = 15, + estimate_name = "mu", + estimate_samples = rnorm(1000, 0.5, 0.1), + estimate_units = NULL, + estimate_conditional = TRUE + ) + ) + + result2 <- interpret2(info2, "Test") + test_reference_text(result2, "interpret2_conditional.txt") + expect_match(result2, "strong evidence in favor") + expect_match(result2, "conditional") + expect_false(grepl("model-averaged", result2)) + + # Test evidence against (BF < 1) + info3 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF01", + inference_BF = 0.1, + estimate_name = "mu", + estimate_samples = rnorm(1000, 0, 0.05), + estimate_units = NULL, + estimate_conditional = NULL + ) + ) + + result3 <- interpret2(info3, "Method") + test_reference_text(result3, "interpret2_evidence_against.txt") + expect_match(result3, "moderate evidence against the Effect") + expect_match(result3, "BF01 = 0.100") + + # Test weak evidence + info4 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF", + inference_BF = 1.5, + estimate_name = "delta", + estimate_samples = rnorm(1000, 0.1, 0.1), + estimate_units = NULL, + estimate_conditional = FALSE + ) + ) + + result4 <- interpret2(info4, "Test") + test_reference_text(result4, "interpret2_weak_evidence.txt") + expect_match(result4, "weak evidence in favor") + + # Test without estimate samples (inference only) + info5 <- list( + list( + inference_name = "Bias", + inference_BF_name = "BF_pb", + inference_BF = 5 + ) + ) + + result5 <- interpret2(info5, "RoBMA") + test_reference_text(result5, "interpret2_inference_only.txt") + expect_match(result5, "RoBMA found moderate evidence in favor of the Bias") + expect_match(result5, "BF_pb = 5.00") + expect_false(grepl("estimate", result5)) + + # Test multiple specifications + info6 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF10", + inference_BF = 10, + estimate_name = "mu", + estimate_samples = rnorm(1000, 0.3, 0.1), + estimate_units = NULL, + estimate_conditional = FALSE + ), + list( + inference_name = "Bias", + inference_BF_name = "BF_pb", + inference_BF = 0.5 + ) + ) + + result6 <- interpret2(info6, "Test") + test_reference_text(result6, "interpret2_multiple.txt") + expect_match(result6, "Effect") + expect_match(result6, "Bias") + + # Test without method + info7 <- list( + list( + inference_name = "Effect", + inference_BF_name = "BF", + inference_BF = 2 + ) + ) + + result7 <- interpret2(info7, NULL) + test_reference_text(result7, "interpret2_no_method.txt") + expect_match(result7, "found weak evidence") + +}) + + +test_that(".interpret.BF helper function works", { + + # Strong evidence in favor (BF > 10) + result_strong_favor <- BayesTools:::.interpret.BF(15, "effect", "BF10") + test_reference_text(result_strong_favor, "interpret_BF_strong_favor.txt") + expect_match(result_strong_favor, "strong evidence in favor of the effect") + expect_match(result_strong_favor, "BF10 = 15.00") + + # Moderate evidence in favor (3 < BF < 10) + result_moderate_favor <- BayesTools:::.interpret.BF(5, "effect", NULL) + test_reference_text(result_moderate_favor, "interpret_BF_moderate_favor.txt") + expect_match(result_moderate_favor, "moderate evidence in favor") + expect_match(result_moderate_favor, "BF = 5.00") + + # Weak evidence in favor (1 < BF < 3) + result_weak_favor <- BayesTools:::.interpret.BF(1.5, "effect", "BF") + test_reference_text(result_weak_favor, "interpret_BF_weak_favor.txt") + expect_match(result_weak_favor, "weak evidence in favor") + + # Strong evidence against (BF < 0.1) + result_strong_against <- BayesTools:::.interpret.BF(0.05, "effect", "BF01") + test_reference_text(result_strong_against, "interpret_BF_strong_against.txt") + expect_match(result_strong_against, "strong evidence against the effect") + expect_match(result_strong_against, "BF01 = 0.050") + + # Moderate evidence against (0.1 <= BF < 1/3) + result_moderate_against1 <- BayesTools:::.interpret.BF(0.1, "effect", NULL) + test_reference_text(result_moderate_against1, "interpret_BF_moderate_against1.txt") + expect_match(result_moderate_against1, "moderate evidence against") + + result_moderate_against2 <- BayesTools:::.interpret.BF(0.2, "effect", NULL) + test_reference_text(result_moderate_against2, "interpret_BF_moderate_against2.txt") + expect_match(result_moderate_against2, "moderate evidence against") + + # Weak evidence against (1/3 < BF < 1) + result_weak_against <- BayesTools:::.interpret.BF(0.5, "effect", NULL) + test_reference_text(result_weak_against, "interpret_BF_weak_against.txt") + expect_match(result_weak_against, "weak evidence against") + +}) + + +test_that(".interpret.par helper function works", { + + set.seed(42) + samples <- rnorm(10000, 0.5, 0.1) + + # Test model-averaged (conditional = FALSE) + result1 <- BayesTools:::.interpret.par(samples, "mu", NULL, FALSE) + test_reference_text(result1, "interpret_par_model_averaged.txt") + expect_match(result1, "model-averaged estimate mu") + expect_match(result1, "95% CI") + + # Test model-averaged (conditional = NULL) + result2 <- BayesTools:::.interpret.par(samples, "delta", NULL, NULL) + test_reference_text(result2, "interpret_par_model_averaged_null.txt") + expect_match(result2, "model-averaged") + + # Test conditional + result3 <- BayesTools:::.interpret.par(samples, "mu", NULL, TRUE) + test_reference_text(result3, "interpret_par_conditional.txt") + expect_match(result3, "conditional estimate mu") + expect_false(grepl("model-averaged", result3)) + + # Test with units + result4 <- BayesTools:::.interpret.par(samples, "weight", "kg", FALSE) + test_reference_text(result4, "interpret_par_with_units.txt") + expect_match(result4, "kg") + +}) + + +test_that("interpret function input validation works", { + + # Test specification validation + expect_error(interpret(list(), list(), "not a list", "Test")) + + # Test invalid specification elements + expect_error(interpret(list(), list(), list(list(inference = 1)), "Test")) + +}) diff --git a/tests/testthat/test-model-averaging-edge-cases.R b/tests/testthat/test-model-averaging-edge-cases.R new file mode 100644 index 0000000..7f5371b --- /dev/null +++ b/tests/testthat/test-model-averaging-edge-cases.R @@ -0,0 +1,385 @@ +context("Model averaging edge cases and comprehensive tests") + +# Reference directory for text output comparisons +REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-edge-cases") + +source(testthat::test_path("common-functions.R")) + +# ============================================================================ # +# SECTION 1: mix_posteriors edge cases +# ============================================================================ # +test_that("mix_posteriors handles various prior types correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + # Create model list for simple priors + models_simple <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) + ) + + # Test mix_posteriors with simple priors + mixed <- mix_posteriors( + model_list = models_simple, + parameters = c("m", "s"), + is_null_list = list("m" = c(FALSE, TRUE), "s" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed, "mixed_posteriors")) + # Capture a summary of the mixed posteriors structure for reference + mixed_info <- paste0( + "Class: ", paste(class(mixed), collapse = ", "), "\n", + "Parameters: ", paste(names(mixed), collapse = ", "), "\n", + "Sample size m: ", length(mixed$m), "\n", + "Sample size s: ", length(mixed$s) + ) + test_reference_text(mixed_info, "mix_posteriors_simple_info.txt") + expect_equal(length(mixed$m), 1000) + expect_equal(length(mixed$s), 1000) + + # Test with conditional = TRUE + mixed_conditional <- mix_posteriors( + model_list = models_simple, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, TRUE)), + conditional = TRUE, + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_conditional, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles weightfunction priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load summary models which have weightfunction priors + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) + marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + + models_wf <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1), + list(fit = fit_summary2, marglik = marglik_summary2, prior_weights = 1) + ) + + mixed_wf <- mix_posteriors( + model_list = models_wf, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE, FALSE), "omega" = c(TRUE, FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_wf, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles factor priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load the orthonormal factor models (have both factor priors and marginal likelihoods) + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + # Create model list with two different models + models_factor <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) + ) + + # Get the parameters from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + param_names <- names(prior_list) + + # Filter to factor parameters only + factor_params <- param_names[sapply(prior_list, is.prior.factor)] + + + mixed_factor <- mix_posteriors( + model_list = models_factor, + parameters = factor_params[1], # Just test one + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params[1]), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_factor, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles vector priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + + + # Load vector prior models + fit_vector_mnormal <- readRDS(file.path(temp_fits_dir, "fit_vector_mnormal.RDS")) + + # Create a mock marglik for testing (we only need the structure) + mock_marglik <- structure( + list(logml = -100, niter = 1000, method = "warp3"), + class = "bridge" + ) + + models_vector <- list( + list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1), + list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1) + ) + + prior_list <- attr(fit_vector_mnormal, "prior_list") + vector_params <- names(prior_list)[sapply(prior_list, is.prior.vector)] + + mixed_vector <- mix_posteriors( + model_list = models_vector, + parameters = vector_params[1], + is_null_list = setNames(list(c(FALSE, FALSE)), vector_params[1]), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_vector, "mixed_posteriors")) + +}) + + +# ============================================================================ # +# SECTION 2: ensemble_inference edge cases +# ============================================================================ # +test_that("ensemble_inference handles different configurations", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) + ) + + # Test with integer is_null specification + inference_int <- ensemble_inference( + model_list = models, + parameters = "m", + is_null_list = list("m" = 2) # Second model is null + ) + + expect_true(inherits(inference_int$m, "inference")) + inference_int_info <- paste0( + "BF: ", round(inference_int$m$BF, 4), "\n", + "is_null: ", paste(attr(inference_int$m, "is_null"), collapse = ", "), "\n", + "prior_probs: ", paste(round(inference_int$m$prior_probs, 4), collapse = ", "), "\n", + "post_probs: ", paste(round(inference_int$m$post_probs, 4), collapse = ", ") + ) + test_reference_text(inference_int_info, "ensemble_inference_int_spec.txt") + + # Test conditional inference + inference_cond <- ensemble_inference( + model_list = models, + parameters = "m", + is_null_list = list("m" = c(FALSE, TRUE)), + conditional = TRUE + ) + + expect_true(attr(inference_cond, "conditional")) + inference_cond_info <- paste0( + "Conditional: ", attr(inference_cond, "conditional"), "\n", + "BF: ", round(inference_cond$m$BF, 4) + ) + test_reference_text(inference_cond_info, "ensemble_inference_conditional.txt") + +}) + + +test_that("models_inference computes correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 2) + ) + + models_with_inference <- models_inference(models) + + # Check that inference was added to each model + expect_true("inference" %in% names(models_with_inference[[1]])) + expect_true("inference" %in% names(models_with_inference[[2]])) + + # Create reference output for models_inference structure + models_inf_info <- paste0( + "Model 1 inference:\n", + " m_number: ", models_with_inference[[1]]$inference$m_number, "\n", + " prior_prob: ", round(models_with_inference[[1]]$inference$prior_prob, 6), "\n", + " post_prob: ", round(models_with_inference[[1]]$inference$post_prob, 6), "\n", + "Model 2 inference:\n", + " m_number: ", models_with_inference[[2]]$inference$m_number, "\n", + " prior_prob: ", round(models_with_inference[[2]]$inference$prior_prob, 6), "\n", + " post_prob: ", round(models_with_inference[[2]]$inference$post_prob, 6), "\n", + "Total post_prob: ", round(sum(sapply(models_with_inference, function(m) m$inference$post_prob)), 6) + ) + test_reference_text(models_inf_info, "models_inference_output.txt") + + # Check prior probs reflect weights (1:2 ratio) + expect_equal(models_with_inference[[1]]$inference$prior_prob, 1/3, tolerance = 1e-10) + expect_equal(models_with_inference[[2]]$inference$prior_prob, 2/3, tolerance = 1e-10) + + # Check posterior probs sum to 1 + total_post_prob <- sum(sapply(models_with_inference, function(m) m$inference$post_prob)) + expect_equal(total_post_prob, 1, tolerance = 1e-10) + +}) + + +# ============================================================================ # +# SECTION 3: as_mixed_posteriors and as_marginal_inference +# ============================================================================ # +test_that("as_mixed_posteriors works correctly with BayesTools_fit objects", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # Load a fitted model + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # as_mixed_posteriors needs a BayesTools_fit object + mixed <- as_mixed_posteriors(fit_simple_normal, parameters = c("m", "s")) + + expect_true(inherits(mixed, "mixed_posteriors")) +}) + + +test_that("as_marginal_inference works correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + + # as_marginal_inference requires a BayesTools_fit object - load one + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Get parameter names from the fitted model + prior_list <- attr(fit_simple_normal, "prior_list") + params <- names(prior_list) + + # Test basic as_marginal_inference call + # This requires the model to have spike_and_slab or mixture priors + # For now, just test that it errors correctly with non-matching parameters + expect_error( + as_marginal_inference(fit_simple_normal, marginal_parameters = "nonexistent"), + regexp = NULL # Any error is expected + ) + +}) + + +# ============================================================================ # +# SECTION 4: Inclusion BF edge cases +# ============================================================================ # +test_that("inclusion_BF handles edge cases", { + + # All null models - should return 0 + prior_probs <- c(0.5, 0.5) + post_probs <- c(0.5, 0.5) + is_null <- c(TRUE, TRUE) + + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, 0) + + # All alternative models - should return Inf + is_null <- c(FALSE, FALSE) + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, Inf) + + # Single model + prior_probs <- 1 + post_probs <- 1 + is_null <- FALSE + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, Inf) + + # Test with marginal likelihoods only + prior_probs <- c(0.5, 0.5) + margliks <- c(-10, -10) # Equal margliks + is_null <- c(TRUE, FALSE) + BF <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) + expect_equal(BF, 1) +}) + + +# ============================================================================ # +# SECTION 5: weightfunctions_mapping edge cases +# ============================================================================ # +test_that("weightfunctions_mapping handles various configurations", { + + # Create one-sided weightfunction prior + wf_onesided <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + + # Create two-sided weightfunction prior + wf_twosided <- prior_weightfunction("two.sided", list(c(0.05), c(1, 1))) + + # Test with one-sided prior list + mapping <- weightfunctions_mapping(list(wf_onesided)) + mapping_info <- paste0( + "One-sided mapping:\n", + " Length: ", length(mapping), "\n", + " Is list: ", is.list(mapping) + ) + + # Test with two-sided prior list + mapping_two <- weightfunctions_mapping(list(wf_twosided)) + + # Test with one_sided = TRUE + mapping_one <- weightfunctions_mapping(list(wf_twosided), one_sided = TRUE) + + # Test cuts_only = TRUE + cuts <- weightfunctions_mapping(list(wf_onesided), cuts_only = TRUE) + + wf_mapping_info <- paste0( + "One-sided mapping length: ", length(mapping), "\n", + "Two-sided mapping length: ", length(mapping_two), "\n", + "Two-sided with one_sided=TRUE length: ", length(mapping_one), "\n", + "Cuts: ", paste(cuts, collapse = ", ") + ) + test_reference_text(wf_mapping_info, "weightfunctions_mapping_info.txt") + +}) + diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R new file mode 100644 index 0000000..eb3029c --- /dev/null +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -0,0 +1,350 @@ +context("Model averaging plots edge cases") + +# Reference directory for text output comparisons (if needed) +REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-plots-edge-cases") + +source(testthat::test_path("common-functions.R")) + + +# ============================================================================ # +# SECTION 1: plot_prior_list input validation and edge cases +# ============================================================================ # +test_that("plot_prior_list handles input validation correctly", { + set.seed(1) + # Test error for non-list input + expect_error( + plot_prior_list(prior("normal", list(0, 1))), + "must be a list of priors" + ) + + # Test error for PET-PEESE without prior_list_mu + pet_list <- list( + p1 = prior_PET("normal", list(0, 1)) + ) + expect_error( + plot_prior_list(pet_list), + "prior_list_mu" + ) + + # Test error for providing prior_list_mu when not needed + simple_list <- list( + p1 = prior("normal", list(0, 1)) + ) + expect_error( + plot_prior_list(simple_list, prior_list_mu = list(prior("spike", list(0)))), + "prior_list_mu" + ) + +}) + + +test_that("plot_prior_list handles orthonormal priors", { + set.seed(1) + # Create orthonormal factor prior + prior_orth <- prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + attr(prior_orth, "levels") <- 3 + + prior_list <- list(p1 = prior_orth) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-base", function() { + plot_prior_list(prior_list) + }) + + # ggplot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + +}) + + +test_that("plot_prior_list handles meandif priors", { + set.seed(1) + # Create meandif factor prior + prior_md <- prior_factor("mnorm", list(mean = 0, sd = 0.5), contrast = "meandif") + attr(prior_md, "levels") <- 3 + + prior_list <- list(p1 = prior_md) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-meandif-base", function() { + plot_prior_list(prior_list) + }) + + # ggplot + vdiffr::expect_doppelganger("plot-prior-list-meandif-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + +}) + + +# ============================================================================ # +# SECTION 2: lines_prior_list edge cases +# ============================================================================ # +test_that("lines_prior_list handles various configurations", { + set.seed(1) + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(0, 2)) + ) + + # Test adding lines to existing plot + vdiffr::expect_doppelganger("lines-prior-list-add", function() { + plot(NULL, xlim = c(-5, 5), ylim = c(0, 0.5), xlab = "", ylab = "") + lines_prior_list(prior_list, col = "red", lwd = 2) + }) + + # Test with custom xlim + vdiffr::expect_doppelganger("lines-prior-list-xlim", function() { + plot(NULL, xlim = c(-3, 3), ylim = c(0, 0.5), xlab = "", ylab = "") + lines_prior_list(prior_list, xlim = c(-3, 3), col = "blue") + }) + +}) + + +# ============================================================================ # +# SECTION 3: geom_prior_list edge cases +# ============================================================================ # +test_that("geom_prior_list handles various configurations", { + set.seed(1) + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("spike", list(0.5)) + ) + + # Test adding to ggplot + vdiffr::expect_doppelganger("geom-prior-list-add", { + ggplot2::ggplot() + + ggplot2::xlim(-4, 4) + + ggplot2::ylim(0, 1) + + geom_prior_list(prior_list, col = "red") + }) + +}) + + +# ============================================================================ # +# SECTION 4: plot_posterior edge cases +# ============================================================================ # +test_that("plot_posterior handles various sample types", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test simple posterior plot + vdiffr::expect_doppelganger("plot-posterior-simple", function() { + plot_posterior(mixed_posteriors, "m") + }) + + # Test with prior overlay + vdiffr::expect_doppelganger("plot-posterior-with-prior", function() { + plot_posterior(mixed_posteriors, "m", prior = TRUE) + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-posterior-ggplot", { + plot_posterior(mixed_posteriors, "m", plot_type = "ggplot") + }) + + # Test with custom xlim + vdiffr::expect_doppelganger("plot-posterior-xlim", function() { + plot_posterior(mixed_posteriors, "m", xlim = c(-2, 2)) + }) + +}) + + +test_that("plot_posterior handles weightfunction posteriors", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test weightfunction posterior plot + vdiffr::expect_doppelganger("plot-posterior-omega", function() { + plot_posterior(mixed_posteriors, "omega", n_points = 50, n_samples = 500) + }) + +}) + + +# ============================================================================ # +# SECTION 5: plot_models edge cases +# ============================================================================ # +test_that("plot_models handles various configurations", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + + # Skip if summary fits don't exist + if (!file.exists(file.path(temp_fits_dir, "fit_summary0.RDS"))) { + skip("Summary fits not found") + } + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) + ) + models <- models_inference(models) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test basic plot_models + vdiffr::expect_doppelganger("plot-models-basic", function() { + plot_models(models, mixed_posteriors, inference, "m") + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-models-ggplot", { + plot_models(models, mixed_posteriors, inference, "m", plot_type = "ggplot") + }) + +}) + + +# ============================================================================ # +# SECTION 6: scale_y2 handling for mixed priors +# ============================================================================ # +test_that("scale_y2 is handled correctly for mixed distributions", { + set.seed(1) + # Create a list with both continuous and point priors + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("spike", list(0)) + ) + + # Base plot should handle dual y-axis + vdiffr::expect_doppelganger("plot-prior-list-dual-axis", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_prior_list(prior_list) + }) + + # ggplot should handle it differently + vdiffr::expect_doppelganger("plot-prior-list-dual-axis-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + +}) + + +# ============================================================================ # +# SECTION 7: Simple prior list plotting +# ============================================================================ # +test_that("plot_prior_list handles simple cases", { + set.seed(1) + # Test with a single normal prior + prior_list_normal <- list( + p1 = prior("normal", list(0, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-single-normal", function() { + plot_prior_list(prior_list_normal) + }) + + # Test with multiple priors + prior_list_multi <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(1, 0.5)), + p3 = prior("cauchy", list(0, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-multi", function() { + plot_prior_list(prior_list_multi) + }) + + # Test with gamma prior + prior_list_gamma <- list( + p1 = prior("gamma", list(2, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-gamma", function() { + plot_prior_list(prior_list_gamma) + }) + +}) + + +# ============================================================================ # +# SECTION 8: Weightfunction prior plotting +# ============================================================================ # +test_that("plot_prior_list handles weightfunction priors", { + set.seed(1) + # Create one-sided weightfunction prior + wf_prior <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + + prior_list_wf <- list(p1 = wf_prior) + + vdiffr::expect_doppelganger("plot-prior-list-weightfunction", function() { + plot_prior_list(prior_list_wf) + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-prior-list-weightfunction-ggplot", { + plot_prior_list(prior_list_wf, plot_type = "ggplot") + }) + +}) + diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R new file mode 100644 index 0000000..cc6c9a2 --- /dev/null +++ b/tests/testthat/test-model-averaging.R @@ -0,0 +1,174 @@ +context("Model averaging functions") + + +test_that("compute_inference works correctly", { + + skip_if_not_installed("bridgesampling") + + # Test basic inference computation + prior_weights <- c(1, 1) + margliks <- c(-10, -11) + + result <- compute_inference(prior_weights, margliks) + + expect_equal(length(result$prior_probs), 2) + expect_equal(sum(result$prior_probs), 1) + expect_equal(length(result$post_probs), 2) + expect_true(sum(result$post_probs) > 0.99) # Should be close to 1 + expect_true(is.numeric(result$BF)) + + # Test with is_null as logical vector + result2 <- compute_inference(prior_weights, margliks, is_null = c(TRUE, FALSE)) + expect_true(is.numeric(result2$BF)) + expect_true(attr(result2, "is_null")[1]) + expect_false(attr(result2, "is_null")[2]) + + # Test with is_null as integer vector + result3 <- compute_inference(prior_weights, margliks, is_null = 1) + expect_true(attr(result3, "is_null")[1]) + expect_false(attr(result3, "is_null")[2]) + + # Test conditional inference + result4 <- compute_inference(prior_weights, margliks, is_null = c(TRUE, FALSE), conditional = TRUE) + expect_equal(result4$prior_probs[1], 0) # Null model should have 0 prior prob in conditional + expect_equal(result4$prior_probs[2], 1) # Alternative should have all weight + expect_true(attr(result4, "conditional")) + + # Test with unequal prior weights + result5 <- compute_inference(c(1, 3), margliks) + expect_equal(result5$prior_probs[1], 0.25) + expect_equal(result5$prior_probs[2], 0.75) + +}) + + +test_that("compute_inference input validation works", { + + skip_if_not_installed("bridgesampling") + + # Wrong is_null type + expect_error( + compute_inference(c(1, 1), c(-10, -11), is_null = "TRUE"), + "must be either logical vector, integer vector, or NULL" + ) + + # is_null wrong length + expect_error( + compute_inference(c(1, 1), c(-10, -11), is_null = c(TRUE, FALSE, TRUE)), + "must have length" + ) + + # mismatched lengths + expect_error( + compute_inference(c(1, 1, 1), c(-10, -11)), + "must have length" + ) + +}) + + +test_that("inclusion_BF works correctly", { + + # Test with posterior probabilities + prior_probs <- c(0.5, 0.5) + post_probs <- c(0.8, 0.2) + is_null <- c(TRUE, FALSE) + + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_true(is.numeric(BF)) + # With equal prior, BF should be 0.2/0.8 = 0.25 (for alternative vs null) + expect_equal(BF, 0.25) + + # Test with marginal likelihoods + margliks <- c(-10, -10) # Equal margliks + BF2 <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) + expect_equal(BF2, 1) # Should be 1 with equal margliks and equal priors + + # Test with integer is_null + BF3 <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = 1) + expect_equal(BF3, BF) + + # Test all null scenario + BF_all_null <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = c(TRUE, TRUE)) + expect_equal(BF_all_null, 0) + + # Test all alternative scenario + BF_all_alt <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = c(FALSE, FALSE)) + expect_equal(BF_all_alt, Inf) + +}) + + +test_that("inclusion_BF input validation works", { + + # Wrong is_null type + expect_error( + inclusion_BF(prior_probs = c(0.5, 0.5), post_probs = c(0.8, 0.2), is_null = "TRUE"), + "must be either logical vector, integer vector, or NULL" + ) + + # Missing arguments + expect_error( + inclusion_BF(prior_probs = c(0.5, 0.5), is_null = c(TRUE, FALSE)), + "'prior_probs' and either 'post_probs' or 'marglik' must be specified" + ) + +}) + + +test_that(".inclusion_BF.probs edge cases work", { + + # Test when posterior is fully concentrated on alternative + prior_probs <- c(0.5, 0.5) + post_probs <- c(0, 1) + is_null <- c(TRUE, FALSE) + + BF <- BayesTools:::.inclusion_BF.probs(prior_probs, post_probs, is_null) + expect_equal(BF, Inf) + + # Test when posterior is fully concentrated on null + post_probs2 <- c(1, 0) + BF2 <- BayesTools:::.inclusion_BF.probs(prior_probs, post_probs2, is_null) + expect_equal(BF2, 0) + +}) + + +test_that("weightfunctions_mapping works correctly", { + + # Create weightfunction priors + wf_onesided <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + wf_twosided <- prior_weightfunction("two.sided", list(c(0.05), c(1, 1))) + + # Test with single weightfunction + mapping1 <- weightfunctions_mapping(list(wf_onesided)) + expect_true(is.list(mapping1)) + + # Test with cuts_only = TRUE + cuts <- weightfunctions_mapping(list(wf_onesided), cuts_only = TRUE) + expect_true(is.numeric(cuts)) + expect_true(0 %in% cuts) + expect_true(1 %in% cuts) + + # Test with one_sided = TRUE + mapping2 <- weightfunctions_mapping(list(wf_twosided), one_sided = TRUE) + expect_true(is.list(mapping2)) + + # Test with point prior (should be handled gracefully) + p_point <- prior("point", list(1)) + mapping3 <- weightfunctions_mapping(list(wf_onesided, p_point)) + expect_true(is.list(mapping3)) + +}) + + +test_that("weightfunctions_mapping input validation works", { + + # Non-weightfunction priors should fail + p_normal <- prior("normal", list(0, 1)) + expect_error( + weightfunctions_mapping(list(p_normal)), + "must be a list of weightfunction priors" + ) + +}) diff --git a/tests/testthat/test-priors-print.R b/tests/testthat/test-priors-print.R index 33bbd1a..5f9f120 100644 --- a/tests/testthat/test-priors-print.R +++ b/tests/testthat/test-priors-print.R @@ -1,6 +1,21 @@ context("Prior print function") +test_that("Prior print function input validation", { + + p <- prior("normal", list(0, 1)) + + # Check invalid inputs + expect_error(print(p, short_name = "no"), "'short_name'") + expect_error(print(p, parameter_names = "no"), "'parameter_names'") + expect_error(print(p, digits_estimates = "two"), "'digits_estimates'") + expect_error(print(p, plot = "yes"), "'plot'") + expect_error(print(p, silent = "shh"), "'silent'") + expect_error(print(p, inline = "no"), "'inline'") + +}) + + test_that("Prior print function works", { # check the default options @@ -175,3 +190,78 @@ test_that("Prior print function works", { text(0.5, 1, print(pe1, plot = TRUE)) }) }) + + +test_that("Prior print for prior_none", { + + p_none <- prior_none() + output <- utils::capture.output(print(p_none)) + expect_type(output, "character") + + # Silent output + expect_equal(utils::capture.output(print(p_none, silent = TRUE)), character()) + +}) + + +test_that("Prior print with inline option for mixtures", { + + p_mix <- prior_mixture( + list( + prior("normal", list(0, 1)), + prior("normal", list(0, 2)) + ) + ) + + # Test inline option + output_inline <- print(p_mix, silent = TRUE, inline = TRUE) + expect_type(output_inline, "character") + +}) + + +test_that("Prior print for additional distributions", { + + # Beta distribution with different parameters + p_beta <- prior("beta", list(alpha = 2, beta = 5)) + expect_equal(utils::capture.output(print(p_beta)), "Beta(2, 5)") + expect_equal(utils::capture.output(print(p_beta, short_name = TRUE)), "B(2, 5)") + + # Exponential distribution + p_exp <- prior("exp", list(rate = 2)) + expect_equal(utils::capture.output(print(p_exp)), "Exponential(2)") + expect_equal(utils::capture.output(print(p_exp, short_name = TRUE)), "E(2)") + + # Uniform distribution + p_unif <- prior("uniform", list(a = -1, b = 1)) + expect_equal(utils::capture.output(print(p_unif)), "Uniform(-1, 1)") + expect_equal(utils::capture.output(print(p_unif, short_name = TRUE)), "U(-1, 1)") + + # Lognormal distribution + p_ln <- prior("lognormal", list(meanlog = 0, sdlog = 1)) + expect_equal(utils::capture.output(print(p_ln)), "Lognormal(0, 1)") + expect_equal(utils::capture.output(print(p_ln, short_name = TRUE)), "Ln(0, 1)") + + # Inverse gamma distribution + p_ig <- prior("invgamma", list(shape = 1, scale = 1)) + expect_equal(utils::capture.output(print(p_ig)), "InvGamma(1, 1)") + expect_equal(utils::capture.output(print(p_ig, short_name = TRUE)), "Ig(1, 1)") + +}) + + +test_that("Prior print digits_estimates parameter", { + + p <- prior("normal", list(mean = 1.2345678, sd = 0.9876543)) + + # Default (2 digits) + expect_match(utils::capture.output(print(p)), "Normal\\(1\\.23, 0\\.99\\)") + + # 4 digits + expect_match(utils::capture.output(print(p, digits_estimates = 4)), "Normal\\(1\\.2346, 0\\.9877\\)") + + # 0 digits + expect_match(utils::capture.output(print(p, digits_estimates = 0)), "Normal\\(1, 1\\)") + +}) + diff --git a/tests/testthat/test-priors-tools.R b/tests/testthat/test-priors-tools.R index 601d364..ffb0e2b 100644 --- a/tests/testthat/test-priors-tools.R +++ b/tests/testthat/test-priors-tools.R @@ -43,3 +43,306 @@ test_that("Prior handling works", { expect_error(prior_weightfunction("one-sided", list(c(.05, 0.55, .40), c(1, 1), c(1, 1))), "Parameters 'steps' must be monotonically increasing.") }) + + +test_that("is.prior functions work correctly", { + + # Create priors for testing + p_normal <- prior("normal", list(0, 1)) + p_point <- prior("point", list(0)) + p_discrete <- prior("bernoulli", list(0.5)) + p_vector <- prior("mnormal", list(0, 1, 3)) + p_pet <- prior_PET("normal", list(0, 1)) + p_peese <- prior_PEESE("normal", list(0, 1)) + p_wf <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + p_factor_t <- prior_factor("normal", contrast = "treatment", list(0, 1)) + p_factor_o <- prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + p_factor_m <- prior_factor("mnormal", contrast = "meandif", list(0, 1)) + p_factor_i <- prior_factor("beta", contrast = "independent", list(1, 1)) + p_spike_slab <- prior_spike_and_slab(prior("normal", list(0, 1)), prior_inclusion = prior("spike", list(0.5))) + p_none <- prior_none() + + # Test is.prior + expect_true(is.prior(p_normal)) + expect_true(is.prior(p_point)) + expect_false(is.prior("not a prior")) + expect_false(is.prior(list(a = 1))) + + # Test is.prior.simple + expect_true(is.prior.simple(p_normal)) + expect_true(is.prior.simple(p_point)) + expect_false(is.prior.simple(p_wf)) + expect_false(is.prior.simple(p_vector)) + + # Test is.prior.point + expect_true(is.prior.point(p_point)) + expect_false(is.prior.point(p_normal)) + + # Test is.prior.none + expect_true(is.prior.none(p_none)) + expect_false(is.prior.none(p_normal)) + + # Test is.prior.discrete + expect_true(is.prior.discrete(p_discrete)) + expect_false(is.prior.discrete(p_normal)) + + # Test is.prior.vector + expect_true(is.prior.vector(p_vector)) + expect_false(is.prior.vector(p_normal)) + + # Test is.prior.PET + expect_true(is.prior.PET(p_pet)) + expect_false(is.prior.PET(p_normal)) + + # Test is.prior.PEESE + expect_true(is.prior.PEESE(p_peese)) + expect_false(is.prior.PEESE(p_normal)) + + # Test is.prior.weightfunction + expect_true(is.prior.weightfunction(p_wf)) + expect_false(is.prior.weightfunction(p_normal)) + + # Test is.prior.factor + expect_true(is.prior.factor(p_factor_t)) + expect_true(is.prior.factor(p_factor_o)) + expect_true(is.prior.factor(p_factor_m)) + expect_true(is.prior.factor(p_factor_i)) + expect_false(is.prior.factor(p_normal)) + + # Test is.prior.treatment + expect_true(is.prior.treatment(p_factor_t)) + expect_false(is.prior.treatment(p_factor_o)) + + # Test is.prior.orthonormal + expect_true(is.prior.orthonormal(p_factor_o)) + expect_false(is.prior.orthonormal(p_factor_t)) + + # Test is.prior.meandif + expect_true(is.prior.meandif(p_factor_m)) + expect_false(is.prior.meandif(p_factor_o)) + + # Test is.prior.independent + expect_true(is.prior.independent(p_factor_i)) + expect_false(is.prior.independent(p_factor_t)) + + # Test is.prior.spike_and_slab + expect_true(is.prior.spike_and_slab(p_spike_slab)) + expect_false(is.prior.spike_and_slab(p_normal)) + +}) + + +test_that(".check_prior works correctly", { + + p_normal <- prior("normal", list(0, 1)) + + # Valid prior should pass + expect_null(BayesTools:::.check_prior(p_normal)) + + # Non-prior should fail + expect_error(BayesTools:::.check_prior("not a prior"), "must be a valid prior object") + expect_error(BayesTools:::.check_prior(list(a = 1)), "must be a valid prior object") + +}) + + +test_that(".check_prior_list works correctly", { + + p_normal <- prior("normal", list(0, 1)) + p_point <- prior("point", list(0)) + p_wf <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + + # Valid prior list should pass + expect_null(BayesTools:::.check_prior_list(list(p_normal, p_point))) + + # Empty list with allow_NULL + expect_null(BayesTools:::.check_prior_list(NULL, allow_NULL = TRUE)) + expect_null(BayesTools:::.check_prior_list(list(), allow_NULL = TRUE)) + + # Non-list should fail + expect_error(BayesTools:::.check_prior_list("not a list"), "must be a list") + + # List with non-prior should fail + expect_error(BayesTools:::.check_prior_list(list("not a prior")), "must be a prior distribution") + + # Disallowing specific types + expect_error( + BayesTools:::.check_prior_list(list(p_point), allow_prior.point = FALSE), + "must not contain point priors" + ) + expect_error( + BayesTools:::.check_prior_list(list(p_wf), allow_prior.weightfunction = FALSE), + "must not contain weightfunction priors" + ) + +}) + + +test_that(".check_and_name_parameters works correctly", { + + # Valid parameters + params <- list(0, 1) + result <- BayesTools:::.check_and_name_parameters(params, c("mean", "sd"), "normal") + expect_equal(names(result), c("mean", "sd")) + + # Named parameters in different order + params2 <- list(sd = 1, mean = 0) + result2 <- BayesTools:::.check_and_name_parameters(params2, c("mean", "sd"), "normal") + expect_equal(result2$mean, 0) + expect_equal(result2$sd, 1) + + # Wrong number of parameters + expect_error( + BayesTools:::.check_and_name_parameters(list(0), c("mean", "sd"), "normal"), + "requires 2 parameters" + ) + + # Invalid parameter names + expect_error( + BayesTools:::.check_and_name_parameters(list(location = 0, sd = 1), c("mean", "sd"), "normal"), + "Parameters 'location' are not supported" + ) + +}) + + +test_that(".check_and_set_truncation works correctly", { + + # Default truncation + result <- BayesTools:::.check_and_set_truncation(list()) + expect_equal(result$lower, -Inf) + expect_equal(result$upper, Inf) + + # Named truncation + result2 <- BayesTools:::.check_and_set_truncation(list(lower = 0)) + expect_equal(result2$lower, 0) + expect_equal(result2$upper, Inf) + + result3 <- BayesTools:::.check_and_set_truncation(list(upper = 1)) + expect_equal(result3$lower, -Inf) + expect_equal(result3$upper, 1) + + # Positional truncation + result4 <- BayesTools:::.check_and_set_truncation(list(0, 1)) + expect_equal(result4$lower, 0) + expect_equal(result4$upper, 1) + + # Single positional (becomes lower) + result5 <- BayesTools:::.check_and_set_truncation(list(0)) + expect_equal(result5$lower, 0) + + # Distribution-specific defaults + result6 <- BayesTools:::.check_and_set_truncation(list(), lower = 0) + expect_equal(result6$lower, 0) + + # Error conditions + expect_error( + BayesTools:::.check_and_set_truncation(list(1, 2, 3)), + "More than two truncation points" + ) + + expect_error( + BayesTools:::.check_and_set_truncation(list(bad_name = 0)), + "must be named 'lower' and 'upper'" + ) + + expect_error( + BayesTools:::.check_and_set_truncation(list(1, 0)), + "lower truncation point must be lower" + ) + + expect_error( + BayesTools:::.check_and_set_truncation(list(-1, Inf), lower = 0), + "Lower truncation point must be larger or equal to 0" + ) + + expect_error( + BayesTools:::.check_and_set_truncation(list(-Inf, 2), upper = 1), + "Upper truncation point must be smaller or equal to 1" + ) + +}) + + +test_that(".check_parameter works correctly", { + + # Valid parameters + expect_null(BayesTools:::.check_parameter(1, "param")) + expect_null(BayesTools:::.check_parameter(c(1, 2, 3), "param", length = 3)) + expect_null(BayesTools:::.check_parameter(c(1, 2), "param", length = 0)) + + # Expressions should pass through + expect_null(BayesTools:::.check_parameter(expression(x + 1), "param")) + + # Invalid parameters + expect_error( + BayesTools:::.check_parameter("a", "param"), + "must be a numeric vector" + ) + + expect_error( + BayesTools:::.check_parameter(c(1, 2), "param", length = 3), + "must be a numeric vector of length 3" + ) + +}) + + +test_that(".check_parameter_dimensions works correctly", { + + # Valid dimensions + expect_null(BayesTools:::.check_parameter_dimensions(3, "K")) + expect_null(BayesTools:::.check_parameter_dimensions(NA, "K", allow_NA = TRUE)) + + # Expressions should pass through + expect_null(BayesTools:::.check_parameter_dimensions(expression(K), "K")) + + # Invalid dimensions + expect_error( + BayesTools:::.check_parameter_dimensions(NA, "K", allow_NA = FALSE), + "must be defined" + ) + + # Note: The function has some implementation quirks with vector input, + # so we just test that invalid inputs throw some error + expect_error(BayesTools:::.check_parameter_dimensions(c(1, 2), "K")) + expect_error(BayesTools:::.check_parameter_dimensions(1.5, "K")) + +}) + + +test_that(".get_prior_factor_levels works correctly", { + + # Treatment contrast - levels - 1 + p_treatment <- prior_factor("normal", contrast = "treatment", list(0, 1)) + attr(p_treatment, "levels") <- 3 + expect_equal(BayesTools:::.get_prior_factor_levels(p_treatment), 2) + + # Independent contrast - all levels + p_independent <- prior_factor("beta", contrast = "independent", list(1, 1)) + attr(p_independent, "levels") <- 3 + expect_equal(BayesTools:::.get_prior_factor_levels(p_independent), 3) + + # Orthonormal contrast - levels - 1 + p_orthonormal <- prior_factor("mnormal", contrast = "orthonormal", list(0, 1)) + attr(p_orthonormal, "levels") <- 4 + expect_equal(BayesTools:::.get_prior_factor_levels(p_orthonormal), 3) + + # Meandif contrast - levels - 1 + p_meandif <- prior_factor("mnormal", contrast = "meandif", list(0, 1)) + attr(p_meandif, "levels") <- 3 + expect_equal(BayesTools:::.get_prior_factor_levels(p_meandif), 2) + +}) + + +test_that(".prior_clean_input_name works correctly", { + + expect_equal(BayesTools:::.prior_clean_input_name("Normal"), "normal") + expect_equal(BayesTools:::.prior_clean_input_name("Log-Normal"), "lognormal") + expect_equal(BayesTools:::.prior_clean_input_name("Student_t"), "studentt") + expect_equal(BayesTools:::.prior_clean_input_name("one.sided"), "onesided") + expect_equal(BayesTools:::.prior_clean_input_name("two-sided"), "twosided") + expect_equal(BayesTools:::.prior_clean_input_name(" Sp ace "), "space") + +}) diff --git a/tests/testthat/test-summary-tables-edge-cases.R b/tests/testthat/test-summary-tables-edge-cases.R new file mode 100644 index 0000000..96b6347 --- /dev/null +++ b/tests/testthat/test-summary-tables-edge-cases.R @@ -0,0 +1,446 @@ +context("Summary tables edge cases and comprehensive tests") + +REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables-edge-cases") +source(testthat::test_path("common-functions.R")) + +# Helper to skip if pre-fitted models aren't available +skip_if_no_fits <- function() { + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + if (!dir.exists(temp_fits_dir)) { + skip("Pre-fitted models directory not found. Run test-00-model-fits.R first.") + } + if (!file.exists(file.path(temp_fits_dir, "fit_simple_normal.RDS"))) { + skip("Pre-fitted models not found. Run test-00-model-fits.R first.") + } +} + +# ============================================================================ # +# SECTION 1: ensemble_estimates_table edge cases +# ============================================================================ # +test_that("ensemble_estimates_table handles matrix posteriors", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Load fits with margliks for creating mixed posteriors + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test basic table creation + estimates_table <- ensemble_estimates_table( + mixed_posteriors, + parameters = c("m", "omega") + ) + + test_reference_table(estimates_table, "ensemble_estimates_basic.txt") + + # Test with custom probs + estimates_table_probs <- ensemble_estimates_table( + mixed_posteriors, + parameters = c("m", "omega"), + probs = c(0.10, 0.50, 0.90) + ) + + test_reference_table(estimates_table_probs, "ensemble_estimates_custom_probs.txt") + +}) + + +test_that("ensemble_estimates_table handles transform_factors", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Load orthonormal models with marginal likelihoods + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + models <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) + ) + + # Get factor parameter names from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), + seed = 1, + n_samples = 1000 + ) + + # Test with transform_factors = TRUE + estimates_table_transform <- ensemble_estimates_table( + mixed_posteriors, + parameters = factor_params, + transform_factors = TRUE + ) + + test_reference_table(estimates_table_transform, "ensemble_estimates_transform_factors.txt") + +}) + + +test_that("ensemble_estimates_table handles formula posteriors", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Use orthonormal models (have formulas and marginal likelihoods) + fit_formula <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_formula <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_formula2 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_formula2 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + models <- list( + list(fit = fit_formula, marglik = marglik_formula, prior_weights = 1), + list(fit = fit_formula2, marglik = marglik_formula2, prior_weights = 1) + ) + + prior_list <- attr(fit_formula, "prior_list") + params <- names(prior_list)[!sapply(prior_list, is.null)] + + is_null_list <- setNames( + lapply(params, function(p) c(FALSE, FALSE)), + params + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = params, + is_null_list = is_null_list, + seed = 1, + n_samples = 1000 + ) + + # Test with formula_prefix = TRUE + estimates_prefix_true <- ensemble_estimates_table( + mixed_posteriors, + parameters = params, + formula_prefix = TRUE + ) + + # Test with formula_prefix = FALSE + estimates_prefix_false <- ensemble_estimates_table( + mixed_posteriors, + parameters = params, + formula_prefix = FALSE + ) + + test_reference_table(estimates_prefix_true, "ensemble_estimates_formula_prefix_true.txt") + test_reference_table(estimates_prefix_false, "ensemble_estimates_formula_prefix_false.txt") + +}) + + +# ============================================================================ # +# SECTION 2: ensemble_inference_table edge cases +# ============================================================================ # +test_that("ensemble_inference_table handles multiple parameters", { + + skip_if_not_installed("rjags") + skip_on_cran() + + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)) + ) + + # Basic table + inference_table <- ensemble_inference_table(inference, names(inference)) + test_reference_table(inference_table, "ensemble_inference_basic.txt") + + # With logBF + inference_table_log <- ensemble_inference_table(inference, names(inference), logBF = TRUE) + test_reference_table(inference_table_log, "ensemble_inference_logBF.txt") + + # With BF01 + inference_table_bf01 <- ensemble_inference_table(inference, names(inference), BF01 = TRUE) + test_reference_table(inference_table_bf01, "ensemble_inference_BF01.txt") + + # With both + inference_table_both <- ensemble_inference_table(inference, names(inference), logBF = TRUE, BF01 = TRUE) + test_reference_table(inference_table_both, "ensemble_inference_both.txt") + +}) + + +# ============================================================================ # +# SECTION 3: ensemble_summary_table and ensemble_diagnostics_table +# ============================================================================ # +test_that("ensemble_summary_table handles different model configurations", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Use models with and without spike-at-zero to test remove_spike_0 + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_spike)) + ) + models <- models_inference(models) + + # Test summary table + summary_table <- ensemble_summary_table(models, c("m", "s")) + test_reference_table(summary_table, "ensemble_summary_basic.txt") + + # Test with short_name + summary_table_short <- ensemble_summary_table(models, c("m", "s"), short_name = TRUE) + test_reference_table(summary_table_short, "ensemble_summary_short_name.txt") + + # Test with logBF and BF01 + summary_table_bf <- ensemble_summary_table(models, c("m", "s"), logBF = TRUE, BF01 = TRUE) + test_reference_table(summary_table_bf, "ensemble_summary_bf_options.txt") + + # Test with remove_spike_0 (should remove 'm' which has spike at zero in fit_simple_spike) + summary_table_no_spike <- ensemble_summary_table(models, c("m", "s"), remove_spike_0 = FALSE) + test_reference_table(summary_table_no_spike, "ensemble_summary_no_spike.txt") + +}) + + +test_that("ensemble_summary_table handles parameters as list", { + + skip_if_not_installed("rjags") + skip_on_cran() + + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_spike)) + ) + models <- models_inference(models) + + # Test with parameters supplied as a list + pars <- list("m" = "m", "renamed 2" = "s") + summary_table_list <- ensemble_summary_table(models, pars) + test_reference_table(summary_table_list, "ensemble_summary_params_list.txt") + +}) + + +test_that("ensemble_diagnostics_table handles different configurations", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Use models with and without spike-at-zero to test remove_spike_0 + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_spike)) + ) + models <- models_inference(models) + + # Test diagnostics table + diagnostics_table <- ensemble_diagnostics_table(models, c("m", "s")) + test_reference_table(diagnostics_table, "ensemble_diagnostics_basic.txt") + + # Test with short_name + diagnostics_short <- ensemble_diagnostics_table(models, c("m", "s"), short_name = TRUE) + test_reference_table(diagnostics_short, "ensemble_diagnostics_short_name.txt") + + # Test with remove_spike_0 + diagnostics_no_spike <- ensemble_diagnostics_table(models, c("m", "s"), remove_spike_0 = FALSE) + test_reference_table(diagnostics_no_spike, "ensemble_diagnostics_no_spike.txt") + +}) + + +# ============================================================================ # +# SECTION 4: marginal_estimates_table edge cases +# ============================================================================ # +test_that("marginal_estimates_table handles various inputs", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Create sample data for marginal inference testing + samples <- list( + mu = rnorm(1000, 0, 1) + ) + + inference <- list( + mu = structure(list( + BF = 2.5, + prior_probs = c(0.5, 0.5), + post_probs = c(0.4, 0.6) + ), class = c("list", "marginal_inference")) + ) + + attr(inference$mu, "is_null") <- c(TRUE, FALSE) + attr(inference$mu, "prior_list") <- list( + prior("spike", list(0)), + prior("normal", list(0, 1)) + ) + + marginal_table <- marginal_estimates_table( + samples = samples, + inference = inference, + parameters = "mu" + ) + + test_reference_table(marginal_table, "marginal_estimates_basic.txt") + + # With logBF + marginal_table_log <- marginal_estimates_table( + samples = samples, + inference = inference, + parameters = "mu", + logBF = TRUE + ) + test_reference_table(marginal_table_log, "marginal_estimates_logBF.txt") + + # With BF01 + marginal_table_bf01 <- marginal_estimates_table( + samples = samples, + inference = inference, + parameters = "mu", + BF01 = TRUE + ) + test_reference_table(marginal_table_bf01, "marginal_estimates_BF01.txt") + +}) + + +# ============================================================================ # +# SECTION 7: model_summary_table tests +# ============================================================================ # +test_that("model_summary_table handles various configurations", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Use model with spike-at-zero to test remove_spike_0 + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + model <- list( + fit = fit_simple_spike, + marglik = marglik_simple_spike, + prior_weights = 1, + fit_summary = runjags_estimates_table(fit_simple_spike) + ) + model_list <- list(model) + model_list <- models_inference(model_list) + + # Basic model summary + summary_table <- model_summary_table(model_list[[1]]) + test_reference_table(summary_table, "model_summary_basic.txt") + + # With short_name + summary_short <- model_summary_table(model_list[[1]], short_name = TRUE) + test_reference_table(summary_short, "model_summary_short_name.txt") + + # With remove_spike_0 (should remove 'm' which has spike at zero) + summary_no_spike <- model_summary_table(model_list[[1]], remove_spike_0 = TRUE) + test_reference_table(summary_no_spike, "model_summary_no_spike.txt") + +}) + + + +# ============================================================================ # +# SECTION 9: update.BayesTools_table tests +# ============================================================================ # +test_that("update.BayesTools_table works correctly", { + + skip_if_not_installed("rjags") + skip_on_cran() + + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) + ) + models <- models_inference(models) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)) + ) + + # Create inference table + inference_table <- ensemble_inference_table(inference, names(inference)) + + # Update with new title + updated_table <- update(inference_table, title = "Updated Title") + test_reference_table(updated_table, "update_table_new_title.txt") + + # Update with footnotes + updated_footnotes <- update(inference_table, footnotes = "This is a footnote") + test_reference_table(updated_footnotes, "update_table_footnotes.txt") + + # Update with warnings + updated_warnings <- update(inference_table, warnings = "This is a warning") + test_reference_table(updated_warnings, "update_table_warnings.txt") + + # Update with logBF + updated_logbf <- update(inference_table, logBF = TRUE) + test_reference_table(updated_logbf, "update_table_logBF.txt") + + # Update with BF01 + updated_bf01 <- update(inference_table, BF01 = TRUE) + test_reference_table(updated_bf01, "update_table_BF01.txt") + +}) + diff --git a/tests/testthat/test-summary-tables-helpers.R b/tests/testthat/test-summary-tables-helpers.R new file mode 100644 index 0000000..a769522 --- /dev/null +++ b/tests/testthat/test-summary-tables-helpers.R @@ -0,0 +1,233 @@ +context("Summary tables helper functions") + +REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables-helpers") +source(testthat::test_path("common-functions.R")) + + +test_that("format_BF works correctly", { + + # Basic usage + BF <- format_BF(3.5) + expect_equal(as.numeric(BF), 3.5) + expect_equal(attr(BF, "name"), "BF") + expect_false(attr(BF, "logBF")) + expect_false(attr(BF, "BF01")) + + # With BF01 = TRUE (inverted) + BF_01 <- format_BF(2, BF01 = TRUE) + expect_equal(as.numeric(BF_01), 0.5) + expect_equal(attr(BF_01, "name"), "1/BF") + expect_true(attr(BF_01, "BF01")) + + # With logBF = TRUE + BF_log <- format_BF(exp(2), logBF = TRUE) + expect_equal(as.numeric(BF_log), 2, tolerance = 1e-10) + expect_match(attr(BF_log, "name"), "log\\(BF\\)") + expect_true(attr(BF_log, "logBF")) + + # With inclusion = TRUE + BF_incl <- format_BF(5, inclusion = TRUE) + expect_equal(attr(BF_incl, "name"), "Inclusion BF") + + # With BF01 = TRUE and inclusion = TRUE + BF_excl <- format_BF(5, BF01 = TRUE, inclusion = TRUE) + expect_equal(attr(BF_excl, "name"), "Exclusion BF") + + # Combined logBF and BF01 + BF_both <- format_BF(10, logBF = TRUE, BF01 = TRUE) + expect_equal(as.numeric(BF_both), log(0.1), tolerance = 1e-10) + expect_match(attr(BF_both, "name"), "log\\(1/BF\\)") + + # Vector input with NA - NA_real_ must be part of numeric vector + BF_vec_na <- format_BF(c(1, 2, NA_real_)) + expect_equal(as.numeric(BF_vec_na)[1:2], c(1, 2)) + expect_true(is.na(as.numeric(BF_vec_na)[3])) + + # Vector input + BF_vec <- format_BF(c(1, 2, 3)) + expect_equal(as.numeric(BF_vec), c(1, 2, 3)) + +}) + + +test_that("format_BF input validation works", { + + expect_error(format_BF(-1), "must be equal or higher than 0") + expect_error(format_BF("3"), "must be a numeric") + expect_error(format_BF(3, logBF = "TRUE"), "must be a logical") + expect_error(format_BF(3, BF01 = "TRUE"), "must be a logical") + +}) + + +test_that("add_column works correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Create a proper BayesTools_table with 3 columns (needed for middle position test) + test_data <- data.frame( + Mean = c(0.5, 1.2), + Median = c(0.4, 1.1), + SD = c(0.1, 0.2) + ) + rownames(test_data) <- c("mu", "sigma") + class(test_data) <- c("BayesTools_table", "data.frame") + attr(test_data, "type") <- c("estimate", "estimate", "estimate") + attr(test_data, "rownames") <- TRUE + + # Add column at end (default) + result1 <- add_column(test_data, "CI_lower", c(-0.5, 0.8)) + expect_equal(ncol(result1), 4) + expect_true("CI_lower" %in% names(result1)) + expect_s3_class(result1, "BayesTools_table") + expect_equal(attr(result1, "type"), c("estimate", "estimate", "estimate", "estimate")) + test_reference_table(result1, "add_column_end.txt") + + # Add column at specific position + result2 <- add_column(test_data, "CI_lower", c(-0.5, 0.8), column_position = 2) + expect_equal(ncol(result2), 4) + expect_equal(names(result2)[2], "CI_lower") + test_reference_table(result2, "add_column_position2.txt") + + # Add column at position 1 + result3 <- add_column(test_data, "ID", c(1, 2), column_position = 1) + expect_equal(ncol(result3), 4) + expect_equal(names(result3)[1], "ID") + expect_equal(attr(result3, "type")[1], "integer") + test_reference_table(result3, "add_column_position1.txt") + + # With specified column type + result4 <- add_column(test_data, "Prob", c(0.5, 0.8), column_type = "probability") + expect_equal(ncol(result4), 4) + expect_equal(attr(result4, "type")[4], "probability") + test_reference_table(result4, "add_column_probability.txt") + + # Add column with string values (must specify column_type) + result5 <- add_column(test_data, "Category", c("A", "B"), column_type = "string") + expect_equal(ncol(result5), 4) + expect_true("Category" %in% names(result5)) + expect_equal(attr(result5, "type")[4], "string") + test_reference_table(result5, "add_column_string.txt") + +}) + + +test_that("add_column input validation works", { + + # Create a proper BayesTools_table with data (3 columns) + test_data <- data.frame( + Mean = c(0.5, 1.2), + Median = c(0.4, 1.1), + SD = c(0.1, 0.2) + ) + rownames(test_data) <- c("mu", "sigma") + class(test_data) <- c("BayesTools_table", "data.frame") + attr(test_data, "type") <- c("estimate", "estimate", "estimate") + attr(test_data, "rownames") <- TRUE + + # Wrong table class + expect_error(add_column(data.frame(a = 1), "b", 2), "must be of class 'BayesTools_table'") + + # Wrong column_values length + expect_error(add_column(test_data, "new", c(1, 2, 3)), "must be a vector of the same length") + +}) + + +test_that("remove_column works correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Create a proper BayesTools_table with data + test_data <- data.frame( + Mean = c(0.5, 1.2), + Median = c(0.4, 1.1), + SD = c(0.1, 0.2) + ) + rownames(test_data) <- c("mu", "sigma") + class(test_data) <- c("BayesTools_table", "data.frame") + attr(test_data, "type") <- c("estimate", "estimate", "estimate") + attr(test_data, "rownames") <- TRUE + + # Remove last column (default) + result0 <- remove_column(test_data) + expect_equal(ncol(result0), 2) + expect_false("SD" %in% names(result0)) + expect_s3_class(result0, "BayesTools_table") + expect_equal(attr(result0, "type"), c("estimate", "estimate")) + test_reference_table(result0, "remove_column_last.txt") + + # Remove by position + result2 <- remove_column(test_data, column_position = 2) + expect_equal(ncol(result2), 2) + expect_false("Median" %in% names(result2)) + test_reference_table(result2, "remove_column_position2.txt") + +}) + + +test_that("remove_column input validation works", { + + # Create a proper BayesTools_table with data + test_data <- data.frame( + Mean = c(0.5, 1.2), + Median = c(0.4, 1.1) + ) + rownames(test_data) <- c("mu", "sigma") + class(test_data) <- c("BayesTools_table", "data.frame") + attr(test_data, "type") <- c("estimate", "estimate") + attr(test_data, "rownames") <- TRUE + + # Wrong table class + expect_error(remove_column(data.frame(a = 1)), "must be of class 'BayesTools_table'") + + # Invalid column position + expect_error(remove_column(test_data, column_position = 10), "'column_position'") + +}) + + +test_that("ensemble_estimates_empty_table works correctly", { + + empty_table <- ensemble_estimates_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_equal(nrow(empty_table), 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "ensemble_estimates_empty.txt") + +}) + + +test_that("ensemble_inference_empty_table works correctly", { + + empty_table <- ensemble_inference_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_equal(nrow(empty_table), 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "ensemble_inference_empty.txt") + +}) + + +test_that("ensemble_summary_empty_table works correctly", { + + empty_table <- ensemble_summary_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_equal(nrow(empty_table), 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "ensemble_summary_empty.txt") + +}) + + +test_that("ensemble_diagnostics_empty_table works correctly", { + + empty_table <- ensemble_diagnostics_empty_table() + expect_s3_class(empty_table, "BayesTools_table") + expect_equal(nrow(empty_table), 0) + expect_true(ncol(empty_table) > 0) + test_reference_table(empty_table, "ensemble_diagnostics_empty.txt") + +}) diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools.R index 0d9762e..df1e322 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools.R @@ -272,3 +272,80 @@ test_that("Other tools",{ expect_error(.check_transformation_input(transformation = 1, NULL, FALSE), "Uknown format of the 'transformation' argument.") }) + + +test_that(".is.wholenumber works correctly", { + + expect_true(BayesTools:::.is.wholenumber(0)) + expect_true(BayesTools:::.is.wholenumber(5)) + expect_true(BayesTools:::.is.wholenumber(-3)) + expect_true(BayesTools:::.is.wholenumber(1e10)) + + expect_false(BayesTools:::.is.wholenumber(0.5)) + expect_false(BayesTools:::.is.wholenumber(1.1)) + expect_false(BayesTools:::.is.wholenumber(-3.5)) + + # NA handling + expect_true(is.na(BayesTools:::.is.wholenumber(NA))) + # When na.rm = TRUE and input is just NA, result is logical(0) + expect_equal(BayesTools:::.is.wholenumber(NA, na.rm = TRUE), logical(0)) + + # Vector input + expect_equal(BayesTools:::.is.wholenumber(c(1, 2, 3.5)), c(TRUE, TRUE, FALSE)) + + # Vector input with NA + expect_equal(BayesTools:::.is.wholenumber(c(1, NA, 3.5)), c(TRUE, NA, FALSE)) + +}) + + +test_that("check_int rejects non-integer values", { + + # Non-integer values should fail + expect_error(check_int(1.5, "test"), "must be an integer") + expect_error(check_int(c(1, 2.5, 3), "test", check_length = 3), "must be an integer") + +}) + + +test_that("check functions handle empty vectors correctly", { + + # Empty vectors should be treated like NULL + expect_error(check_bool(logical(0), "test")) + expect_error(check_char(character(0), "test")) + expect_error(check_real(numeric(0), "test")) + expect_error(check_int(integer(0), "test")) + + # But should succeed with allow_NULL + expect_null(check_bool(logical(0), "test", allow_NULL = TRUE)) + expect_null(check_char(character(0), "test", allow_NULL = TRUE)) + expect_null(check_real(numeric(0), "test", allow_NULL = TRUE)) + expect_null(check_int(integer(0), "test", allow_NULL = TRUE)) + +}) + + +test_that("check functions custom error prefix works", { + + expect_error( + check_bool("string", "test", call = "[custom] "), + "\\[custom\\] The 'test' argument must be a logical" + ) + expect_error( + check_char(1, "test", call = "[custom] "), + "\\[custom\\] The 'test' argument must be a character" + ) + expect_error( + check_real("a", "test", call = "[custom] "), + "\\[custom\\] The 'test' argument must be a numeric" + ) + expect_error( + check_int("a", "test", call = "[custom] "), + "\\[custom\\] The 'test' argument must be a numeric" + ) + expect_error( + check_list("a", "test", call = "[custom] "), + "\\[custom\\] The 'test' argument must be a list" + ) + +}) From c33db0236c333893dbf25a14974cec07c648a74c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 11 Dec 2025 09:03:49 +0100 Subject: [PATCH 08/38] update coverage --- .../JAGS_add_priors_peese_mixture.txt | 6 + .../JAGS_add_priors_pet_mixture.txt | 6 + .../results/JAGS-fit-edge-cases/fit_jasp.txt | 1 + .../marginal_estimates_BF01.txt | 2 +- .../marginal_estimates_basic.txt | 2 +- .../marginal_estimates_logBF.txt | 2 +- .../plot-factor-transformation.svg | 51 +++++ .../plot-factor-with-spike.svg | 73 +++++++ .../plot-models-order-decreasing-estimate.svg | 73 +++++++ .../plot-models-order-decreasing-prob.svg | 73 +++++++ .../plot-models-order-increasing-bf.svg | 73 +++++++ .../plot-models-orthonormal.svg | 201 ++++++++++++++++++ .../plot-posterior-factor-transformation.svg | 79 +++++++ tests/testthat/test-JAGS-fit-edge-cases.R | 195 +++++++++++++++++ .../test-model-averaging-edge-cases.R | 8 + .../test-model-averaging-plots-edge-cases.R | 185 ++++++++++++++++ .../testthat/test-summary-tables-edge-cases.R | 10 + 17 files changed, 1037 insertions(+), 3 deletions(-) create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt create mode 100644 tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt create mode 100644 tests/results/JAGS-fit-edge-cases/fit_jasp.txt create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt new file mode 100644 index 0000000..ff93da5 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt @@ -0,0 +1,6 @@ +model{ + bias_indicator ~ dcat(c(1, 1)) + PEESE_1 ~ dnorm(0,1)T(0,) + PEESE = PEESE_1 * (bias_indicator == 2) + +} diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt new file mode 100644 index 0000000..e9d1c10 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt @@ -0,0 +1,6 @@ +model{ + bias_indicator ~ dcat(c(1, 1)) + PET_1 ~ dnorm(0,1)T(0,) + PET = PET_1 * (bias_indicator == 2) + +} diff --git a/tests/results/JAGS-fit-edge-cases/fit_jasp.txt b/tests/results/JAGS-fit-edge-cases/fit_jasp.txt new file mode 100644 index 0000000..0882ad2 --- /dev/null +++ b/tests/results/JAGS-fit-edge-cases/fit_jasp.txt @@ -0,0 +1 @@ +Test: Adapting and burnin the model(1),.Test: Sampling the model(5),.....,JAGS model with 101 samples (adapt+burnin = 100),,Full summary statistics have not been pre-calculated - use either the summary method or add.summary to calculate summary statistics, diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt index aec9b32..927d83e 100644 --- a/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt @@ -1,2 +1,2 @@ Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 0.400 +mu[] -0.626 -0.626 -0.626 -0.626 0.400 diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt index 340696f..2a4141a 100644 --- a/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt @@ -1,2 +1,2 @@ Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 2.500 +mu[] -0.626 -0.626 -0.626 -0.626 2.500 diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt b/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt index 64ea4ce..48e8e35 100644 --- a/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt +++ b/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt @@ -1,2 +1,2 @@ Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 0.916 +mu[] -0.626 -0.626 -0.626 -0.626 0.916 diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg new file mode 100644 index 0000000..d502b5e --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + +1 +2 +3 +4 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg new file mode 100644 index 0000000..a21650c --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + +Density + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg new file mode 100644 index 0000000..cdad4f0 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 +m + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +0.17 [-0.22, 0.59] +0.20 [-0.20, 0.63] +BF = 0.57 [0.50 -> 0.36] +0.16 [-0.25, 0.50] +BF = 1.76 [0.50 -> 0.64] + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg new file mode 100644 index 0000000..6693d00 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 +m + + + + +Model-Averaged +Model 2 +Model 1 + + + + + + +0.17 [-0.22, 0.59] +0.16 [-0.25, 0.50] +BF = 1.76 [0.50 -> 0.64] +0.20 [-0.20, 0.63] +BF = 0.57 [0.50 -> 0.36] + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg new file mode 100644 index 0000000..6693d00 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 +0.8 +m + + + + +Model-Averaged +Model 2 +Model 1 + + + + + + +0.17 [-0.22, 0.59] +0.16 [-0.25, 0.50] +BF = 1.76 [0.50 -> 0.64] +0.20 [-0.20, 0.63] +BF = 0.57 [0.50 -> 0.36] + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg new file mode 100644 index 0000000..bdf5133 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg @@ -0,0 +1,201 @@ + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + +(mu) x_fac3o [dif: A] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +0.00 [-0.47, 0.46] +0.00 [ 0.00, 0.00] +BF = 0.07 [0.50 -> 0.06] +0.02 [-0.20, 0.24] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + +(mu) x_fac3o [dif: B] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +0.00 [-0.47, 0.46] + 0.00 [ 0.00, 0.00] +BF = 0.07 [0.50 -> 0.06] +-0.32 [-0.54, -0.11] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 +0.2 +0.4 +0.6 + + + + + + + +(mu) x_fac3o [dif: C] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +0.00 [-0.47, 0.46] +0.00 [0.00, 0.00] +BF = 0.07 [0.50 -> 0.06] +0.31 [0.09, 0.52] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg new file mode 100644 index 0000000..f7aee41 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + +Density + + + + + +0.5 +1.0 +1.5 +2.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + + + +0 +0.01 +0.02 +0.03 +0.04 +0.05 +0.06 +0.07 +Probability + + + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 057d2af..79d4148 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -120,6 +120,7 @@ test_that("JAGS_get_inits handles various prior types", { test_that("JAGS_check_convergence works with fitted models", { skip_if_not_installed("rjags") + skip_if_no_fits() fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) prior_list <- attr(fit_simple, "prior_list") @@ -179,6 +180,7 @@ test_that("JAGS_fit preserves attributes", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -200,6 +202,7 @@ test_that("runjags_estimates_table works with fitted models", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -212,3 +215,195 @@ test_that("runjags_estimates_table works with fitted models", { test_reference_table(estimates_table_param, "runjags_estimates_param_m.txt") }) + + +# ============================================================================ # +# SECTION 7: JAGS_extend tests +# ============================================================================ # +test_that("JAGS_extend works correctly", { + + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Test extending a fitted model + fit_extended <- JAGS_extend( + fit_simple, + autofit_control = list( + max_Rhat = 1.05, + min_ESS = 100, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 2, + max_extend = 2 + ), + silent = TRUE, + seed = 1 + ) + + # Check that the extended fit is still a BayesTools_fit + + expect_true(inherits(fit_extended, "BayesTools_fit")) + expect_true(inherits(fit_extended, "runjags")) + + # Check that attributes are preserved + expect_true(!is.null(attr(fit_extended, "prior_list"))) + expect_true(!is.null(attr(fit_extended, "model_syntax"))) + + # Check that the extended fit has more samples + original_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_simple))) + extended_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_extended))) + expect_true(extended_samples >= original_samples) + +}) + +test_that("JAGS_extend error handling", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Test error when fit is not a BayesTools_fit + expect_error( + JAGS_extend(list(), autofit_control = list()), + "'fit' must be a 'BayesTools_fit'" + ) + +}) + + +# ============================================================================ # +# SECTION 8: .check_JAGS_syntax error handling +# ============================================================================ # +test_that(".check_JAGS_syntax validates syntax correctly", { + + # Test with valid syntax + expect_silent(JAGS_add_priors("model{}", list(mu = prior("normal", list(0, 1))))) + + # Test with missing "model" keyword + expect_error( + JAGS_add_priors("invalid{}", list(mu = prior("normal", list(0, 1)))), + "syntax must be a JAGS model syntax" + ) + + # Test with missing opening brace + expect_error( + JAGS_add_priors("model}", list(mu = prior("normal", list(0, 1)))), + "syntax must be a JAGS model syntax" + ) + + # Test with missing closing brace + expect_error( + JAGS_add_priors("model{", list(mu = prior("normal", list(0, 1)))), + "syntax must be a JAGS model syntax" + ) + + # Test with non-character input + expect_error( + JAGS_add_priors(123, list(mu = prior("normal", list(0, 1)))), + "must be a character" + ) + +}) + + +# ============================================================================ # +# SECTION 9: JAGS_fit with is_JASP mode +# ============================================================================ # +test_that("JAGS_fit works with is_JASP mode", { + + skip_if_not_installed("rjags") + skip_on_cran() + + # Simple model for testing is_JASP mode + set.seed(1) + data <- list( + y = rnorm(20, 0.5, 1), + N = 20 + ) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("normal", list(0, 1), list(0, Inf)) + ) + + model_syntax <- "model{ + for(i in 1:N){ + y[i] ~ dnorm(mu, 1/pow(sigma, 2)) + } + }" + + # Mock JASP progress bar functions (they should be skipped if not available) + # The is_JASP mode should work but simply skip progress bars if functions don't exist + + fit_jasp <- capture.output(tryCatch({ + suppressWarnings(JAGS_fit( + model_syntax = model_syntax, + data = data, + prior_list = prior_list, + chains = 1, + adapt = 50, + burnin = 50, + sample = 100, + seed = 1, + silent = TRUE, + is_JASP = TRUE, + is_JASP_prefix = "Test" + )) + }, error = function(e) { + # If JASP functions don't exist, this should still produce a fit + # or fail gracefully + if (grepl("JASP", e$message)) { + skip("JASP progress bar functions not available") + } + stop(e) + })) + + test_reference_text(paste0(fit_jasp, collapse = ","), "fit_jasp.txt") + +}) + + +# ============================================================================ # +# SECTION 10: .JAGS_prior.mixture with PEESE prior +# ============================================================================ # +test_that("JAGS_add_priors handles mixture with PEESE prior", { + + skip_if_not_installed("rjags") + + # Create a bias mixture with PEESE prior + bias_mixture <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PEESE("normal", list(0, 1), prior_weights = 1) + )) + + priors_peese <- list( + bias = bias_mixture + ) + + result_peese <- JAGS_add_priors("model{}", priors_peese) + test_reference_text(result_peese, "JAGS_add_priors_peese_mixture.txt") + +}) + +test_that("JAGS_add_priors handles mixture with PET prior", { + + skip_if_not_installed("rjags") + + # Create a bias mixture with PET prior + bias_mixture <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PET("normal", list(0, 1), prior_weights = 1) + )) + + priors_pet <- list( + bias = bias_mixture + ) + + result_pet <- JAGS_add_priors("model{}", priors_pet) + test_reference_text(result_pet, "JAGS_add_priors_pet_mixture.txt") + +}) diff --git a/tests/testthat/test-model-averaging-edge-cases.R b/tests/testthat/test-model-averaging-edge-cases.R index 7f5371b..23819ea 100644 --- a/tests/testthat/test-model-averaging-edge-cases.R +++ b/tests/testthat/test-model-averaging-edge-cases.R @@ -12,6 +12,7 @@ test_that("mix_posteriors handles various prior types correctly", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -65,6 +66,7 @@ test_that("mix_posteriors handles weightfunction priors", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load summary models which have weightfunction priors fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) @@ -98,6 +100,7 @@ test_that("mix_posteriors handles factor priors", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load the orthonormal factor models (have both factor priors and marginal likelihoods) fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) @@ -136,6 +139,7 @@ test_that("mix_posteriors handles vector priors", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load vector prior models @@ -175,6 +179,7 @@ test_that("ensemble_inference handles different configurations", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -226,6 +231,7 @@ test_that("models_inference computes correctly", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -277,6 +283,7 @@ test_that("as_mixed_posteriors works correctly with BayesTools_fit objects", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # Load a fitted model fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -292,6 +299,7 @@ test_that("as_marginal_inference works correctly", { skip_on_cran() skip_if_not_installed("rjags") + skip_if_no_fits() # as_marginal_inference requires a BayesTools_fit object - load one fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R index eb3029c..2cd6352 100644 --- a/tests/testthat/test-model-averaging-plots-edge-cases.R +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -133,6 +133,7 @@ test_that("plot_posterior handles various sample types", { set.seed(1) skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) @@ -181,6 +182,7 @@ test_that("plot_posterior handles weightfunction posteriors", { set.seed(1) skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) @@ -348,3 +350,186 @@ test_that("plot_prior_list handles weightfunction priors", { }) + +# ============================================================================ # +# SECTION 9: .plot_prior_list.factor edge cases +# ============================================================================ # +test_that(".plot_prior_list.factor handles point priors within factor", { + set.seed(1) + + # Test factor prior - using treatment contrast with normal distribution + prior_spike <- prior("spike", list(0)) + prior_factor_treat <- prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment") + attr(prior_factor_treat, "levels") <- 3 + + # Simple list with both spike and factor priors + prior_list <- list(p1 = prior_spike, p2 = prior_factor_treat) + + # This should handle mixed plotting + vdiffr::expect_doppelganger("plot-factor-with-spike", function() { + plot_prior_list(prior_list) + }) + +}) + +test_that(".plot_prior_list.factor handles transformation", { + set.seed(1) + + # Create treatment factor prior with normal distribution + prior_treat <- prior_factor("normal", list(mean = 0, sd = 0.5), contrast = "treatment") + attr(prior_treat, "levels") <- 3 + + prior_list <- list(p1 = prior_treat) + + # Test with transformation (exp) - use string format for simplicity + vdiffr::expect_doppelganger("plot-factor-transformation", function() { + plot_prior_list(prior_list, transformation = "exp") + }) + +}) + + +# ============================================================================ # +# SECTION 10: plot_models with order argument +# ============================================================================ # +test_that("plot_models handles order argument", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) + ) + models <- models_inference(models) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test with order = decreasing by estimate + vdiffr::expect_doppelganger("plot-models-order-decreasing-estimate", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "estimate")) + }) + + # Test with order = increasing by BF + vdiffr::expect_doppelganger("plot-models-order-increasing-bf", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "BF")) + }) + + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-decreasing-prob", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "probability")) + }) + +}) + + +test_that("plot_models handles orthonormal priors", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load orthonormal models with marginal likelihoods + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + models <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1, + fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_0, transform_factors = TRUE))), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1, + fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_1, transform_factors = TRUE))) + ) + models <- models_inference(models) + + # Get factor parameter names from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] + + inference <- ensemble_inference( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), + seed = 1, + n_samples = 1000 + ) + + # Test with orthonormal priors - the models should be transformed to differences from mean + vdiffr::expect_doppelganger("plot-models-orthonormal", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params) + }) + +}) + + +# ============================================================================ # +# SECTION 11: .plot_data_samples.factor with transformation +# ============================================================================ # +test_that("plot_posterior handles factor samples with transformation", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load orthonormal models with marginal likelihoods + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + models <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) + ) + + # Get factor parameter names from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), + seed = 1, + n_samples = 1000 + ) + + # Test with transformation on factor posterior + vdiffr::expect_doppelganger("plot-posterior-factor-transformation", function() { + suppressMessages(BayesTools::plot_posterior(mixed_posteriors, factor_params, transformation = "exp")) + }) + +}) + diff --git a/tests/testthat/test-summary-tables-edge-cases.R b/tests/testthat/test-summary-tables-edge-cases.R index 96b6347..369ff19 100644 --- a/tests/testthat/test-summary-tables-edge-cases.R +++ b/tests/testthat/test-summary-tables-edge-cases.R @@ -22,6 +22,7 @@ test_that("ensemble_estimates_table handles matrix posteriors", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Load fits with margliks for creating mixed posteriors fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) @@ -68,6 +69,7 @@ test_that("ensemble_estimates_table handles transform_factors", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Load orthonormal models with marginal likelihoods fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) @@ -109,6 +111,7 @@ test_that("ensemble_estimates_table handles formula posteriors", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Use orthonormal models (have formulas and marginal likelihoods) fit_formula <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) @@ -165,6 +168,7 @@ test_that("ensemble_inference_table handles multiple parameters", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) @@ -209,6 +213,7 @@ test_that("ensemble_summary_table handles different model configurations", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Use models with and without spike-at-zero to test remove_spike_0 fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -246,6 +251,7 @@ test_that("ensemble_summary_table handles parameters as list", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) @@ -271,6 +277,7 @@ test_that("ensemble_diagnostics_table handles different configurations", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Use models with and without spike-at-zero to test remove_spike_0 fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) @@ -309,6 +316,7 @@ test_that("marginal_estimates_table handles various inputs", { skip_on_cran() # Create sample data for marginal inference testing + set.seed(1) # Ensure reproducibility samples <- list( mu = rnorm(1000, 0, 1) ) @@ -363,6 +371,7 @@ test_that("model_summary_table handles various configurations", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() # Use model with spike-at-zero to test remove_spike_0 fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) @@ -400,6 +409,7 @@ test_that("update.BayesTools_table works correctly", { skip_if_not_installed("rjags") skip_on_cran() + skip_if_no_fits() fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) From b6eccbf8eb3141f7855fc916f9c7e22d73d33cca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 11 Dec 2025 12:20:36 +0100 Subject: [PATCH 09/38] update coverage --- R/model-averaging.R | 19 +- R/priors-print.R | 3 +- .../diagnostics-plot-mixture-1.svg | 56 ++-- .../diagnostics-plot-mixture-2.svg | 56 ++-- .../diagnostics-plot-mixture-3.svg | 56 ++-- .../diagnostics-plot-mixture-4.svg | 32 +- .../diagnostics-plot-mixture-5.svg | 32 +- .../diagnostics-plot-mixture-6.svg | 32 +- ...mplex-bias-conditional-posterior-peese.svg | 50 ++++ ...complex-bias-conditional-posterior-pet.svg | 80 +++++ ...plot-complex-bias-posterior-bias-peese.svg | 76 +++++ ...g-plot-complex-bias-posterior-bias-pet.svg | 76 +++++ ...eraging-plot-complex-bias-posterior-mu.svg | 54 ++++ .../model-averaging-plot-posterior-i-1.svg | 67 +++++ .../model-averaging-plot-posterior-i-2.svg | 67 +++++ .../model-averaging-plot-posterior-m-1.svg | 65 +++++ .../model-averaging-plot-posterior-m-2.svg | 65 +++++ .../model-averaging-plot-posterior-o-5.svg | 61 ++++ .../model-averaging-plot-posterior-t-1.svg | 59 ++++ .../model-averaging-plot-posterior-t-2.svg | 59 ++++ ...g-plot-ss-posterior-weightfunction-con.svg | 4 +- ...aging-plot-ss-posterior-weightfunction.svg | 4 +- .../_snaps/priors-print/priors-print-4.svg | 28 +- .../_snaps/priors/prior-mixture-2.svg | 28 +- .../_snaps/priors/prior-mixture-4.svg | 60 ++-- .../_snaps/priors/prior-mixture-5.svg | 60 ++-- tests/testthat/test-00-model-fits.R | 39 +++ tests/testthat/test-JAGS-ensemble-plots.R | 275 ++++++++++++++++++ tests/testthat/test-priors-print.R | 2 +- 29 files changed, 1330 insertions(+), 235 deletions(-) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-mu.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-2.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-5.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-2.svg diff --git a/R/model-averaging.R b/R/model-averaging.R index 31a073e..1eff432 100644 --- a/R/model-averaging.R +++ b/R/model-averaging.R @@ -779,35 +779,36 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition # TODO: this needs to be implemented for enabling of the conditional mixture posterior distributions when more than one components is present # (e.g., conditional marginal and posterior plots) # the current workaround is suitable only for a single parameters (to produce averaged prior and posterior plots) - if(length(conditional) == 1 && length(parameters) == 1 && conditional == parameters && force_plots){ + if(length(conditional) == 1 && length(parameters) == 1 && (parameters == "bias" || conditional == parameters) && force_plots){ # special cases for PET / PEESE / PET-PEESE / weightfunctions - if(conditional == "PET" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ + if(parameters == "bias" && conditional == "PET" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ is_PET <- sapply(priors[["bias"]], is.prior.PET) for(i in seq(along = is_PET)){ if(!is_PET[i]){ - priors[[parameters]][[i]][["prior_weights"]] <- 0 + priors[["bias"]][[i]][["prior_weights"]] <- 0 } } - }else if(conditional == "PEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ + }else if(parameters == "bias" && conditional == "PEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ + is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) for(i in seq(along = is_PEESE)){ if(!is_PEESE[i]){ - priors[[parameters]][[i]][["prior_weights"]] <- 0 + priors[["bias"]][[i]][["prior_weights"]] <- 0 } } - }else if(conditional == "PETPEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ + }else if(parameters == "bias" && conditional == "PETPEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ is_PET <- sapply(priors[["bias"]], is.prior.PET) is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) for(i in seq(along = is_PET)){ if(!(is_PET[i] || is_PEESE[i])){ - priors[[parameters]][[i]][["prior_weights"]] <- 0 + priors[["bias"]][[i]][["prior_weights"]] <- 0 } } - }else if(conditional == "omega" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ + }else if(parameters == "bias" && conditional == "omega" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ is_weightfunction <- sapply(priors[["bias"]], is.prior.weightfunction) for(i in seq(along = is_weightfunction)){ if(!is_weightfunction[i]){ - priors[[parameters]][[i]][["prior_weights"]] <- 0 + priors[["bias"]][[i]][["prior_weights"]] <- 0 } } }else if(is.prior.mixture(priors[[parameters]])){ diff --git a/R/priors-print.R b/R/priors-print.R index ec2d7a0..f9e0a16 100644 --- a/R/priors-print.R +++ b/R/priors-print.R @@ -347,7 +347,8 @@ print.prior <- function(x, short_name = FALSE, parameter_names = FALSE, plot = F prior_components <- attr(x, "components") if(all(prior_components %in% c("null", "alternative"))){ - prior_components <- sort(prior_components) + prior_names <- prior_names[order(prior_components)] + prior_components <- prior_components[order(prior_components)] } if(!plot){ diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg index 195fd63..863db0e 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-1.svg @@ -52,34 +52,34 @@ * -Spike -(0) - -+ - -( -1 -/ -4 -) - -* - -Normal -(-1, 0.5) - -+ - -( -1 -/ -4 -) - -* - -Normal -(1, 0.5) +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Spike +(0) (mu) intercept Density diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg index e2840ec..495708d 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-2.svg @@ -54,34 +54,34 @@ * -Spike -(0) - -+ - -( -1 -/ -4 -) - -* - -Normal -(-1, 0.5) - -+ - -( -1 -/ -4 -) - -* - -Normal -(1, 0.5) +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Spike +(0) Lag Autocorrelation((mu) intercept) diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg index b95fd26..81bae33 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-3.svg @@ -52,34 +52,34 @@ * -Spike -(0) - -+ - -( -1 -/ -4 -) - -* - -Normal -(-1, 0.5) - -+ - -( -1 -/ -4 -) - -* - -Normal -(1, 0.5) +Normal +(-1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Normal +(1, 0.5) + ++ + +( +1 +/ +4 +) + +* + +Spike +(0) Iteration (mu) intercept diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg index c945200..83e1228 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-4.svg @@ -62,22 +62,22 @@ * orthonormal contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -orthonormal contrast: -mNormal -(0, 1) +mNormal +(0, 1) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) (mu) x_fac3t[2] Density diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg index 5a076b1..227c16c 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-5.svg @@ -64,22 +64,22 @@ * orthonormal contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -orthonormal contrast: -mNormal -(0, 1) +mNormal +(0, 1) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) Lag Autocorrelation((mu) x_fac3t[2]) diff --git a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg index ccf6425..a565c93 100644 --- a/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg +++ b/tests/testthat/_snaps/JAGS-diagnostic-plots/diagnostics-plot-mixture-6.svg @@ -60,22 +60,22 @@ * orthonormal contrast: -mSpike -(0) - -+ - -( -1 -/ -2 -) - -* - -orthonormal contrast: -mNormal -(0, 1) +mNormal +(0, 1) + ++ + +( +1 +/ +2 +) + +* + +orthonormal contrast: +mSpike +(0) Iteration (mu) x_fac3t[2] diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg new file mode 100644 index 0000000..c65dfef --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg @@ -0,0 +1,50 @@ + + + + + + + + + + + + +Probability + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + +0 +1 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg new file mode 100644 index 0000000..251821c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + +Density + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg new file mode 100644 index 0000000..e94de85 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + +0 +0.01 +0.02 +0.03 +0.04 +0.05 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg new file mode 100644 index 0000000..3f7baeb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + +0 +0.02 +0.04 +0.06 +0.08 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-mu.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-mu.svg new file mode 100644 index 0000000..a315e88 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-mu.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg new file mode 100644 index 0000000..d01db1c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Density + + + + + + + + + + + + + +1 +2 +3 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg new file mode 100644 index 0000000..d01db1c --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Density + + + + + + + + + + + + + +1 +2 +3 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-1.svg new file mode 100644 index 0000000..3cb8259 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-1.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +Density + + + + + + + + + + + + + + 1 + 2 + 3 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-2.svg new file mode 100644 index 0000000..3cb8259 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-m-2.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + +-2 +-1 +0 +1 +2 + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +Density + + + + + + + + + + + + + + 1 + 2 + 3 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-5.svg new file mode 100644 index 0000000..4beb1e6 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-o-5.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + +-0.5 +0.0 +0.5 + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 +Density + + + + + + + + + + + + + + A + B + C + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-1.svg new file mode 100644 index 0000000..7e496f7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-1.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + +2 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-2.svg new file mode 100644 index 0000000..7e496f7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-t-2.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + +2 + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg index 8a22f8b..85b7289 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg index 19398e7..7e67503 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/priors-print/priors-print-4.svg b/tests/testthat/_snaps/priors-print/priors-print-4.svg index 01a17dc..9e121d5 100644 --- a/tests/testthat/_snaps/priors-print/priors-print-4.svg +++ b/tests/testthat/_snaps/priors-print/priors-print-4.svg @@ -77,20 +77,20 @@ * Normal -(0, 1) - -+ - -( -5 -/ -7 -) - -* - -Normal -(-3, 1) +(-3, 1) + ++ + +( +5 +/ +7 +) + +* + +Normal +(0, 1) + diff --git a/tests/testthat/_snaps/priors/prior-mixture-2.svg b/tests/testthat/_snaps/priors/prior-mixture-2.svg index 32d8709..2cd5127 100644 --- a/tests/testthat/_snaps/priors/prior-mixture-2.svg +++ b/tests/testthat/_snaps/priors/prior-mixture-2.svg @@ -27,20 +27,20 @@ * Normal -(0, 1) - -+ - -( -5 -/ -7 -) - -* - -Normal -(-3, 1) +(-3, 1) + ++ + +( +5 +/ +7 +) + +* + +Normal +(0, 1) + diff --git a/tests/testthat/_snaps/priors/prior-mixture-4.svg b/tests/testthat/_snaps/priors/prior-mixture-4.svg index baa9cd2..9aa6667 100644 --- a/tests/testthat/_snaps/priors/prior-mixture-4.svg +++ b/tests/testthat/_snaps/priors/prior-mixture-4.svg @@ -27,36 +27,36 @@ * orthonormal contrast: -mSpike -(0) - -+ - -( -3 -/ -5 -) - -* - -orthonormal contrast: -mNormal -(0, 10) - -+ - -( -1 -/ -5 -) - -* - -orthonormal contrast: -mNormal -(0, 1) +mNormal +(0, 10) + ++ + +( +3 +/ +5 +) + +* + +orthonormal contrast: +mNormal +(0, 1) + ++ + +( +1 +/ +5 +) + +* + +orthonormal contrast: +mSpike +(0) rng(p4, 10000, transform_factor_samples = FALSE) Density diff --git a/tests/testthat/_snaps/priors/prior-mixture-5.svg b/tests/testthat/_snaps/priors/prior-mixture-5.svg index af5b50c..796ce6b 100644 --- a/tests/testthat/_snaps/priors/prior-mixture-5.svg +++ b/tests/testthat/_snaps/priors/prior-mixture-5.svg @@ -27,36 +27,36 @@ * orthonormal contrast: -mSpike -(0) - -+ - -( -3 -/ -5 -) - -* - -orthonormal contrast: -mNormal -(0, 10) - -+ - -( -1 -/ -5 -) - -* - -orthonormal contrast: -mNormal -(0, 1) +mNormal +(0, 10) + ++ + +( +3 +/ +5 +) + +* + +orthonormal contrast: +mNormal +(0, 1) + ++ + +( +1 +/ +5 +) + +* + +orthonormal contrast: +mSpike +(0) rng(p4, 10000, transform_factor_samples = TRUE) Density diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index c23d4a5..0dd1050 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -1889,6 +1889,45 @@ test_that("Complex models for plotting fit correctly", { expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_formula_mixed.RDS"))) }) +# ============================================================================ # +# SECTION 3: COMPLEX BIAS ONLY MODEL FOR PLOTTING +# ============================================================================ # +test_that("Complex models for plotting fit correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + skip_if_not_installed("RoBMA") + require("RoBMA") + + set.seed(1) + + prior_list1 <- list( + "mu" = prior("gamma", list(3, 3)), + "bias" = prior_mixture(list( + prior_none(prior_weights = 1), + prior_weightfunction(distribution = "two.sided", parameters = list(alpha = c(1, 1), steps = c(0.05)), prior_weights = 1/3), + prior_weightfunction(distribution = "one.sided", parameters = list(alpha = c(1, 1, 1), steps = c(0.025, 0.05)), prior_weights = 1/3), + prior_PET("normal", list(0, 1), prior_weights = 1/3), + prior_PEESE("normal", list(0, 2), prior_weights = 1/3) + ), is_null = c(TRUE, FALSE, FALSE, FALSE, FALSE)) + ) + model_syntax1 <- "model{}" + + fit_complex_bias <- suppressWarnings(JAGS_fit( + model_syntax = model_syntax1, data = NULL, prior_list = prior_list1, + chains = 1, adapt = 100, burnin = 150, sample = 500, seed = 1)) + + result <- save_fit(fit_complex_bias, "fit_complex_bias", + formulas = FALSE, mixture_priors = TRUE, spike_and_slab_priors = FALSE, + pub_bias_priors = TRUE, weightfunction_priors = TRUE, + note = "Model with complex publication bias mixture prior") + model_registry[["fit_complex_bias"]] <<- result$registry_entry + fit_complex_bias <- result$fit + + expect_true(file.exists(file.path(temp_fits_dir, "fit_complex_bias.RDS"))) +}) + + # ============================================================================ # # SAVE MODEL REGISTRY # ============================================================================ # diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index 32db710..e4a71bc 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -788,6 +788,14 @@ test_that("posterior plot functions (orthonormal) work", { "mu_x_fac3o" = c(FALSE, TRUE) ), seed = 1, n_samples = 10000) + mixed_posteriors2 <- mix_posteriors( + model_list = models, + parameters = c("mu_x_fac3o"), + conditional = TRUE, + is_null_list = list( + "mu_x_fac3o" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) vdiffr::expect_doppelganger("model-averaging-plot-posterior-o-1", function(){ oldpar <- graphics::par(no.readonly = TRUE) @@ -813,6 +821,165 @@ test_that("posterior plot functions (orthonormal) work", { par(mar = c(4, 4, 1, 4)) plot_posterior(mixed_posteriors, "mu_x_fac3o", legend = FALSE) }) + vdiffr::expect_doppelganger("model-averaging-plot-posterior-o-5", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "mu_x_fac3o") + }) +}) + +test_that("posterior plot functions (treatment) work", { + + skip_on_os(c("mac", "linux", "solaris")) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_factor_treatment.RDS")) + # Create dummy marginal likelihood since this model doesn't have one + marglik0 <- structure(list(logml = -10), class = "bridge") + + # Create a second model with different prior for comparison + fit1 <- readRDS(file.path(temp_fits_dir, "fit_factor_treatment.RDS")) + marglik1 <- structure(list(logml = -12), class = "bridge") + + # mix posteriors + models <- list( + list(fit = fit0, marglik = marglik0, prior_weights = 1), + list(fit = fit1, marglik = marglik1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("p1"), + is_null_list = list( + "p1" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + mixed_posteriors2 <- mix_posteriors( + model_list = models, + parameters = c("p1"), + conditional = TRUE, + is_null_list = list( + "p1" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + + vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "p1") + }) + vdiffr::expect_doppelganger("model-averaging-plot-posterior-t-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "p1") + }) +}) + +test_that("posterior plot functions (independent) work", { + + skip_on_os(c("mac", "linux", "solaris")) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) + # Create dummy marginal likelihood since this model doesn't have one + marglik0 <- structure(list(logml = -15), class = "bridge") + + # Create a second model with different prior for comparison + fit1 <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) + marglik1 <- structure(list(logml = -17), class = "bridge") + + # mix posteriors + models <- list( + list(fit = fit0, marglik = marglik0, prior_weights = 1), + list(fit = fit1, marglik = marglik1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("p1"), + is_null_list = list( + "p1[1]" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + + mixed_posteriors2 <- mix_posteriors( + model_list = models, + parameters = c("p1"), + conditional = TRUE, + is_null_list = list( + "p1[1]" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + + vdiffr::expect_doppelganger("model-averaging-plot-posterior-i-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "p1") + }) + + vdiffr::expect_doppelganger("model-averaging-plot-posterior-i-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "p1") + }) +}) + +test_that("posterior plot functions (meandif) work", { + + skip_on_os(c("mac", "linux", "solaris")) + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_factor_meandif.RDS")) + # Create dummy marginal likelihood since this model doesn't have one + marglik0 <- structure(list(logml = -20), class = "bridge") + + # Create a second model with different prior for comparison + fit1 <- readRDS(file.path(temp_fits_dir, "fit_factor_meandif.RDS")) + marglik1 <- structure(list(logml = -22), class = "bridge") + + # mix posteriors + models <- list( + list(fit = fit0, marglik = marglik0, prior_weights = 1), + list(fit = fit1, marglik = marglik1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("p1"), + is_null_list = list( + "p" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + mixed_posteriors2 <- mix_posteriors( + model_list = models, + parameters = c("p1"), + conditional = TRUE, + is_null_list = list( + "p" = c(TRUE, FALSE) + ), + seed = 1, n_samples = 10000) + + vdiffr::expect_doppelganger("model-averaging-plot-posterior-m-1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "p1") + }) + vdiffr::expect_doppelganger("model-averaging-plot-posterior-m-2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "p1") + }) + }) test_that("posterior plot model averaging based on complex single JAGS models (formulas + spike factors + mixture)", { @@ -1049,4 +1216,112 @@ test_that("posterior plot model averaging based on simple single JAGS models (f }) +test_that("posterior plot model averaging based on complex bias mixture model (PET + PEESE + weightfunction)", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit1 <- readRDS(file.path(temp_fits_dir, "fit_complex_bias.RDS")) + + mixed_posteriors <- as_mixed_posteriors( + mode = fit1, + parameters = names(attr(fit1, "prior_list")) + ) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-mu", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "mu", prior = TRUE, dots_prior = list(col = "grey")) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PET", function(){ + PET <- mixed_posteriors$bias[,"PET",drop=FALSE] + attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) + attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) + attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { + class(p) <- class(p)[!class(p) %in% "prior.PET"] + return(p) + }) + plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PEESE", function(){ + PEESE <- mixed_posteriors$bias[,"PEESE",drop=FALSE] + attributes(PEESE) <- c(attributes(PEESE), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) + attr(PEESE, "prior_list")[!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(1:sum(!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)), function(i) prior("point", list(0))) + attr(PEESE, "prior_list")[ sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(attr(PEESE, "prior_list")[sapply(attr(PEESE, "prior_list"), is.prior.PEESE)], function(p) { + class(p) <- class(p)[!class(p) %in% "prior.PEESE"] + return(p) + }) + plot_posterior(list(PEESE = PEESE), "PEESE", prior = TRUE, dots_prior = list(col = "grey")) + }) + + + mixed_posteriors_conditional1 <- as_mixed_posteriors( + mode = fit1, + parameters = "bias", + conditional = "PET", + force_plots = TRUE + ) + + mixed_posteriors_conditional2 <- as_mixed_posteriors( + mode = fit1, + parameters = "bias", + conditional = "PEESE", + force_plots = TRUE + ) + + mixed_posteriors_conditional3 <- as_mixed_posteriors( + mode = fit1, + parameters = "bias", + conditional = "PETPEESE", + force_plots = TRUE + ) + + mixed_posteriors_conditional4 <- as_mixed_posteriors( + mode = fit1, + parameters = "bias", + conditional = "omega", + force_plots = TRUE + ) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-conditional-posterior-PET", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + + PET <- mixed_posteriors_conditional1$bias[,"PET",drop=FALSE] + attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors_conditional1$bias)[!names(attributes(mixed_posteriors_conditional1$bias)) %in% c("dimnames", "dim")]) + attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) + attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { + class(p) <- class(p)[!class(p) %in% "prior.PET"] + return(p) + }) + + plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-conditional-posterior-PEESE", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + + PEESE <- mixed_posteriors_conditional2$bias[,"PEESE",drop=FALSE] + attributes(PEESE) <- c(attributes(PEESE), attributes(mixed_posteriors_conditional1$bias)[!names(attributes(mixed_posteriors_conditional1$bias)) %in% c("dimnames", "dim")]) + attr(PEESE, "prior_list")[!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(1:sum(!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)), function(i) prior("point", list(0))) + attr(PEESE, "prior_list")[ sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(attr(PEESE, "prior_list")[sapply(attr(PEESE, "prior_list"), is.prior.PEESE)], function(p) { + class(p) <- class(p)[!class(p) %in% "prior.PEESE"] + return(p) + }) + + plot_posterior(list(PEESE = PEESE), "PEESE", prior = TRUE, dots_prior = list(col = "grey")) + }) + +}) + + + + + diff --git a/tests/testthat/test-priors-print.R b/tests/testthat/test-priors-print.R index 5f9f120..c9e6376 100644 --- a/tests/testthat/test-priors-print.R +++ b/tests/testthat/test-priors-print.R @@ -168,7 +168,7 @@ test_that("Prior print function works", { "alternative:", " (1/3) * Normal(mean = 0, sd = 1)", " (1/3) * Normal(mean = -3, sd = 1)", " (1/3) * Gamma(shape = 5, rate = 10)" )) expect_equal(utils::capture.output(print(p23, short_name = TRUE)), c( - "alternative:", " (1/7) * N(0, 1)", "null:", " (5/7) * N(-3, 1)", " (1/7) * G(5, 10)" + "alternative:", " (1/7) * N(-3, 1)", "null:", " (5/7) * N(0, 1)", " (1/7) * G(5, 10)" )) expect_equal(utils::capture.output(print(p24)), c( "b:", " (1/6) * Normal(0, 1)", "a:", " (5/6) * Normal(-3, 1)" From 3be3c40921d2da949d62443e3f6de8b4b3d72688 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 11 Dec 2025 15:25:48 +0100 Subject: [PATCH 10/38] update coverage --- R/priors-density.R | 2 +- .../stan_estimates_basic2.txt | 8 + .../plot-factor-with-spike-trans-settings.svg | 71 ++++++ .../plot-factor-with-spike-trans.svg | 69 ++++++ .../plot-models-order-trans-prior.svg | 77 +++++++ .../plot-models-order-trans.svg | 75 +++++++ .../plot-models-orthonormal-2.svg | 199 +++++++++++++++++ .../plot-models-orthonormal-3.svg | 210 ++++++++++++++++++ .../priors-density/prior-density-4-5.svg | 57 +++++ .../priors-density/prior-density-5-1.svg | 69 ++++++ .../priors-density/prior-density-5-2.svg | 69 ++++++ .../priors-density/prior-density-5-3.svg | 67 ++++++ .../_snaps/priors-plot/priors-plot-11-5-1.svg | 62 ++++++ .../_snaps/priors-plot/priors-plot-14-1.svg | 55 +++++ .../_snaps/priors-plot/priors-plot-15-1.svg | 72 +++--- .../_snaps/priors-plot/priors-plot-15-10.svg | 132 +++++------ .../_snaps/priors-plot/priors-plot-15-11.svg | 136 ++++++------ .../_snaps/priors-plot/priors-plot-15-12.svg | 107 +++++++++ .../_snaps/priors-plot/priors-plot-15-13.svg | 90 ++++++++ .../_snaps/priors-plot/priors-plot-15-2.svg | 72 +++--- .../_snaps/priors-plot/priors-plot-15-3.svg | 72 +++--- .../_snaps/priors-plot/priors-plot-15-4.svg | 72 +++--- .../_snaps/priors-plot/priors-plot-15-5.svg | 76 ++++--- .../_snaps/priors-plot/priors-plot-15-6.svg | 132 +++++------ .../_snaps/priors-plot/priors-plot-15-7.svg | 132 +++++------ .../_snaps/priors-plot/priors-plot-15-8.svg | 132 +++++------ .../_snaps/priors-plot/priors-plot-15-9.svg | 131 +++++------ .../_snaps/priors-plot/priors-plot-17-1.svg | 57 +++++ .../_snaps/priors-plot/priors-plot-20-5-1.svg | 95 ++++++++ .../_snaps/priors/prior-mixture-6.svg | 129 +++++++++++ .../_snaps/priors/prior-mixture-7.svg | 126 +++++++++++ .../_snaps/priors/prior-mixture-8.svg | 142 ++++++++++++ tests/testthat/test-00-model-fits.R | 16 ++ tests/testthat/test-JAGS-ensemble-plots.R | 10 - tests/testthat/test-JAGS-summary-tables.R | 3 + .../test-model-averaging-plots-edge-cases.R | 70 +++--- tests/testthat/test-priors-density.R | 11 + tests/testthat/test-priors-plot.R | 11 +- tests/testthat/test-priors.R | 33 +++ 39 files changed, 2550 insertions(+), 599 deletions(-) create mode 100644 tests/results/JAGS-summary-tables/stan_estimates_basic2.txt create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg create mode 100644 tests/testthat/_snaps/priors-density/prior-density-4-5.svg create mode 100644 tests/testthat/_snaps/priors-density/prior-density-5-1.svg create mode 100644 tests/testthat/_snaps/priors-density/prior-density-5-2.svg create mode 100644 tests/testthat/_snaps/priors-density/prior-density-5-3.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-11-5-1.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-14-1.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-15-12.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-15-13.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-17-1.svg create mode 100644 tests/testthat/_snaps/priors-plot/priors-plot-20-5-1.svg create mode 100644 tests/testthat/_snaps/priors/prior-mixture-6.svg create mode 100644 tests/testthat/_snaps/priors/prior-mixture-7.svg create mode 100644 tests/testthat/_snaps/priors/prior-mixture-8.svg diff --git a/R/priors-density.R b/R/priors-density.R index f182c57..e504820 100644 --- a/R/priors-density.R +++ b/R/priors-density.R @@ -81,7 +81,7 @@ density.prior <- function(x, }else if(!individual & is.prior.weightfunction(x)){ x_range <- c(0, 1) }else if(is.prior.spike_and_slab(x)){ - x_range <- range(.get_spike_and_slab_variable(x)[["truncation"]]["lower"], .get_spike_and_slab_variable(x)[["truncation"]]["upper"], 0) + x_range <- range(c(range(.get_spike_and_slab_variable(x), if(is.null(x_range_quant)) .range.prior_quantile_default(.get_spike_and_slab_variable(x)) else x_range_quant), 0)) }else if(is.prior.discrete(x)){ x_range <- c(x[["truncation"]]["lower"], x[["truncation"]]["upper"]) }else{ diff --git a/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt b/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt new file mode 100644 index 0000000..87caabb --- /dev/null +++ b/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt @@ -0,0 +1,8 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 4.514 1.718 0.811 4.157 2.159 1.06422 0.620 37 1.012 +sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 +pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg new file mode 100644 index 0000000..52ac589 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + +Density + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 + + + + + + + +0 +0.05 +0.1 +0.15 +0.2 +0.25 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg new file mode 100644 index 0000000..dfa1de5 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + +Density + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + + +0 +0.1 +0.2 +0.3 +0.4 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg new file mode 100644 index 0000000..42fcda7 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +m + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.19 [0.80, 1.80] +1.22 [0.82, 1.88] +BF = 0.57 [0.50 -> 0.36] +1.17 [0.78, 1.64] +BF = 1.76 [0.50 -> 0.64] + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg new file mode 100644 index 0000000..bc5589b --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + +0.6 +0.8 +1.0 +1.2 +1.4 +1.6 +1.8 +2.0 +m + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.19 [0.80, 1.80] +1.22 [0.82, 1.88] +BF = 0.57 [0.50 -> 0.36] +1.17 [0.78, 1.64] +BF = 1.76 [0.50 -> 0.64] + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg new file mode 100644 index 0000000..3686fbd --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg @@ -0,0 +1,199 @@ + + + + + + + + + + + + + + + + + + + +0.6 +0.8 +1.0 +1.2 +1.4 +1.6 + + + + + + + +(mu) x_fac3o [dif: A] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +1.02 [0.82, 1.27] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.4 +0.6 +0.8 +1.0 +1.2 +1.4 +1.6 + + + + + + + +(mu) x_fac3o [dif: B] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +0.72 [0.58, 0.90] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + +0.6 +0.8 +1.0 +1.2 +1.4 +1.6 +1.8 + + + + + + + +(mu) x_fac3o [dif: C] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +1.36 [1.09, 1.68] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg new file mode 100644 index 0000000..a278ee6 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg @@ -0,0 +1,210 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +(mu) x_fac3o [dif: A] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +1.02 [0.82, 1.27] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +(mu) x_fac3o [dif: B] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +0.72 [0.58, 0.90] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + +(mu) x_fac3o [dif: C] + + + + + + +Model-Averaged +Model 1 +Model 2 + + + + + + +1.00 [0.62, 1.59] +1.00 [1.00, 1.00] +BF = 0.07 [0.50 -> 0.06] +1.36 [1.09, 1.68] +BF = 15.08 [0.50 -> 0.94] + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors-density/prior-density-4-5.svg b/tests/testthat/_snaps/priors-density/prior-density-4-5.svg new file mode 100644 index 0000000..5401c8f --- /dev/null +++ b/tests/testthat/_snaps/priors-density/prior-density-4-5.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +-1 +0 +1 + + + + + + +0.1 +0.2 +0.3 +0.4 +0.5 + +density("orthonormal contrast: mNormal(0, 1)") +N = 1000 Bandwidth = +Density + + + + + diff --git a/tests/testthat/_snaps/priors-density/prior-density-5-1.svg b/tests/testthat/_snaps/priors-density/prior-density-5-1.svg new file mode 100644 index 0000000..d22e9b3 --- /dev/null +++ b/tests/testthat/_snaps/priors-density/prior-density-5-1.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + +density("PET ~ Normal(0, 1)[0, Inf]") +N = 1000 Bandwidth = +Density + + + + + diff --git a/tests/testthat/_snaps/priors-density/prior-density-5-2.svg b/tests/testthat/_snaps/priors-density/prior-density-5-2.svg new file mode 100644 index 0000000..f150996 --- /dev/null +++ b/tests/testthat/_snaps/priors-density/prior-density-5-2.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 + +density("PET ~ Normal(0, 1)[0, Inf]") +N = 1000 Bandwidth = +Density + + + + + diff --git a/tests/testthat/_snaps/priors-density/prior-density-5-3.svg b/tests/testthat/_snaps/priors-density/prior-density-5-3.svg new file mode 100644 index 0000000..7efe42a --- /dev/null +++ b/tests/testthat/_snaps/priors-density/prior-density-5-3.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + +density("PET ~ Normal(0, 1)[0, Inf]") +N = 1000 Bandwidth = +Density + + + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-11-5-1.svg b/tests/testthat/_snaps/priors-plot/priors-plot-11-5-1.svg new file mode 100644 index 0000000..6901790 --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-11-5-1.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 +20 + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +dif + +orthonormal contrast: +mNormal +(0, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-14-1.svg b/tests/testthat/_snaps/priors-plot/priors-plot-14-1.svg new file mode 100644 index 0000000..fc7f65c --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-14-1.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + +treatment contrast: +Beta +(2, 3) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-1.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-1.svg index 81fccef..2569a59 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-1.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-1.svg @@ -18,38 +18,47 @@ +Density - - - - + + + + + -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - +-3 +-2 +-1 +0 +1 +2 +3 + - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - -Bernoulli -(0.33) -Probability + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability @@ -57,9 +66,8 @@ - - - - + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-10.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-10.svg index 118d3f5..94f4d30 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-10.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-10.svg @@ -21,73 +21,77 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -Bernoulli -(0.33) -Probability +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density +Probability diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-11.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-11.svg index 4df5fdd..d7c2258 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-11.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-11.svg @@ -21,76 +21,78 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -μ - -~ - -Bernoulli -(0.33) -Probability +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +mu +Density +Probability diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-12.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-12.svg new file mode 100644 index 0000000..6c4faa2 --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-12.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +0.35 + + + + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + +0 +5 +10 +15 +20 +25 +mu +Density +Probability + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-13.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-13.svg new file mode 100644 index 0000000..037d99b --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-13.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + +1 +2 +3 +4 +5 +mu +Density +Probability + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-2.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-2.svg index 8a048a3..2569a59 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-2.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-2.svg @@ -18,38 +18,47 @@ +Density - - - - + + + + + -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - +-3 +-2 +-1 +0 +1 +2 +3 + - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - -Br -(0.33) -Probability + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability @@ -57,9 +66,8 @@ - - - - + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-3.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-3.svg index b4fb12d..2569a59 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-3.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-3.svg @@ -18,38 +18,47 @@ +Density - - - - + + + + + -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - +-3 +-2 +-1 +0 +1 +2 +3 + - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - -Bernoulli -(probability = 0.33) -Probability + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability @@ -57,9 +66,8 @@ - - - - + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-4.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-4.svg index c06549e..74fd0e0 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-4.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-4.svg @@ -18,38 +18,47 @@ +Density - - - - + + + + + -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - +-3 +-2 +-1 +0 +1 +2 +3 + - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - -Bernoulli -(0.33) -Probability + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability @@ -57,9 +66,8 @@ - - - - + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-5.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-5.svg index f08988b..17d6f75 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-5.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-5.svg @@ -18,41 +18,48 @@ +name +Density - - - - + + + + + -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - +-3 +-2 +-1 +0 +1 +2 +3 + - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -name - -~ - -Bernoulli -(0.33) -Probability + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability @@ -60,9 +67,8 @@ - - - - + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-6.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-6.svg index c869b7a..eb3336b 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-6.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-6.svg @@ -21,73 +21,77 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -Bernoulli -(0.33) -Probability +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density +Probability diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-7.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-7.svg index 68e6c30..eb3336b 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-7.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-7.svg @@ -21,73 +21,77 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -Br -(0.33) -Probability +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density +Probability diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-8.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-8.svg index 159eb00..eb3336b 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-8.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-8.svg @@ -21,73 +21,77 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -Bernoulli -(probability = 0.33) -Probability +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density +Probability diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-15-9.svg b/tests/testthat/_snaps/priors-plot/priors-plot-15-9.svg index 5bfbc7c..eb4eb75 100644 --- a/tests/testthat/_snaps/priors-plot/priors-plot-15-9.svg +++ b/tests/testthat/_snaps/priors-plot/priors-plot-15-9.svg @@ -21,72 +21,79 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -xlab +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +xlab ylab -main +Probability +main diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-17-1.svg b/tests/testthat/_snaps/priors-plot/priors-plot-17-1.svg new file mode 100644 index 0000000..4f297b7 --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-17-1.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + +independent contrast: +Uniform +(-0.5, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors-plot/priors-plot-20-5-1.svg b/tests/testthat/_snaps/priors-plot/priors-plot-20-5-1.svg new file mode 100644 index 0000000..0acf81b --- /dev/null +++ b/tests/testthat/_snaps/priors-plot/priors-plot-20-5-1.svg @@ -0,0 +1,95 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + + +0.3 +0.4 +0.5 +0.6 +0.7 +0.8 +0.9 +1.0 +dif + +orthonormal contrast: +mSpike +(0) +Probability + + diff --git a/tests/testthat/_snaps/priors/prior-mixture-6.svg b/tests/testthat/_snaps/priors/prior-mixture-6.svg new file mode 100644 index 0000000..fa4f580 --- /dev/null +++ b/tests/testthat/_snaps/priors/prior-mixture-6.svg @@ -0,0 +1,129 @@ + + + + + + + + + + + + +( +1 +/ +3 +) + +* + +Spike +(0) + ++ + +( +1 +/ +3 +) + +* + +Spike +(1) + ++ + +( +1 +/ +3 +) + +* + +Gamma +(5, 10) +rng(p5, 10000, transform_factor_samples = FALSE) +Density + + + + + +0.0 +0.5 +1.0 +1.5 + + + + + + + + + +0 +1 +2 +3 +4 +5 +6 +7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors/prior-mixture-7.svg b/tests/testthat/_snaps/priors/prior-mixture-7.svg new file mode 100644 index 0000000..dbd51eb --- /dev/null +++ b/tests/testthat/_snaps/priors/prior-mixture-7.svg @@ -0,0 +1,126 @@ + + + + + + + + + + + + +( +1 +/ +3 +) + +* + +orthonormal contrast: +mSpike +(0) + ++ + +( +1 +/ +3 +) + +* + +orthonormal contrast: +mSpike +(1) + ++ + +( +1 +/ +3 +) + +* + +orthonormal contrast: +mNormal +(0, 1) +rng(p6, 10000, transform_factor_samples = FALSE) +Density + + + + + +-2 +0 +2 +4 + + + + + +0.0 +0.5 +1.0 +1.5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/priors/prior-mixture-8.svg b/tests/testthat/_snaps/priors/prior-mixture-8.svg new file mode 100644 index 0000000..9fb897d --- /dev/null +++ b/tests/testthat/_snaps/priors/prior-mixture-8.svg @@ -0,0 +1,142 @@ + + + + + + + + + + + + +( +1 +/ +3 +) + +* + +treatment contrast: +Spike +(0, 2) + ++ + +( +1 +/ +3 +) + +* + +treatment contrast: +Spike +(1, 2) + ++ + +( +1 +/ +3 +) + +* + +treatment contrast: +Beta +(3, 1, 2) +rng(p7, 10000, transform_factor_samples = FALSE) +Density + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +5 +10 +15 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 0dd1050..68c7234 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -1357,9 +1357,25 @@ test_that("Advanced JAGS_fit features work correctly", { } }" + log_posterior <- function(parameters, data){ + return(stats::dnorm(parameters[["g"]], log = TRUE)) + #return(sum(stats::dnorm(data$x, mean = parameters[["m"]], sd = parameters[["s"]], log = TRUE))) + } + add_l <- c("g" = -Inf) + add_u <- c("g" = Inf) + fit_add_parameters <- JAGS_fit(model_syntax_add_param, data, priors_list, add_parameters = "g", chains = 2, adapt = 100, burnin = 100, sample = 300, seed = 1) + marglik_fit_add_parameters <- JAGS_bridgesampling( + fit = fit_add_parameters, + log_posterior = log_posterior, + data = data, + prior_list = priors_list, + add_parameters = "g", + add_bounds = list("lb" = add_l, "ub" = add_u) + ) + result <- save_fit(fit_add_parameters, "fit_add_parameters", simple_priors = TRUE, add_parameters = TRUE, note = "Model with additional monitored parameter 'g' not in prior_list") diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index e4a71bc..e094c09 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -266,7 +266,6 @@ test_that("prior plot functions (PET-PEESE) work", { }) }) - test_that("prior plot functions (weightfunctions) work", { ### simple cases @@ -350,7 +349,6 @@ test_that("prior plot functions (weightfunctions) work", { }) - test_that("prior plot functions (orthonormal) work", { ### simple cases @@ -404,7 +402,6 @@ test_that("prior plot functions (orthonormal) work", { }) - test_that("prior plot functions (treatment) work", { ### simple cases @@ -454,7 +451,6 @@ test_that("prior plot functions (treatment) work", { }) - test_that("prior plot functions (independent) work", { ### simple cases @@ -495,7 +491,6 @@ test_that("prior plot functions (independent) work", { }) - test_that("prior plot functions (meandif) work", { ### simple cases @@ -549,7 +544,6 @@ test_that("prior plot functions (meandif) work", { }) - test_that("posterior plot functions (simple) work", { skip_if_not_installed("rjags") @@ -613,7 +607,6 @@ test_that("posterior plot functions (simple) work", { }) }) - test_that("posterior plot functions (PET-PEESE) work", { skip_if_not_installed("rjags") @@ -685,7 +678,6 @@ test_that("posterior plot functions (PET-PEESE) work", { }) - test_that("posterior plot functions (weightfunctions) work", { skip_if_not_installed("rjags") @@ -762,7 +754,6 @@ test_that("posterior plot functions (weightfunctions) work", { }) - test_that("posterior plot functions (orthonormal) work", { skip_on_os(c("mac", "linux", "solaris")) @@ -1215,7 +1206,6 @@ test_that("posterior plot model averaging based on simple single JAGS models (f }) }) - test_that("posterior plot model averaging based on complex bias mixture model (PET + PEESE + weightfunction)", { skip_if_not_installed("rjags") diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 22d48c5..6352a17 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -287,4 +287,7 @@ test_that("stan_estimates_table works with stored fit", { stan_summary <- stan_estimates_table(fit_stan) test_reference_table(stan_summary, "stan_estimates_basic.txt") + stan_summary2 <- stan_estimates_table(fit_stan, transformations = list("mu" = list(fun = exp))) + test_reference_table(stan_summary2, "stan_estimates_basic2.txt") + }) diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R index 2cd6352..54a1243 100644 --- a/tests/testthat/test-model-averaging-plots-edge-cases.R +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -370,6 +370,16 @@ test_that(".plot_prior_list.factor handles point priors within factor", { plot_prior_list(prior_list) }) + # This should handle mixed plotting + vdiffr::expect_doppelganger("plot-factor-with-spike-trans", function() { + plot_prior_list(prior_list, transformation = "tanh") + }) + + # This should handle mixed plotting + vdiffr::expect_doppelganger("plot-factor-with-spike-trans-settings", function() { + plot_prior_list(prior_list, transformation = "tanh", transformation_settings = T, xlim = c(-0.5, 0.5)) + }) + }) test_that(".plot_prior_list.factor handles transformation", { @@ -440,6 +450,16 @@ test_that("plot_models handles order argument", { BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "probability")) }) + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-trans", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp") + }) + + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-trans-prior", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp") + }) + }) @@ -490,46 +510,20 @@ test_that("plot_models handles orthonormal priors", { BayesTools::plot_models(models, mixed_posteriors, inference, factor_params) }) -}) - - -# ============================================================================ # -# SECTION 11: .plot_data_samples.factor with transformation -# ============================================================================ # -test_that("plot_posterior handles factor samples with transformation", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load orthonormal models with marginal likelihoods - fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) - - fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) - - models <- list( - list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), - list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) - ) - - # Get factor parameter names from the model - prior_list <- attr(fit_orthonormal_1, "prior_list") - factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = factor_params, - is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), - seed = 1, - n_samples = 1000 - ) + vdiffr::expect_doppelganger("plot-models-orthonormal-2", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp") + }) - # Test with transformation on factor posterior - vdiffr::expect_doppelganger("plot-posterior-factor-transformation", function() { - suppressMessages(BayesTools::plot_posterior(mixed_posteriors, factor_params, transformation = "exp")) + vdiffr::expect_doppelganger("plot-models-orthonormal-3", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp", prior = TRUE) }) }) + diff --git a/tests/testthat/test-priors-density.R b/tests/testthat/test-priors-density.R index 2550a4f..68b3460 100644 --- a/tests/testthat/test-priors-density.R +++ b/tests/testthat/test-priors-density.R @@ -30,6 +30,17 @@ test_that("Prior density function density", { vdiffr::expect_doppelganger("prior-density-4-2", function()plot(density(prior_factor("normal", list(0, 1), list(0, Inf), contrast = "treatment")))) vdiffr::expect_doppelganger("prior-density-4-3", function()suppressWarnings(plot(density(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"))))) vdiffr::expect_doppelganger("prior-density-4-4", function()suppressWarnings(plot(density(prior_factor("mnormal", list(0, 1), contrast = "meandif"))))) + vdiffr::expect_doppelganger("prior-density-4-5", function()suppressWarnings(plot(density(prior_factor("mnormal", list(0, 1), contrast = "orthonormal"), force_samples = TRUE)))) + + # PET + vdiffr::expect_doppelganger("prior-density-5-1", function()plot(density(prior_PET("normal", list(0, 1))))) + vdiffr::expect_doppelganger("prior-density-5-2", function()plot(density(prior_PET("normal", list(0, 1)), force_samples = TRUE))) + vdiffr::expect_doppelganger("prior-density-5-3", function()plot(density(prior_PET("normal", list(0, 1)), force_samples = TRUE, transformation = "tanh"))) + + # no plotting etc implemented + xd <- density(prior_spike_and_slab(prior("normal", list(0, 1)))) + expect_s3_class(xd, "density.prior.spike_and_slab") + }) diff --git a/tests/testthat/test-priors-plot.R b/tests/testthat/test-priors-plot.R index d8a27f0..5aec244 100644 --- a/tests/testthat/test-priors-plot.R +++ b/tests/testthat/test-priors-plot.R @@ -80,7 +80,7 @@ test_that("Prior plot (point) function works", { test_that("Prior plot (spike and slab) function works", { # check the default options - p1 <- prior("bernoulli", list(.33)) + p1 <- prior_spike_and_slab(prior("Normal", list(0, 1))) vdiffr::expect_doppelganger("priors-plot-15-1", function()plot(p1)) vdiffr::expect_doppelganger("priors-plot-15-2", function()plot(p1, short_name = TRUE)) @@ -93,7 +93,10 @@ test_that("Prior plot (spike and slab) function works", { vdiffr::expect_doppelganger("priors-plot-15-8", plot(p1, parameter_names = TRUE, plot_type = "ggplot")) vdiffr::expect_doppelganger("priors-plot-15-9", plot(p1, xlab = "xlab", ylab = "ylab", main = "main", plot_type = "ggplot")) vdiffr::expect_doppelganger("priors-plot-15-10", plot(p1, lwd = 3, lty = 3, col = "blue", plot_type = "ggplot")) - vdiffr::expect_doppelganger("priors-plot-15-11", plot(p1, par_name = bquote(mu), plot_type = "ggplot")) + vdiffr::expect_doppelganger("priors-plot-15-11", plot(p1, par_name = "mu", plot_type = "ggplot")) + vdiffr::expect_doppelganger("priors-plot-15-12", plot(p1, par_name = "mu", plot_type = "ggplot", transformation = "exp")) + vdiffr::expect_doppelganger("priors-plot-15-13", plot(p1, par_name = "mu", plot_type = "ggplot", transformation = "exp", transformation_settings = T, xlim = c(1, 5))) + }) @@ -151,9 +154,11 @@ test_that("Prior plot (orthonormal) function works", { vdiffr::expect_doppelganger("priors-plot-11-2", function()plot(p11.2)) vdiffr::expect_doppelganger("priors-plot-11-3", plot(p11.3, plot_type = "ggplot")) vdiffr::expect_doppelganger("priors-plot-11-5", function()plot(p11.5)) + vdiffr::expect_doppelganger("priors-plot-11-5-1", function()suppressMessages(plot(p11.5, transformation = "exp"))) vdiffr::expect_doppelganger("priors-plot-12-9", function()plot(p12.9)) vdiffr::expect_doppelganger("priors-plot-20-3", function()plot(p20.3)) vdiffr::expect_doppelganger("priors-plot-20-5", plot(p20.5, plot_type = "ggplot")) + vdiffr::expect_doppelganger("priors-plot-20-5-1", plot(p20.5, plot_type = "ggplot", transformation = "exp")) }) @@ -166,6 +171,7 @@ test_that("Prior plot (treatment) function works", { vdiffr::expect_doppelganger("priors-plot-13-1", function()plot(p13)) vdiffr::expect_doppelganger("priors-plot-13-2", plot(p13, plot_type = "ggplot")) vdiffr::expect_doppelganger("priors-plot-14", function()plot(p14)) + vdiffr::expect_doppelganger("priors-plot-14-1", function()plot(p14, transformation = "tanh")) vdiffr::expect_doppelganger("priors-plot-21", function()plot(p21)) }) @@ -179,6 +185,7 @@ test_that("Prior plot (independent) function works", { vdiffr::expect_doppelganger("priors-plot-16-1", function()plot(p15)) vdiffr::expect_doppelganger("priors-plot-16-2", plot(p15, plot_type = "ggplot")) vdiffr::expect_doppelganger("priors-plot-17", function()plot(p16)) + vdiffr::expect_doppelganger("priors-plot-17-1", function()plot(p16, transformation = "exp")) vdiffr::expect_doppelganger("priors-plot-22", function()plot(p22)) }) diff --git a/tests/testthat/test-priors.R b/tests/testthat/test-priors.R index ac60ffe..8e94887 100644 --- a/tests/testthat/test-priors.R +++ b/tests/testthat/test-priors.R @@ -377,6 +377,39 @@ test_that("Prior mixture distributions work", { vdiffr::expect_doppelganger("prior-mixture-4", function()hist(rng(p4, 10000, transform_factor_samples = FALSE), main = print(p4, plot = T), breaks = 50, freq = FALSE)) vdiffr::expect_doppelganger("prior-mixture-5", function()hist(rng(p4, 10000, transform_factor_samples = TRUE), main = print(p4, plot = T), breaks = 50, freq = FALSE)) + # mixture with none and spikes + p5 <- prior_mixture( + list( + prior_none(), + prior("spike", list(1)), + prior("gamma", list(5, 10)) + ) + ) + p6 <- prior_mixture( + list( + prior_none(), + prior("spike", list(1)), + prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + ), components = c("a", "b", "c") + ) + p7 <- prior_mixture( + list( + prior_none(), + prior("spike", list(1)), + prior_factor("beta", list(3, 1), contrast = "treatment") + ) + ) + for(i in seq_along(p6)){ + p6[[i]]$parameters[["K"]] <- 2 + } + for(i in seq_along(p7)){ + p7[[i]]$parameters[["K"]] <- 2 + } + + vdiffr::expect_doppelganger("prior-mixture-6", function()hist(rng(p5, 10000, transform_factor_samples = FALSE), main = print(p5, plot = T), breaks = 50, freq = FALSE)) + vdiffr::expect_doppelganger("prior-mixture-7", function()hist(rng(p6, 10000, transform_factor_samples = FALSE), main = print(p6, plot = T), breaks = 50, freq = FALSE)) + vdiffr::expect_doppelganger("prior-mixture-8", function()hist(rng(p7, 10000, transform_factor_samples = FALSE), main = print(p7, plot = T), breaks = 50, freq = FALSE)) + }) test_that("Priors with expressions work", { From 5a52ffdf3a1d85178fb2d7c36c8a6e8cd9454a57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 11 Dec 2025 17:44:25 +0100 Subject: [PATCH 11/38] update coverage --- DESCRIPTION | 2 +- NEWS.md | 8 + R/JAGS-formula.R | 11 +- R/summary-tables.R | 18 +- .../advanced_orthonormal_transform2.txt | 4 + .../fit_complex_bias_runjags_estimates.txt | 9 + ...random_factor_slope2_runjags_estimates.txt | 7 + ...random_factor_slope3_runjags_estimates.txt | 9 + .../runjags_summary_complex2.txt | 12 + .../runjags_summary_complex3.txt | 28 ++ .../marginal-factor-independent-hist.svg | 363 ++++++++++++++++++ .../marginal-wf-onesided-hist.svg | 168 ++++++++ .../plot-models-order-trans-ggplot.svg | 0 .../plot-models-order-trans-prior-ggplot.svg | 0 ...-prior-list-orthonormal-spike-and-slab.svg | 77 ++++ .../plot-prior-list-orthonormal-spike.svg | 48 +++ .../plot-prior-list-orthonormal2-ggplot.svg | 85 ++++ tests/testthat/test-00-model-fits.R | 49 +++ tests/testthat/test-JAGS-fit-edge-cases.R | 31 +- tests/testthat/test-JAGS-formula.R | 4 + .../test-JAGS-marginal-distributions.R | 69 ++++ tests/testthat/test-JAGS-summary-tables.R | 19 +- .../test-model-averaging-plots-edge-cases.R | 34 ++ 23 files changed, 1036 insertions(+), 19 deletions(-) create mode 100644 tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt create mode 100644 tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_summary_complex2.txt create mode 100644 tests/results/JAGS-summary-tables/runjags_summary_complex3.txt create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg create mode 100644 tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior-ggplot.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg diff --git a/DESCRIPTION b/DESCRIPTION index 6e39c9b..47f5a64 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: BayesTools Title: Tools for Bayesian Analyses -Version: 0.2.23 +Version: 0.2.24 Description: Provides tools for conducting Bayesian analyses and Bayesian model averaging (Kass and Raftery, 1995, , Hoeting et al., 1999, ). The package contains diff --git a/NEWS.md b/NEWS.md index 1b0ca47..31fe3fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# version 0.2.24 +### Features +- major refactoring and speed-up of unit tests + +### Fixes +- fixes incorrect ordering the printed mixture priors +- fixes formula with no intercepts coded as `0` (instead of only `-1`) + # version 0.2.23 ### Fixes - `JAGS_diagnostics` functions now correctly handle factor parameters nested within mixture priors diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index f672561..5a7b6db 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -707,12 +707,17 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ return(trimws(sub("\\|.*$", "", formula))) } .add_intercept_to_formula <- function(formula){ - # converts formula with -1 (no intercept) back to formula with intercept - # by removing the -1 term + # converts formula with -1 or 0 (no intercept) back to formula with intercept + # by removing the -1 or 0 term formula_str <- paste(deparse(formula), collapse = " ") - # Remove various forms of -1 or + -1 + # Remove various forms of -1, + -1, 0, or + 0 formula_str <- gsub("\\s*\\-\\s*1\\s*", "", formula_str) formula_str <- gsub("\\s*\\+\\s*\\-\\s*1\\s*", "", formula_str) + formula_str <- gsub("\\s*\\+\\s*0\\s*", "", formula_str) + # Handle 0 at the start (e.g., "~ 0 + x") + formula_str <- gsub("~\\s*0\\s*\\+\\s*", "~ ", formula_str) + # Handle 0 alone (e.g., "~ 0") + formula_str <- gsub("~\\s*0\\s*$", "~ 1", formula_str) # Handle case where formula becomes empty (just "~") if(grepl("^\\s*~\\s*$", formula_str)){ diff --git a/R/summary-tables.R b/R/summary-tables.R index 59284e7..71d95fe 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -753,10 +753,10 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0 })] }) - - cleaned <- .remove_auxiliary_parameters(model_samples, prior_list, remove_params_vec) + + cleaned <- .remove_auxiliary_parameters(model_samples, prior_list, remove_params_vec) model_samples <- cleaned$model_samples - prior_list <- cleaned$prior_list + prior_list <- cleaned$prior_list # simplify mixture and spike and slab priors to simple priors # the samples and summary can be dealt with as any other prior (i.e., transformations later) @@ -764,10 +764,10 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, if(is.prior.spike_and_slab(prior_list[[par]])){ # process spike and slab using helper function - processed <- .process_spike_and_slab(model_samples, prior_list, par, conditional, remove_inclusion, warnings) + processed <- .process_spike_and_slab(model_samples, prior_list, par, conditional, remove_inclusion, warnings) model_samples <- processed$model_samples - prior_list <- processed$prior_list - warnings <- processed$warnings + prior_list <- processed$prior_list + warnings <- processed$warnings }else if(is.prior.mixture(prior_list[[par]])){ @@ -852,7 +852,11 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, }else{ # prepare parameter names - par_names <- par + if(inherits(prior_list[[par]], "prior.factor_mixture")){ + par_names <- .JAGS_prior_factor_names(par, prior_list[[par]]) + }else{ + par_names <- par + } # change the samples between conditional/averaged based on the preferences if(conditional){ diff --git a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt new file mode 100644 index 0000000..37d8ffa --- /dev/null +++ b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt @@ -0,0 +1,4 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +p1 [dif: 1] 1.437 1.295 0.196 1.062 4.979 0.04097 0.032 1000 1.009 +p1 [dif: 2] 1.326 1.230 0.199 0.972 4.605 0.03891 0.032 1000 1.000 +p1 [dif: 3] 1.376 1.289 0.212 0.991 4.776 0.04076 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt new file mode 100644 index 0000000..13ec7aa --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt @@ -0,0 +1,9 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +mu 1.019 0.588 0.243 0.891 2.460 0.02375 0.040 613 NA +bias (inclusion) 0.526 NA NA NA NA NA NA NA NA +PET 0.097 0.328 0.000 0.000 1.229 0.01465 0.045 500 NA +PEESE 0.166 0.583 0.000 0.000 2.134 0.02609 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.887 0.229 0.127 1.000 1.000 0.01024 0.045 500 NA +omega[0.05,0.975] 0.836 0.297 0.070 1.000 1.000 0.01328 0.045 500 NA +omega[0.975,1] 0.896 0.256 0.099 1.000 1.000 0.01146 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt new file mode 100644 index 0000000..b2eec47 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt @@ -0,0 +1,7 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.286 0.138 0.016 0.282 0.560 0.00610 0.044 513 1.007 +(mu) x_fac3[1] -0.345 0.185 -0.726 -0.340 0.013 0.00773 0.042 573 1.002 +(mu) x_fac3[2] 0.134 0.179 -0.228 0.136 0.493 0.00750 0.042 687 1.001 +sd((mu) intercept|id) 0.207 0.161 0.007 0.174 0.617 0.00938 0.058 294 1.004 +sd((mu) x_fac3|id) 0.257 0.165 0.013 0.239 0.615 0.01080 0.065 233 1.001 +sigma 1.105 0.086 0.952 1.098 1.276 0.00421 0.049 441 1.017 diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt new file mode 100644 index 0000000..f8c278e --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt @@ -0,0 +1,9 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) x_fac3[A] 0.433 0.190 0.060 0.433 0.824 0.00666 0.035 856 1.005 +(mu) x_fac3[B] 0.517 0.215 0.071 0.523 0.932 0.00901 0.042 608 1.002 +(mu) x_fac3[C] -0.081 0.248 -0.559 -0.074 0.396 0.00942 0.038 693 1.004 +(mu) _xREx__id_x_fac3 (inclusion) 0.339 NA NA NA NA NA NA NA NA +(mu) _xREx__id_x_fac3[A] 0.141 0.236 0.000 0.000 0.761 0.02420 0.102 92 1.101 +(mu) _xREx__id_x_fac3[B] 0.114 0.213 0.000 0.000 0.728 0.01809 0.085 134 1.078 +(mu) _xREx__id_x_fac3[C] 0.116 0.215 0.000 0.000 0.751 0.02141 0.099 101 1.013 +sigma 1.128 0.086 0.974 1.121 1.316 0.00407 0.048 443 1.002 diff --git a/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt b/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt new file mode 100644 index 0000000..6551bab --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt @@ -0,0 +1,12 @@ + Mean SD lCI Median uCI +mu 1.019 0.588 0.243 0.891 2.460 +bias (inclusion) 0.526 NA NA NA NA +PET 0.823 0.562 0.034 0.831 2.016 +PEESE 1.365 1.080 0.060 1.208 3.836 +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 +omega[0.025,0.05] 0.604 0.267 0.062 0.657 0.970 +omega[0.05,0.975] 0.427 0.272 0.018 0.408 0.937 +omega[0.975,1] 0.635 0.367 0.038 0.651 1.000 +Conditional summary for PET is based on 59 samples. +Conditional summary for PEESE is based on 61 samples. +Conditional summary for omega is based on 143 samples. diff --git a/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt b/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt new file mode 100644 index 0000000..79430be --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt @@ -0,0 +1,28 @@ + Mean SD lCI Median uCI +(mu) intercept (inclusion) 0.738 NA NA NA NA +(mu) intercept -0.140 0.049 -0.228 -0.143 -0.034 +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA +(mu) x_fac2t 0.068 0.062 -0.052 0.068 0.171 +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA +(mu) x_fac3t[1] 0.298 0.075 0.156 0.298 0.441 +(mu) x_fac3t[2] -0.014 0.076 -0.153 -0.011 0.134 +sigma (inclusion: normal) 0.422 NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA +sigma[normal] 0.800 0.035 0.729 0.800 0.868 +sigma[lognormal] 0.806 0.033 0.745 0.805 0.877 +bias (inclusion) 0.476 NA NA NA NA +PET 0.667 0.570 0.040 0.453 1.921 +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 +omega[0.025,0.05] 0.593 0.285 0.020 0.659 0.983 +omega[0.05,0.975] 0.419 0.284 0.017 0.363 0.947 +omega[0.975,1] 0.670 0.376 0.035 1.000 1.000 +Conditional summary for mu_intercept is based on 369 samples. +Conditional summary for mu_x_cont1 is based on 500 samples. +Conditional summary for mu_x_fac2t is based on 64 samples. +Conditional summary for mu_x_fac3t[1], mu_x_fac3t[2] is based on 366 samples. +Conditional summary for sigma[normal] is based on 211 samples. +Conditional summary for sigma[lognormal] is based on 289 samples. +Conditional summary for PET is based on 79 samples. +Conditional summary for omega is based on 159 samples. diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg new file mode 100644 index 0000000..8a2b113 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg @@ -0,0 +1,363 @@ + + + + + + + + + + + + + + + + + + + +p1[1] (level 1) +mixed_posteriors$p1[, 1] +Density + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 +1.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +p1[2] (level 2) +mixed_posteriors$p1[, 2] +Density + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +p1[3] (level 3) +mixed_posteriors$p1[, 3] +Density + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg new file mode 100644 index 0000000..388405d --- /dev/null +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg @@ -0,0 +1,168 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +mixed_posteriors$omega[, 1] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0.025,1] +mixed_posteriors$omega[, 2] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-ggplot.svg new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior-ggplot.svg new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg new file mode 100644 index 0000000..b5abd92 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + +Density + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + +0 +0.05 +0.1 +0.15 +0.2 +0.25 +0.3 +0.35 + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +Probability + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg new file mode 100644 index 0000000..7e3766b --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg @@ -0,0 +1,48 @@ + + + + + + + + + + + + +Probability + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + +0 +1 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg new file mode 100644 index 0000000..ea953ff --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +Density + + diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 68c7234..f19f89b 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -1112,9 +1112,58 @@ test_that("Random effects models fit correctly", { model_registry[["fit_random_factor_slope"]] <<- result$registry_entry fit_random_factor_slope <- result$fit + # Random factor slope with orthonormal contrast + formula_list_re_fac <- list(mu = ~ 1 + x_fac3 + (x_fac3 ||id)) + formula_data_list_re_fac <- list(mu = data_formula) + formula_prior_list_re_fac <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_fac3" = prior_factor("mnormal", list(0, 1)), + "intercept|id" = prior("normal", list(0, 1), list(0, 1)), + "x_fac3|id" = prior("normal", list(0, 1), list(0, 1)) + ) + ) + + fit_random_factor_slope2 <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_re_fac, formula_data_list = formula_data_list_re_fac, + formula_prior_list = formula_prior_list_re_fac, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_random_factor_slope2, "fit_random_factor_slope2", + formulas = TRUE, random_effects = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Random factor slopes with random intercept") + model_registry[["fit_random_factor_slope2"]] <<- result$registry_entry + fit_random_factor_slope2 <- result$fit + + + # Random factor slope independent spike and slab contrast + formula_list_re_fac <- list(mu = ~ -1 + x_fac3 + (x_fac3 - 1 ||id)) + formula_data_list_re_fac <- list(mu = data_formula) + formula_prior_list_re_fac <- list( + mu = list( + "x_fac3" = prior_factor("normal", list(0, 1), contrast = "independent"), + "x_fac3|id" = prior_spike_and_slab(prior("normal", list(0, 1), list(0, 1))) + ) + ) + + fit_random_factor_slope3 <- JAGS_fit( + model_syntax = model_syntax, data = data, prior_list = prior_list, + formula_list = formula_list_re_fac, formula_data_list = formula_data_list_re_fac, + formula_prior_list = formula_prior_list_re_fac, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 3) + result <- save_fit(fit_random_factor_slope3, "fit_random_factor_slope3", + formulas = TRUE, random_effects = TRUE, factor_priors = TRUE, simple_priors = TRUE, + note = "Random factor slopes with random intercept") + model_registry[["fit_random_factor_slope3"]] <<- result$registry_entry + fit_random_factor_slope3 <- result$fit + + + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_intercept.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_random_slope.RDS"))) expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope2.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope3.RDS"))) }) diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 79d4148..2362d59 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -245,19 +245,44 @@ test_that("JAGS_extend works correctly", { seed = 1 ) + # Test extending a fitted model + fit_extended2 <- JAGS_extend( + fit_simple, + autofit_control = list( + max_Rhat = 1.05, + min_ESS = 100, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 2, + max_extend = 2 + ), + parallel = 2, + cores = 2, + silent = TRUE, + seed = 1 + ) + # Check that the extended fit is still a BayesTools_fit expect_true(inherits(fit_extended, "BayesTools_fit")) expect_true(inherits(fit_extended, "runjags")) + expect_true(inherits(fit_extended2, "BayesTools_fit")) + expect_true(inherits(fit_extended2, "runjags")) # Check that attributes are preserved expect_true(!is.null(attr(fit_extended, "prior_list"))) expect_true(!is.null(attr(fit_extended, "model_syntax"))) + expect_true(!is.null(attr(fit_extended2, "prior_list"))) + expect_true(!is.null(attr(fit_extended2, "model_syntax"))) # Check that the extended fit has more samples - original_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_simple))) - extended_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_extended))) - expect_true(extended_samples >= original_samples) + original_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_simple))) + extended_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_extended))) + extended_samples2 <- nrow(suppressWarnings(coda::as.mcmc(fit_extended2))) + expect_true(extended_samples >= original_samples) + expect_true(extended_samples2 >= original_samples) }) diff --git a/tests/testthat/test-JAGS-formula.R b/tests/testthat/test-JAGS-formula.R index d48098f..9b5994e 100644 --- a/tests/testthat/test-JAGS-formula.R +++ b/tests/testthat/test-JAGS-formula.R @@ -323,4 +323,8 @@ test_that("-1 (no intercept) formula handling works correctly", { expect_equal(.add_intercept_to_formula(~ x + y - 1), ~ x + y) expect_equal(.add_intercept_to_formula(~ - 1), ~ 1) + expect_equal(.add_intercept_to_formula(~ x + 0), ~ x) + expect_equal(.add_intercept_to_formula(~ x + y + 0), ~ x + y) + expect_equal(.add_intercept_to_formula(~ 0), ~ 1) + }) diff --git a/tests/testthat/test-JAGS-marginal-distributions.R b/tests/testthat/test-JAGS-marginal-distributions.R index 12e4ed8..3ffa36e 100644 --- a/tests/testthat/test-JAGS-marginal-distributions.R +++ b/tests/testthat/test-JAGS-marginal-distributions.R @@ -1220,3 +1220,72 @@ test_that("Marginal distributions with spike and slab and mixture priors work", vdiffr::expect_doppelganger("plot_marginal-ss-int", plot_marginal(out$averaged, plot_type = "ggplot", parameter = "mu_intercept", prior = TRUE, dots_prior = list(lty = 2), xlim = c(-1, 1))) }) + + +test_that("Marginal distributions with one-sided weightfunction model work", { + + skip_on_os(c("mac", "linux", "solaris")) + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + # Load pre-fitted one-sided weightfunction model + fit_wf <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided.RDS")) + + mixed_posteriors <- as_mixed_posteriors( + model = fit_wf, + parameters = "omega" + ) + + # Not implemented for weightfunctions + # marginal_posterior(mixed_posteriors, parameter = "omega", prior_samples = TRUE) + temp_samples <- .as_mixed_priors.weightfunction(attr(fit_wf, "prior_list")[[1]], parameter = "omega") + + # Visual tests for weightfunction posteriors + vdiffr::expect_doppelganger("marginal-wf-onesided-hist", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + + par(mfrow = c(1, 2)) + hist(mixed_posteriors$omega[,1], freq = FALSE, main = "omega[0,0.025]", breaks = 50, xlim = c(0, 1)) + lines(density(temp_samples[,1])) + hist(mixed_posteriors$omega[,2], freq = FALSE, main = "omega[0.025,1]", breaks = 50, xlim = c(0, 1)) + }) + +}) + + +test_that("Marginal distributions with independent factor model work", { + + skip_on_os(c("mac", "linux", "solaris")) + skip_on_cran() + skip_if_not_installed("rjags") + + # Load pre-fitted independent factor model + fit_ind <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) + + mixed_posteriors <- as_mixed_posteriors( + model = fit_ind, + parameters = "p1" + ) + marginal_posteriors <- marginal_posterior(mixed_posteriors, parameter = "p1", prior_samples = TRUE) + + # Visual tests for independent factor posteriors + vdiffr::expect_doppelganger("marginal-factor-independent-hist", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfrow = oldpar[["mfrow"]])) + + par(mfrow = c(1, 3)) + hist(mixed_posteriors$p1[,1], freq = FALSE, main = "p1[1] (level 1)", breaks = 50) + lines(density(marginal_posteriors[[1]])) + lines(density(attr(marginal_posteriors[[3]], "prior_samples")), lty = 2) + hist(mixed_posteriors$p1[,2], freq = FALSE, main = "p1[2] (level 2)", breaks = 50) + lines(density(marginal_posteriors[[2]])) + lines(density(attr(marginal_posteriors[[2]], "prior_samples")), lty = 2) + hist(mixed_posteriors$p1[,3], freq = FALSE, main = "p1[3] (level 3)", breaks = 50) + lines(density(marginal_posteriors[[3]])) + lines(density(attr(marginal_posteriors[[3]], "prior_samples")), lty = 2) + }) + +}) + diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 6352a17..bf988a2 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -59,7 +59,9 @@ test_that("Summary table advanced features work correctly", { # Test 6: Orthonormal contrast transformations to differences from the mean fit_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_factor_orthonormal.RDS")) - runjags_summary_orthonormal <- suppressMessages(runjags_estimates_table(fit_orthonormal, transform_factors = TRUE)) + runjags_summary_orthonormal <- suppressMessages(runjags_estimates_table(fit_orthonormal, transform_factors = TRUE)) + runjags_summary_orthonormal2 <- suppressMessages(runjags_estimates_table(fit_orthonormal, transform_factors = TRUE, + transformations = list("p1" = list(fun = exp)))) # Test 7: Custom transformations with transform_factors = FALSE # Use a model with factor parameters for transformation testing @@ -77,8 +79,11 @@ test_that("Summary table advanced features work correctly", { remove_inclusion = TRUE )) - # Test 9: Custom probs parameter - runjags_summary_custom_probs <- runjags_estimates_table(fit_complex) + # Test 9: Conditional estimates with mixture priors + fit_complex_bias <- readRDS(file.path(temp_fits_dir, "fit_complex_bias.RDS")) + fit_complex_mixed <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) + runjags_summary_complex2 <- runjags_estimates_table(fit_complex_bias, conditional = TRUE) + runjags_summary_complex3 <- runjags_estimates_table(fit_complex_mixed, conditional = TRUE) # Test basic properties expect_s3_class(runjags_summary_transform, "BayesTools_table") @@ -90,9 +95,11 @@ test_that("Summary table advanced features work correctly", { expect_s3_class(runjags_summary_spike, "BayesTools_table") expect_s3_class(runjags_inference_spike, "BayesTools_table") expect_s3_class(runjags_summary_orthonormal, "BayesTools_table") + expect_s3_class(runjags_summary_orthonormal2, "BayesTools_table") expect_s3_class(runjags_summary_custom_transform, "BayesTools_table") expect_s3_class(runjags_summary_remove_inclusion, "BayesTools_table") - expect_s3_class(runjags_summary_custom_probs, "BayesTools_table") + expect_s3_class(runjags_summary_complex2, "BayesTools_table") + expect_s3_class(runjags_summary_complex3, "BayesTools_table") # Test that row names differ with different formula_prefix settings expect_false(identical(rownames(runjags_summary_prefix_true), @@ -110,9 +117,11 @@ test_that("Summary table advanced features work correctly", { test_reference_table(runjags_summary_spike, "advanced_spike_slab_estimates.txt", "Spike slab estimates table mismatch") test_reference_table(runjags_inference_spike, "advanced_spike_slab_inference.txt", "Spike slab inference table mismatch") test_reference_table(runjags_summary_orthonormal, "advanced_orthonormal_transform.txt", "Orthonormal transform table mismatch") + test_reference_table(runjags_summary_orthonormal2, "advanced_orthonormal_transform2.txt", "Orthonormal transform2 table mismatch") test_reference_table(runjags_summary_custom_transform, "advanced_custom_transform.txt", "Custom transform table mismatch") test_reference_table(runjags_summary_remove_inclusion, "advanced_remove_inclusion.txt", "Remove inclusion table mismatch") - test_reference_table(runjags_summary_custom_probs, "advanced_custom_probs.txt", "Custom probs table mismatch") + test_reference_table(runjags_summary_complex2, "runjags_summary_complex2.txt", "Custom probs table mismatch") + test_reference_table(runjags_summary_complex3, "runjags_summary_complex3.txt", "Custom probs table mismatch") }) diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R index 54a1243..7d3cae5 100644 --- a/tests/testthat/test-model-averaging-plots-edge-cases.R +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -56,6 +56,30 @@ test_that("plot_prior_list handles orthonormal priors", { plot_prior_list(prior_list, plot_type = "ggplot") }) + vdiffr::expect_doppelganger("plot-prior-list-orthonormal2-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot", col = "red", lty = 2, linetype = 2) + }) + + # Create orthonormal factor prior + prior_orth0 <- prior_factor("spike", list(0), contrast = "orthonormal") + attr(prior_orth0, "levels") <- 3 + + prior_list0 <- list(p1 = prior_orth0) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike", function() { + plot_prior_list(prior_list0) + }) + + prior_list2 <- list( + p1 = prior_orth, + p2 = prior_orth0 + ) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike-and-slab", function() { + suppressMessages(plot_prior_list(prior_list2, transformation = "exp", transformation_settings = TRUE, xlim = c(0.01, 5))) + }) }) @@ -460,6 +484,16 @@ test_that("plot_models handles order argument", { BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp") }) + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-trans-ggplot", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp", plot_type = "ggplot") + }) + + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-trans-prior-ggplot", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp", plot_type = "ggplot") + }) + }) From 928c48e34655b980045395dda79e1d46b5bd58cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 11 Dec 2025 21:36:28 +0100 Subject: [PATCH 12/38] update coverage --- .../plot-posterior-factor-transformation.svg | 79 -------- tests/testthat/test-JAGS-fit-edge-cases.R | 2 +- tests/testthat/test-JAGS-marglik.R | 190 ++++++++++++++++++ .../test-distributions-weightfunctions.R | 178 ++++++++++++++++ 4 files changed, 369 insertions(+), 80 deletions(-) delete mode 100644 tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg b/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg deleted file mode 100644 index f7aee41..0000000 --- a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-factor-transformation.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - -Density - - - - - -0.5 -1.0 -1.5 -2.0 - - - - - - -0 -0.5 -1 -1.5 -2 - - - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 -0.07 -Probability - - - - - - - - - - - - - - - - A - B - C - - diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 2362d59..031b2fa 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -258,7 +258,7 @@ test_that("JAGS_extend works correctly", { restarts = 2, max_extend = 2 ), - parallel = 2, + parallel = TRUE, cores = 2, silent = TRUE, seed = 1 diff --git a/tests/testthat/test-JAGS-marglik.R b/tests/testthat/test-JAGS-marglik.R index fe57335..d3cc548 100644 --- a/tests/testthat/test-JAGS-marglik.R +++ b/tests/testthat/test-JAGS-marglik.R @@ -224,3 +224,193 @@ test_that("bridge sampling object function works",{ expect_s3_class(marglik0, "bridge") }) + + +# Targeted tests for uncovered code paths in JAGS-marglik.R + +test_that("JAGS_bridgesampling_posterior input validation works", { + + posterior <- matrix(rnorm(30), nrow = 10, ncol = 3) + colnames(posterior) <- c("mu", "sigma", "x") + + # Input validation errors + + expect_error(JAGS_bridgesampling_posterior(data.frame(x = 1), prior_list = NULL), "'posterior' must be a matrix") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = "x"), "'prior_list' must be a list.") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = list(x = 1)), "'prior_list' must be a list of priors.") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = NULL, add_parameters = 1), "'add_parameters' must be a character") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = NULL, add_parameters = "x", add_bounds = "x"), "'add_bounds' must be a list") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = NULL, add_parameters = "x", add_bounds = list(a = 1)), "'add_bounds' must contain lower and upper bounds") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = NULL, add_parameters = c("x", "y"), add_bounds = list(lb = 0, ub = 1)), "lb' and 'ub' must have the same lenght") + expect_error(JAGS_bridgesampling_posterior(posterior, prior_list = NULL, add_parameters = "x", add_bounds = list(lb = "a", ub = "b")), "lb' and 'ub' must be numeric") + + # Unsupported prior types + expect_error( + JAGS_bridgesampling_posterior(posterior, prior_list = list(p1 = prior_spike_and_slab(prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1))))), + "spike and slab" + ) + expect_error( + JAGS_bridgesampling_posterior(posterior, prior_list = list(p1 = prior_mixture(list(prior("normal", list(0, 1)), prior("normal", list(1, 1))), is_null = c(TRUE, FALSE)))), + "prior mixture" + ) + + # Missing parameters + posterior_small <- matrix(rnorm(20), nrow = 10, ncol = 2) + colnames(posterior_small) <- c("a", "b") + expect_error(JAGS_bridgesampling_posterior(posterior_small, prior_list = list(x = prior("normal", list(0, 1)))), "'posterior' does not contain all") + + # Successful case with add_parameters + result <- JAGS_bridgesampling_posterior(posterior, prior_list = list(mu = prior("normal", list(0, 1))), add_parameters = "x", add_bounds = list(lb = -Inf, ub = Inf)) + expect_true(is.matrix(result)) + expect_true("x" %in% colnames(result)) + +}) + + +test_that("JAGS_marglik_priors input validation and edge cases work", { + + # Empty prior_list returns empty list + + expect_equal(JAGS_marglik_priors(list(), prior_list = list()), list()) + + # Input validation + expect_error(JAGS_marglik_priors(list(), prior_list = "x"), "'prior_list' must be a list.") + expect_error(JAGS_marglik_priors(list(), prior_list = prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") + expect_error(JAGS_marglik_priors(list(), prior_list = list(x = 1)), "'prior_list' must be a list of priors.") + +}) + + +test_that("JAGS_marglik_parameters input validation and edge cases work", { + + # Test: empty prior_list returns empty list + result <- JAGS_marglik_parameters(list(), prior_list = list()) + expect_equal(result, list()) + + # Test: prior_list must be a list + expect_error( + JAGS_marglik_parameters(list(), prior_list = "not_a_list"), + "'prior_list' must be a list." + ) + + # Test: prior_list must be a list of priors (single prior passed) + expect_error( + JAGS_marglik_parameters(list(), prior_list = prior("normal", list(0, 1))), + "'prior_list' must be a list of priors." + ) + + # Test: prior_list must be a list of priors (non-prior elements) + expect_error( + JAGS_marglik_parameters(list(), prior_list = list(x = 1)), + "'prior_list' must be a list of priors." + ) + +}) + + +test_that("JAGS_marglik_parameters_formula works", { + + # Test: empty formula_prior_list returns empty list + result <- JAGS_marglik_parameters_formula(list(), list(), list(), list()) + expect_equal(result, list()) + +}) + + +test_that(".fit_to_posterior handles different input types", { + + skip_if_not_installed("rjags") + skip_if_not_installed("coda") + + prior_list <- list(mu = prior("normal", list(0, 1))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + monitor <- JAGS_to_monitor(prior_list) + inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) + log_posterior <- function(parameters, data) return(0) + + set.seed(1) + model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) + + # mcmc.list (rjags::coda.samples) + samples_mcmc_list <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 100, quiet = TRUE, progress.bar = "none") + marglik <- JAGS_bridgesampling(samples_mcmc_list, prior_list = prior_list, data = list(), log_posterior = log_posterior) + expect_s3_class(marglik, "bridge") + + # mcmc (coda::as.mcmc) + samples_mcmc <- coda::as.mcmc(samples_mcmc_list[[1]]) + marglik_mcmc <- JAGS_bridgesampling(samples_mcmc, prior_list = prior_list, data = list(), log_posterior = log_posterior) + expect_s3_class(marglik_mcmc, "bridge") + + # Error for unsupported input + expect_error(JAGS_bridgesampling("bad_input", prior_list = prior_list, data = list(), log_posterior = log_posterior), "not implemented") + +}) + + +test_that(".fit_to_posterior handles jags.samples output", { + + skip_if_not_installed("rjags") + + # Scalar parameter + prior_list <- list(mu = prior("normal", list(0, 1)), sigma = prior("gamma", list(1, 1))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + monitor <- JAGS_to_monitor(prior_list) + inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) + log_posterior <- function(parameters, data) return(0) + + set.seed(1) + model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) + samples_jags <- rjags::jags.samples(model = model, variable.names = monitor, n.iter = 100, progress.bar = "none") + marglik_jags <- JAGS_bridgesampling(samples_jags, prior_list = prior_list, data = list(), log_posterior = log_posterior) + expect_s3_class(marglik_jags, "bridge") + +}) + + +test_that(".fit_to_posterior handles vector parameters in jags.samples", { + + skip_if_not_installed("rjags") + + # Vector parameter (K > 1) + prior_list <- list(p = prior("mnormal", list(mean = 0, sd = 1, K = 3))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + monitor <- JAGS_to_monitor(prior_list) + inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) + log_posterior <- function(parameters, data) return(0) + + set.seed(1) + model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) + samples_jags <- rjags::jags.samples(model = model, variable.names = monitor, n.iter = 100, progress.bar = "none") + marglik_jags <- JAGS_bridgesampling(samples_jags, prior_list = prior_list, data = list(), log_posterior = log_posterior) + expect_s3_class(marglik_jags, "bridge") + +}) + + +test_that("JAGS_bridgesampling handles runjags output", { + + skip_if_not_installed("runjags") + skip_if_not_installed("rjags") + + prior_list <- list(mu = prior("normal", list(0, 1))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + log_posterior <- function(parameters, data) return(0) + + set.seed(1) + fit <- suppressWarnings(runjags::run.jags( + model = model_syntax, + monitor = "mu", + n.chains = 2, + adapt = 100, + burnin = 100, + sample = 500, + silent.jags = TRUE, + modules = "glm" + )) + + marglik <- JAGS_bridgesampling(fit, prior_list = prior_list, data = list(), log_posterior = log_posterior) + expect_s3_class(marglik, "bridge") + expect_equal(marglik$logml, 0, tolerance = 0.1) + +}) diff --git a/tests/testthat/test-distributions-weightfunctions.R b/tests/testthat/test-distributions-weightfunctions.R index 7674987..11bcce3 100644 --- a/tests/testthat/test-distributions-weightfunctions.R +++ b/tests/testthat/test-distributions-weightfunctions.R @@ -208,6 +208,7 @@ test_that("Quantile function works", { stats::qbeta(p_seq, 1, 1), c(0, rep(1, length(p_seq) - 1)) )) + expect_equal(mqone.sided(p_seq, alpha = c(.3, 1, 2)), cbind( stats::qbeta(p_seq, 0.3, 3), @@ -253,3 +254,180 @@ test_that("Quantile function works", { expect_equal(mqone.sided_fixed(c(0, .5, 1), omega = c(.5, 1), lower.tail = FALSE), matrix(c(1, .5, .5, 1, 1, 1), ncol = 2, nrow = 3)) expect_equal(mqone.sided_fixed(c(0, .5, 1), omega = c(.5, 1)), mqtwo.sided_fixed(c(0, .5, 1), omega = c(.5, 1))) }) + +test_that("Non-monotonic (general) weight functions are not implemented", { + + ### density function + expect_error(mdone.sided(0.5, alpha1 = c(1, 1), alpha2 = c(1, 1)), "Not implemented") + + ### distribution function + expect_error(mpone.sided(0.5, alpha1 = c(1, 1), alpha2 = c(1, 1)), "Not implemented") + + ### quantile function + expect_error(mqone.sided(0.5, alpha1 = c(1, 1), alpha2 = c(1, 1)), "Not implemented") +}) + +test_that("Input validation for alpha parameter works", { + + ### alpha must be numeric vector or matrix + + expect_error(mdone.sided(0.5, alpha = "not_numeric"), "'alpha' must be a numeric vector or a matrix.") + expect_error(mpone.sided(0.5, alpha = list(1, 1)), "'alpha' must be a numeric vector or a matrix.") + expect_error(mqone.sided(0.5, alpha = data.frame(a = 1, b = 1)), "'alpha' must be a numeric vector or a matrix.") + expect_error(rone.sided(5, alpha = "not_numeric"), "'alpha' must be a numeric vector or a matrix.") + + ### alpha must have at least 2 elements + expect_error(mdone.sided(0.5, alpha = 1), "'alpha' must be a vector of length at least 2.") + expect_error(mpone.sided(0.5, alpha = 1), "'alpha' must be a vector of length at least 2.") + expect_error(mqone.sided(0.5, alpha = 1), "'alpha' must be a vector of length at least 2.") + expect_error(rone.sided(5, alpha = 1), "'alpha' must be a vector of length at least 2.") + + ### alpha matrix must have at least 2 columns + expect_error(mdone.sided(0.5, alpha = matrix(1, nrow = 2, ncol = 1)), "'alpha' must be a matrix with at least 2 columns.") + + ### alpha must be positive + expect_error(mdone.sided(0.5, alpha = c(-1, 1)), "'alpha' must be positive.") + expect_error(mdone.sided(0.5, alpha = c(0, 1)), "'alpha' must be positive.") + expect_error(mpone.sided(0.5, alpha = c(-1, 1)), "'alpha' must be positive.") + expect_error(rone.sided(5, alpha = c(0, 1)), "'alpha' must be positive.") +}) + +test_that("Input validation for omega parameter works", { + + ### omega must be numeric vector or matrix + expect_error(mdone.sided_fixed(0.5, omega = "not_numeric"), "'omega' must be a numeric vector or a matrix.") + expect_error(mpone.sided_fixed(0.5, omega = list(0.5, 1)), "'omega' must be a numeric vector or a matrix.") + expect_error(mqone.sided_fixed(0.5, omega = data.frame(a = 0.5, b = 1)), "'omega' must be a numeric vector or a matrix.") + expect_error(rone.sided_fixed(5, omega = "not_numeric"), "'omega' must be a numeric vector or a matrix.") + + ### omega must have at least 2 elements + expect_error(mdone.sided_fixed(0.5, omega = 0.5), "'omega' must be a vector of length at least 2.") + expect_error(mpone.sided_fixed(0.5, omega = 0.5), "'omega' must be a vector of length at least 2.") + expect_error(mqone.sided_fixed(0.5, omega = 0.5), "'omega' must be a vector of length at least 2.") + expect_error(rone.sided_fixed(5, omega = 0.5), "'omega' must be a vector of length at least 2.") + + ### omega matrix must have at least 2 columns + expect_error(mdone.sided_fixed(0.5, omega = matrix(0.5, nrow = 2, ncol = 1)), "'omega' must be a matrix with at least 2 columns.") + + ### omega must be between 0 and 1 + expect_error(mdone.sided_fixed(0.5, omega = c(-0.1, 1)), "'omega' must be between 0 and 1.") + expect_error(mdone.sided_fixed(0.5, omega = c(0.5, 1.1)), "'omega' must be between 0 and 1.") + expect_error(mpone.sided_fixed(0.5, omega = c(-0.1, 1)), "'omega' must be between 0 and 1.") + expect_error(rone.sided_fixed(5, omega = c(0.5, 1.5)), "'omega' must be between 0 and 1.") +}) + +test_that("Dimension mismatch errors work correctly", { + + ### density function with matrix alpha - dimension mismatch + alpha_mat <- matrix(c(1, 1, 2, 2), nrow = 2, byrow = TRUE) + expect_error(mdone.sided(c(0.5, 0.6, 0.7), alpha = alpha_mat), "Non matching dimensions of 'alpha' and 'x'.") + + ### density function with matrix omega - dimension mismatch + omega_mat <- matrix(c(0.5, 1, 0.6, 1), nrow = 2, byrow = TRUE) + expect_error(mdone.sided_fixed(c(0.5, 0.6, 0.7), omega = omega_mat), "Non matching dimensions of 'omega' and 'x'.") + + ### distribution function with matrix alpha - dimension mismatch + expect_error(mpone.sided(c(0.5, 0.6, 0.7), alpha = alpha_mat), "Non matching dimensions of 'alpha' and 'q'.") + + ### distribution function with matrix omega - dimension mismatch + expect_error(mpone.sided_fixed(c(0.5, 0.6, 0.7), omega = omega_mat), "Non matching dimensions of 'omega' and 'q'.") + + ### quantile function with matrix alpha - dimension mismatch + expect_error(mqone.sided(c(0.25, 0.5, 0.75), alpha = alpha_mat), "Non matching dimensions of 'alpha' and 'p'.") + + ### quantile function with matrix omega - dimension mismatch + expect_error(mqone.sided_fixed(c(0.25, 0.5, 0.75), omega = omega_mat), "Non matching dimensions of 'omega' and 'p'.") + + ### random generator with matrix alpha - dimension mismatch + expect_error(rone.sided(5, alpha = alpha_mat), "Incompatible dimensions of requested number of samples and 'alpha'.") + + ### random generator with matrix omega - dimension mismatch + expect_error(rone.sided_fixed(5, omega = omega_mat), "Incompatible dimensions of requested number of samples and 'omega'.") + + ### general random generator - mismatched alpha1 and alpha2 dimensions + alpha1_mat <- matrix(c(1, 1, 2, 2), nrow = 2, byrow = TRUE) + alpha2_mat <- matrix(c(1, 1, 2, 2, 3, 3), nrow = 3, byrow = TRUE) + expect_error(rone.sided(5, alpha1 = alpha1_mat, alpha2 = alpha2_mat), "Non matching dimensions of 'alpha1' and 'alpha2'.") + + ### general random generator - incompatible n and alpha dimensions + expect_error(rone.sided(5, alpha1 = alpha1_mat, alpha2 = matrix(c(1, 1, 2, 2), nrow = 2, byrow = TRUE)), + "Incompatible dimensions of requested number of samples and 'alpha'.") +}) + +test_that("Matrix input broadcasting works correctly", { + + ### density function - single x with matrix alpha broadcasts correctly + alpha_mat <- matrix(c(1, 1), nrow = 1) + result <- mdone.sided(0.5, alpha = alpha_mat) + expect_equal(dim(result), c(1, 2)) + + ### density function - single x with matrix omega broadcasts correctly + omega_mat <- matrix(c(0.5, 1), nrow = 1) + result <- mdone.sided_fixed(0.5, omega = omega_mat) + expect_equal(dim(result), c(1, 2)) + + ### density function - multiple x with vector omega broadcasts correctly (omega becomes 1-row matrix) + result <- mdone.sided_fixed(c(0.3, 0.5, 0.7), omega = c(0.5, 1)) + expect_equal(dim(result), c(3, 2)) + + ### density function - multiple x with vector alpha broadcasts correctly (alpha becomes 1-row matrix) + result <- mdone.sided(c(0.3, 0.5, 0.7), alpha = c(1, 1)) + expect_equal(dim(result), c(3, 2)) + + ### distribution function - single q with matrix alpha broadcasts correctly + result <- mpone.sided(0.5, alpha = alpha_mat) + expect_equal(dim(result), c(1, 2)) + + ### distribution function - single q with matrix omega broadcasts correctly + result <- mpone.sided_fixed(0.5, omega = omega_mat) + expect_equal(dim(result), c(1, 2)) + + ### distribution function - multiple q with vector omega broadcasts correctly + result <- mpone.sided_fixed(c(0.3, 0.5, 0.7), omega = c(0.5, 1)) + expect_equal(dim(result), c(3, 2)) + + ### distribution function - multiple q with vector alpha broadcasts correctly + result <- mpone.sided(c(0.3, 0.5, 0.7), alpha = c(1, 1)) + expect_equal(dim(result), c(3, 2)) + + ### quantile function - single p with matrix alpha broadcasts correctly + result <- mqone.sided(0.5, alpha = alpha_mat) + expect_equal(dim(result), c(1, 2)) + + ### quantile function - single p with matrix omega broadcasts correctly + result <- mqone.sided_fixed(0.5, omega = omega_mat) + expect_equal(dim(result), c(1, 2)) + + ### quantile function - multiple p with vector omega broadcasts correctly + result <- mqone.sided_fixed(c(0.25, 0.5, 0.75), omega = c(0.5, 1)) + expect_equal(dim(result), c(3, 2)) + + ### quantile function - multiple p with vector alpha broadcasts correctly + result <- mqone.sided(c(0.25, 0.5, 0.75), alpha = c(1, 1)) + expect_equal(dim(result), c(3, 2)) + + ### random generator - n=2 with 2-row matrix alpha works + alpha_mat2 <- matrix(c(1, 1, 2, 2), nrow = 2, byrow = TRUE) + set.seed(1) + result <- rone.sided(2, alpha = alpha_mat2) + expect_equal(nrow(result), 2) + + ### random generator - n=2 with 2-row matrix omega works + omega_mat2 <- matrix(c(0.3, 1, 0.5, 1), nrow = 2, byrow = TRUE) + result <- rone.sided_fixed(2, omega = omega_mat2) + expect_equal(nrow(result), 2) + + ### general random generator - n=2 with 2-row matrix alpha1/alpha2 works + alpha1_mat2 <- matrix(c(1, 1, 2, 2), nrow = 2, byrow = TRUE) + alpha2_mat2 <- matrix(c(1, 1, 3, 3), nrow = 2, byrow = TRUE) + set.seed(1) + result <- rone.sided(2, alpha1 = alpha1_mat2, alpha2 = alpha2_mat2) + expect_equal(nrow(result), 2) + + ### general random generator - broadcasting n=5 with 1-row matrix alpha1/alpha2 + alpha1_single <- matrix(c(1, 1), nrow = 1) + alpha2_single <- matrix(c(1, 1), nrow = 1) + set.seed(1) + result <- rone.sided(5, alpha1 = alpha1_single, alpha2 = alpha2_single) + expect_equal(nrow(result), 5) +}) From 5a8c85f96c6bde87197949e505956fb9b4adcfb3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 17 Dec 2025 09:54:52 +0100 Subject: [PATCH 13/38] improve coverage --- tests/testthat/test-JAGS-fit-edge-cases.R | 324 ++++++++++++++++ tests/testthat/test-priors-coverage.R | 447 ++++++++++++++++++++++ 2 files changed, 771 insertions(+) create mode 100644 tests/testthat/test-priors-coverage.R diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 031b2fa..77b087c 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -432,3 +432,327 @@ test_that("JAGS_add_priors handles mixture with PET prior", { test_reference_text(result_pet, "JAGS_add_priors_pet_mixture.txt") }) + + +# ============================================================================ # +# SECTION 11: Additional coverage tests for uncovered code paths +# ============================================================================ # + +test_that("JAGS_add_priors input validation works", { + + # Empty prior_list returns original syntax + expect_equal(JAGS_add_priors("model{}", list()), "model{}") + + # prior_list must be a list of priors + expect_error(JAGS_add_priors("model{}", list(x = 1)), "'prior_list' must be a list of priors.") + expect_error(JAGS_add_priors("model{}", prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") + +}) + + +test_that("JAGS_get_inits input validation works", { + + # Empty prior_list returns empty list + expect_equal(JAGS_get_inits(list(), chains = 2, seed = 1), list()) + + # Input validation + expect_error(JAGS_get_inits(list(x = 1), chains = 2, seed = 1), "'prior_list' must be a list of priors.") + expect_error(JAGS_get_inits(prior("normal", list(0, 1)), chains = 2, seed = 1), "'prior_list' must be a list of priors.") + +}) + + +test_that("JAGS_to_monitor input validation works", { + + # Empty prior_list returns empty string + expect_equal(JAGS_to_monitor(list()), "") + + # Input validation + expect_error(JAGS_to_monitor(list(x = 1)), "'prior_list' must be a list of priors.") + expect_error(JAGS_to_monitor(prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") + +}) + + +test_that("JAGS_check_convergence handles single chain (R-hat warning)", { + + skip_if_not_installed("rjags") + skip_on_cran() + + prior_list <- list(mu = prior("normal", list(0, 1))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + + set.seed(1) + fit <- suppressWarnings(runjags::run.jags( + model = model_syntax, + monitor = "mu", + n.chains = 1, # Single chain - R-hat cannot be computed + adapt = 50, + burnin = 50, + sample = 100, + silent.jags = TRUE + )) + + # Should warn about single chain R-hat + expect_warning( + JAGS_check_convergence(fit, prior_list = prior_list, max_Rhat = 1.05), + "Only one chain was run" + ) + +}) + + +test_that("JAGS_check_convergence handles ESS and error checks", { + + skip_if_not_installed("rjags") + skip_on_cran() + + prior_list <- list(mu = prior("normal", list(0, 1))) + model_syntax <- JAGS_add_priors("model{}", prior_list) + + set.seed(1) + fit <- suppressWarnings(runjags::run.jags( + model = model_syntax, + monitor = "mu", + n.chains = 2, + adapt = 50, + burnin = 50, + sample = 50, # Small sample for testing convergence failures + silent.jags = TRUE + )) + + # Test with very strict ESS requirement (should fail) + result_ess <- JAGS_check_convergence(fit, prior_list = prior_list, max_Rhat = NULL, min_ESS = 10000, max_error = NULL, max_SD_error = NULL, fail_fast = FALSE) + expect_false(result_ess) + expect_true(!is.null(attr(result_ess, "errors"))) + + # Test with very strict error requirement + result_err <- JAGS_check_convergence(fit, prior_list = prior_list, max_Rhat = NULL, min_ESS = NULL, max_error = 0.00001, max_SD_error = NULL, fail_fast = FALSE) + expect_false(result_err) + + # Test with very strict SD error requirement + result_sd <- JAGS_check_convergence(fit, prior_list = prior_list, max_Rhat = NULL, min_ESS = NULL, max_error = NULL, max_SD_error = 0.00001, fail_fast = FALSE) + expect_false(result_sd) + +}) + + +test_that("JAGS_check_and_list_autofit_settings validates all parameters", { + + # Valid settings + valid_settings <- list( + max_Rhat = 1.05, + min_ESS = 500, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 3, + max_extend = 10 + ) + expect_silent(JAGS_check_and_list_autofit_settings(valid_settings)) + + # max_time without names - should auto-assign + unnamed_time <- list( + max_Rhat = 1.05, min_ESS = 500, max_error = 0.01, max_SD_error = 0.05, + max_time = list(1, "mins"), sample_extend = 100 + ) + expect_silent(JAGS_check_and_list_autofit_settings(unnamed_time)) + +}) + + +test_that("JAGS_add_priors handles spike_and_slab priors", { + + skip_if_not_installed("rjags") + + priors_sas <- list( + mu = prior_spike_and_slab( + prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + ) + + result <- JAGS_add_priors("model{}", priors_sas) + expect_true(grepl("mu_variable", result)) + expect_true(grepl("mu_inclusion", result)) + expect_true(grepl("mu_indicator", result)) + + # Test inits + inits <- JAGS_get_inits(priors_sas, chains = 2, seed = 1) + expect_true("mu_variable" %in% names(inits[[1]]) || "mu_inclusion" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_sas) + expect_true("mu_indicator" %in% monitor) + +}) + + +test_that("JAGS_add_priors handles standard prior_mixture (non-bias)", { + + skip_if_not_installed("rjags") + + # Standard mixture (not bias mixture) + mix <- prior_mixture(list( + prior("normal", list(0, 0.5)), + prior("normal", list(0, 1)) + ), is_null = c(TRUE, FALSE)) + + priors_mix <- list(mu = mix) + + result <- JAGS_add_priors("model{}", priors_mix) + expect_true(grepl("mu_indicator", result)) + expect_true(grepl("mu_component_1", result)) + expect_true(grepl("mu_component_2", result)) + + # Test inits + inits <- JAGS_get_inits(priors_mix, chains = 2, seed = 1) + expect_true("mu_indicator" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_mix) + expect_true("mu_indicator" %in% monitor) + expect_true("mu" %in% monitor) + +}) + + +test_that("JAGS handles invgamma prior", { + + skip_if_not_installed("rjags") + + priors_inv <- list(tau = prior("invgamma", list(3, 2))) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_inv) + expect_true(grepl("inv_tau", result)) + expect_true(grepl("dgamma", result)) + + # Test inits + inits <- JAGS_get_inits(priors_inv, chains = 2, seed = 1) + expect_true("inv_tau" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_inv) + expect_true("tau" %in% monitor) + +}) + + +test_that("JAGS handles weightfunction one.sided with alpha1/alpha2", { + + skip_if_not_installed("rjags") + + # One-sided with steps crossing 0.5 uses alpha1/alpha2 parametrization + priors_wf2 <- list(omega = prior_weightfunction("one.sided", list(c(0.05, 0.60), c(1, 1), c(1, 1)))) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_wf2) + expect_true(grepl("eta1", result)) + expect_true(grepl("eta2", result)) + + # Test inits + inits <- JAGS_get_inits(priors_wf2, chains = 2, seed = 1) + expect_true("eta1" %in% names(inits[[1]])) + expect_true("eta2" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_wf2) + expect_true("eta1" %in% monitor) + expect_true("eta2" %in% monitor) + +}) + + +test_that("JAGS handles weightfunction fixed prior", { + + skip_if_not_installed("rjags") + + priors_wf_fixed <- list(omega = prior_weightfunction("one.sided.fixed", list(steps = c(0.05), omega = c(1, 0.5)))) + + # Test syntax - fixed weightfunction has no eta parameters to sample + result <- JAGS_add_priors("model{}", priors_wf_fixed) + expect_true(grepl("omega", result)) + + # Test inits - fixed weightfunction should return empty inits for eta + inits <- JAGS_get_inits(priors_wf_fixed, chains = 2, seed = 1) + # Should not have eta since it's fixed + expect_true(!("eta" %in% names(inits[[1]]))) + + # Test monitor + monitor <- JAGS_to_monitor(priors_wf_fixed) + expect_true("omega" %in% monitor) + +}) + + +test_that("JAGS handles factor treatment/independent priors", { + + skip_if_not_installed("rjags") + + # Treatment contrast + prior_treat <- prior_factor("normal", list(0, 1), contrast = "treatment") + attr(prior_treat, "levels") <- 3 + + priors_treat <- list(fac = prior_treat) + result_treat <- JAGS_add_priors("model{}", priors_treat) + expect_true(grepl("fac\\[i\\]", result_treat)) + + # Independent contrast + prior_indep <- prior_factor("gamma", list(2, 1), contrast = "independent") + attr(prior_indep, "levels") <- 2 + + priors_indep <- list(fac = prior_indep) + result_indep <- JAGS_add_priors("model{}", priors_indep) + expect_true(grepl("dgamma", result_indep)) + +}) + + +test_that("JAGS handles vector mt prior", { + + skip_if_not_installed("rjags") + + prior_mt <- prior("mt", list(location = 0, scale = 1, df = 5, K = 2)) + priors_mt <- list(p = prior_mt) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_mt) + expect_true(grepl("prior_par_s_p", result)) + expect_true(grepl("prior_par_z_p", result)) + + # Test inits + inits <- JAGS_get_inits(priors_mt, chains = 2, seed = 1) + expect_true("prior_par_s_p" %in% names(inits[[1]])) + expect_true("prior_par_z_p" %in% names(inits[[1]])) + +}) + + +test_that("JAGS handles bias mixture with weightfunction", { + + skip_if_not_installed("rjags") + + bias_mix_wf <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_weightfunction("one.sided", list(c(0.05), c(1, 1)), prior_weights = 1) + )) + + priors_bias_wf <- list(bias = bias_mix_wf) + + result <- JAGS_add_priors("model{}", priors_bias_wf) + expect_true(grepl("bias_indicator", result)) + expect_true(grepl("omega", result)) + expect_true(grepl("eta", result)) + + # Test inits + inits <- JAGS_get_inits(priors_bias_wf, chains = 2, seed = 1) + expect_true("bias_indicator" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_bias_wf) + expect_true("bias_indicator" %in% monitor) + expect_true("omega" %in% monitor) + +}) diff --git a/tests/testthat/test-priors-coverage.R b/tests/testthat/test-priors-coverage.R new file mode 100644 index 0000000..df90fa6 --- /dev/null +++ b/tests/testthat/test-priors-coverage.R @@ -0,0 +1,447 @@ +context("Prior distribution coverage tests") + +# Targeted coverage tests for priors.R uncovered lines + + +test_that("Unknown distribution name error (line 115)", { + expect_error(prior("unknown_dist", list(0, 1)), + "The specified distribution name") +}) + + +test_that("prior_factor orthonormal/meandif with non-vector prior error (lines 328, 334, 336)", { + # orthonormal contrast requires multivariate distribution + expect_error(prior_factor("normal", list(0, 1), contrast = "orthonormal"), + "contrasts require multivariate prior") + + # meandif contrast requires multivariate distribution + expect_error(prior_factor("normal", list(0, 1), contrast = "meandif"), + "contrasts require multivariate prior") +}) + + +test_that("prior_factor orthonormal/meandif with unsupported distribution (line 346)", +{ + # bernoulli is not a valid multivariate distribution + expect_error(prior_factor("bernoulli", list(0.5), contrast = "orthonormal"), + "contrasts require multivariate prior") +}) + + +test_that("prior_factor treatment contrast requires univariate (line 358)", { + # treatment contrast with multivariate dist should fail + # mnormal requires 3 params, so it fails earlier - use a valid multivariate prior + expect_error(prior_factor("mnormal", list(0, 1, 2), contrast = "treatment"), + "contrasts require univariate prior") +}) + + +test_that("prior_spike_and_slab with factor prior (lines 402-408)", { + # spike_and_slab with factor prior as variable + p_factor <- prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal") + p_factor$parameters[["K"]] <- 2 + + p_ss <- prior_spike_and_slab( + prior_parameter = p_factor, + prior_inclusion = prior("beta", list(1, 1)) + ) + + expect_true(is.prior.spike_and_slab(p_ss)) + expect_s3_class(p_ss, "prior.spike_and_slab") +}) + + +test_that(".set_spike_and_slab_variable_attr (lines 486-497)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + # Set an attribute on the variable component + p_ss2 <- BayesTools:::.set_spike_and_slab_variable_attr(p_ss, "test_attr", "test_value") + expect_true(is.prior.spike_and_slab(p_ss2)) + + # Error when not spike_and_slab + expect_error(BayesTools:::.set_spike_and_slab_variable_attr(prior("normal", list(0, 1)), "attr", "val"), + "only works with spike_and_slab priors") +}) + + +test_that(".get_spike_and_slab_variable error (line 459)", { + expect_error(BayesTools:::.get_spike_and_slab_variable(prior("normal", list(0, 1))), + "only works with spike_and_slab priors") +}) + + +test_that(".get_spike_and_slab_inclusion error (lines 471, 476)", { + expect_error(BayesTools:::.get_spike_and_slab_inclusion(prior("normal", list(0, 1))), + "only works with spike_and_slab priors") +}) + + +test_that("prior_mixture with factor prior containing spike (lines 522, 538)", { + # Mixture of factor priors where one is a spike + p1 <- prior("spike", list(0)) + p2 <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p2$parameters[["K"]] <- 2 + + p_mix <- prior_mixture(list(p1, p2), components = c("null", "alt")) + + expect_s3_class(p_mix, "prior.factor_mixture") +}) + + +test_that("prior_mixture with prior_none factor (line 576)", { + # Mixture with prior_none that should be converted to factor spike + p1 <- prior_none() + p2 <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p2$parameters[["K"]] <- 2 + + p_mix <- prior_mixture(list(p1, p2), components = c("null", "alt")) + + expect_s3_class(p_mix, "prior.factor_mixture") +}) + + +test_that("prior_mixture bias mixture (lines 585, 600)", { + # PET/PEESE/weightfunction mixture + p_pet <- prior_PET("normal", list(0, 1)) + p_wf <- prior_weightfunction("one.sided", list(steps = c(0.05), alpha = c(1, 1))) + + p_mix <- prior_mixture(list(p_pet, p_wf), components = c("a", "b")) + + expect_s3_class(p_mix, "prior.bias_mixture") +}) + + +test_that("Uniform prior with a > b error (line 843)", { + expect_error(prior("uniform", list(a = 5, b = 1)), + "lower than") +}) + + +test_that("rng spike_and_slab sample_components (line 1155)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + set.seed(1) + components <- rng(p_ss, 10, sample_components = TRUE) + + expect_true(all(components %in% c(0, 1))) + expect_length(components, 10) +}) + + +test_that("rng mixture sample_components (line 1190)", { + p_mix <- prior_mixture( + list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), + components = c("a", "b") + ) + + set.seed(1) + components <- rng(p_mix, 10, sample_components = TRUE) + + expect_true(all(components %in% 1:2)) + expect_length(components, 10) +}) + + +test_that("rng factor_mixture (lines 1221, 1236, 1240, 1244-1247)", { + p_mix <- prior_mixture( + list( + prior("spike", list(0)), + prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + ), + components = c("null", "alt") + ) + for (i in seq_along(p_mix)) { + p_mix[[i]]$parameters[["K"]] <- 2 + } + + set.seed(1) + # Default: transform_factor_samples = FALSE + samples <- rng(p_mix, 10, transform_factor_samples = FALSE) + expect_true(is.matrix(samples)) + + # With transform_factor_samples = TRUE + samples2 <- rng(p_mix, 10, transform_factor_samples = TRUE) + expect_true(is.matrix(samples2)) + expect_equal(ncol(samples2), 3) # K+1 columns +}) + + +test_that("rng orthonormal/meandif transform (line 1284)", { + p <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p$parameters[["K"]] <- 2 + + set.seed(1) + samples <- rng(p, 10, transform_factor_samples = TRUE) + + expect_true(is.matrix(samples)) + expect_equal(ncol(samples), 3) # K+1 columns +}) + + +test_that("cdf with truncation for spike_and_slab error (lines 1329, 1333)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + expect_error(cdf(p_ss, 0), "No cdfs are implemented for spike and slab") +}) + + +test_that("cdf with truncation for simple prior (lines 1363, 1365, 1367, 1369)", { + p <- prior("normal", list(0, 1), truncation = list(-2, 2)) + + # Test cdf at various points + expect_true(cdf(p, 0) > 0) + expect_true(cdf(p, -3) == 0) # Below truncation + expect_true(cdf(p, 3) >= 1 - 1e-6) # Above truncation (approx 1) +}) + + +test_that("ccdf errors and truncation (lines 1385, 1389, 1419-1425)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + expect_error(ccdf(p_ss, 0), "No ccdf are implemented for spike and slab") + + # Mixture error + p_mix <- prior_mixture( + list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), + components = c("a", "b") + ) + expect_error(ccdf(p_mix, 0), "No ccdf are implemented for prior mixtures") + + # ccdf with truncation + p <- prior("normal", list(0, 1), truncation = list(-2, 2)) + expect_true(ccdf(p, 0) > 0) + expect_true(ccdf(p, 3) == 0) # Above truncation +}) + + +test_that("lpdf spike_and_slab and mixture errors (lines 1442, 1446, 1496, 1498)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + expect_error(lpdf(p_ss, 0), "No lpdf are implemented for spike and slab") + + p_mix <- prior_mixture( + list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), + components = c("a", "b") + ) + expect_error(lpdf(p_mix, 0), "No lpdf are implemented for prior mixtures") +}) + + +test_that("quant spike_and_slab and mixture errors (lines 1528, 1532)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + + expect_error(quant(p_ss, 0.5), "No quant(ile)? functions? are implemented for spike and slab") + + p_mix <- prior_mixture( + list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), + components = c("a", "b") + ) + expect_error(quant(p_mix, 0.5), "No quant(ile)? functions? are implemented for prior mixtures") +}) + + +test_that("quant with non-default truncation optimization (lines 1561, 1582, 1584)", { + # Truncated prior that requires optimization in quant + p <- prior("normal", list(0, 1), truncation = list(0.5, 2)) + + q <- quant(p, 0.5) + expect_true(q > 0.5 && q < 2) + + # Also test edge quantiles + q_low <- quant(p, 0.01) + q_high <- quant(p, 0.99) + expect_true(q_low >= 0.5) + expect_true(q_high <= 2) +}) + + +test_that("mcdf for orthonormal/meandif (lines 1681, 1685, 1689, 1711-1722)", { + # orthonormal prior + p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p_orth$parameters[["K"]] <- 2 + + cdf_val <- mcdf(p_orth, 0) + expect_true(cdf_val >= 0 && cdf_val <= 1) + + # meandif prior + p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") + p_md$parameters[["K"]] <- 2 + + cdf_val2 <- mcdf(p_md, 0) + expect_true(cdf_val2 >= 0 && cdf_val2 <= 1) +}) + + +test_that("mccdf for orthonormal/meandif (lines 1760-1801)", { + p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p_orth$parameters[["K"]] <- 2 + + ccdf_val <- mccdf(p_orth, 0) + expect_true(ccdf_val >= 0 && ccdf_val <= 1) + + p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") + p_md$parameters[["K"]] <- 2 + + ccdf_val2 <- mccdf(p_md, 0) + expect_true(ccdf_val2 >= 0 && ccdf_val2 <= 1) +}) + + +test_that("mlpdf for orthonormal/meandif (lines 1840, 1844, 1870, 1874)", { + p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p_orth$parameters[["K"]] <- 2 + + lpdf_val <- mlpdf(p_orth, 0) + expect_true(is.finite(lpdf_val)) + + p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") + p_md$parameters[["K"]] <- 2 + + lpdf_val2 <- mlpdf(p_md, 0) + expect_true(is.finite(lpdf_val2)) +}) + + +test_that("mquant for orthonormal/meandif (lines 1933, 1937, 1963, 1967)", { + p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") + p_orth$parameters[["K"]] <- 2 + + q <- mquant(p_orth, 0.5) + expect_true(is.numeric(q)) + + p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") + p_md$parameters[["K"]] <- 2 + + q2 <- mquant(p_md, 0.5) + expect_true(is.numeric(q2)) +}) + + +test_that("pdf.default passes through to stats::dnorm for vectors", { + # pdf.default calls stats::dnorm for numeric vectors, not an error + # This tests the generic S3 dispatch working correctly + p <- prior("normal", list(0, 1)) + expect_true(is.numeric(pdf(p, 0))) +}) + + +test_that("mean.prior for spike_and_slab (line 2123)", { + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(1, 1)), + prior_inclusion = prior("point", list(0.5)) # Fixed inclusion probability + ) + + m <- mean(p_ss) + expect_true(is.numeric(m)) + expect_equal(m, 0.5) # mean(normal(1,1)) * 0.5 +}) + + +test_that("mean.prior for truncated distributions (lines 2148, 2153)", { + # Truncated normal + p <- prior("normal", list(0, 1), truncation = list(0, Inf)) + m <- mean(p) + expect_true(m > 0) + + # Truncated t with df <= 1 should return NaN + p_t <- prior("t", list(0, 1, 1), truncation = list(-1, 1)) + m_t <- mean(p_t) + expect_true(is.nan(m_t)) +}) + + +test_that("mean.prior for orthonormal/meandif with mt df<=1 (lines 2181, 2185, 2189)", { + p_mt <- prior_factor("mt", list(0, 1, 1), contrast = "orthonormal") # df = 1 + p_mt$parameters[["K"]] <- 2 + + m <- mean(p_mt) + expect_true(is.nan(m)) +}) + + +test_that("var dispatches to stats::var for vectors", { + # var.default calls stats::var for numeric vectors + x <- c(1, 2, 3, 4, 5) + expect_equal(var(x), stats::var(x)) +}) + + +test_that("var.prior for spike_and_slab (lines 2276-2291)", { + # spike_and_slab with beta inclusion + p_ss <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + v <- var(p_ss) + expect_true(is.numeric(v)) + expect_true(v > 0) + + # spike_and_slab with point inclusion + p_ss2 <- prior_spike_and_slab( + prior_parameter = prior("normal", list(0, 1)), + prior_inclusion = prior("point", list(0.5)) + ) + v2 <- var(p_ss2) + expect_true(is.numeric(v2)) +}) + + +test_that("var.prior for truncated distributions (lines 2316, 2321)", { + # t with df <= 2 should return NaN for variance + p_t <- prior("t", list(0, 1, 2), truncation = list(-1, 1)) + v <- var(p_t) + expect_true(is.nan(v)) + + # invgamma with shape <= 2 should return NaN + p_ig <- prior("invgamma", list(2, 1), truncation = list(0.1, 10)) + v_ig <- var(p_ig) + expect_true(is.nan(v_ig)) +}) + + +test_that("var.prior for orthonormal/meandif (lines 2350-2368)", { + # orthonormal with mpoint + p_mp <- prior_factor("mpoint", list(0), contrast = "orthonormal") + p_mp$parameters[["K"]] <- 2 + v <- var(p_mp) + expect_equal(v, 0) + + # orthonormal with mt and df <= 2 + p_mt <- prior_factor("mt", list(0, 1, 2), contrast = "orthonormal") + p_mt$parameters[["K"]] <- 2 + v_mt <- var(p_mt) + expect_true(is.nan(v_mt)) + + # meandif with mnormal + p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") + p_md$parameters[["K"]] <- 2 + v_md <- var(p_md) + expect_true(v_md > 0) +}) + + +test_that("var.prior for mixture error", { + p_mix <- prior_mixture( + list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), + components = c("a", "b") + ) + expect_error(var(p_mix), "No var is implemented for prior mixtures") +}) From ceb25b9ef56f49755cbb6cf3c2e3875bad7fa63d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 18 Dec 2025 15:49:49 +0100 Subject: [PATCH 14/38] further test consolidation --- .github/instructions/tests.instructions.md | 138 ++- DESCRIPTION | 3 +- R/marginal-distributions.R | 10 + R/model-averaging.R | 12 +- .../model-averaging-plot-posterior-i-1.svg | 54 +- .../model-averaging-plot-posterior-i-2.svg | 54 +- .../ggplot-marginal-ss-mu-x-cont1.svg | 6 +- .../ggplot-marginal-ss-mu-x-fac2t-3.svg | 56 +- .../ggplot-marginal-ss-mu-x-fac2t-4.svg | 4 +- .../ggplot-marginal-ss-mu-x-fac3md.svg | 6 +- .../marginal-factor-independent-hist.svg | 6 +- .../marginal-inference-ss-cont-p.svg | 350 +++--- .../marginal-inference-ss-fac-md-p.svg | 194 ++-- .../marginal-prior-ind.svg | 337 +++--- .../marginal-prior-trt.svg | 296 +++-- .../marginal-prior-weightfunction.svg | 192 ++-- .../marginal-ss-cond-fac.svg | 161 +-- .../marginal-ss-form-con-p-exp.svg | 318 +++--- .../marginal-ss-form-con-p.svg | 452 ++++---- .../marginal-ss-form-fac-md-p.svg | 188 +-- .../marginal-ss-form-fac-mdi-p.svg | 1016 ++++++++--------- .../marginal-ss-form-fac-t-p.svg | 144 +-- .../marginal-ss-form-int-p.svg | 50 +- .../marginal-ss-simple-con-p.svg | 80 +- .../marginal-ss-simple-fac-p.svg | 75 +- .../marginal-wf-onesided-hist.svg | 2 +- .../plot-marginal-ss-int.svg | 2 +- .../plot-marginal-ss-mu-x-cont1.svg | 6 +- .../plot-marginal-ss-mu-x-fac2t-3.svg | 40 +- .../plot-marginal-ss-mu-x-fac2t-4.svg | 4 +- .../plot-marginal-ss-mu-x-fac2t-5.svg | 4 +- .../plot-marginal-ss-mu-x-fac3md.svg | 6 +- tests/testthat/common-functions.R | 230 +++- tests/testthat/test-00-model-fits.R | 25 +- tests/testthat/test-JAGS-diagnostic-plots.R | 42 +- tests/testthat/test-JAGS-ensemble-plots.R | 30 +- tests/testthat/test-JAGS-ensemble-tables.R | 35 +- tests/testthat/test-JAGS-fit-edge-cases.R | 22 +- tests/testthat/test-JAGS-formula.R | 79 +- .../test-JAGS-marginal-distributions.R | 46 +- tests/testthat/test-JAGS-marglik.R | 55 +- .../testthat/test-JAGS-posterior-extraction.R | 22 +- tests/testthat/test-JAGS-summary-tables.R | 25 +- tests/testthat/test-distributions-mpoint.R | 17 +- tests/testthat/test-distributions-point.R | 16 +- tests/testthat/test-distributions-tools.R | 17 +- .../test-distributions-weightfunctions.R | 20 +- tests/testthat/test-interpret.R | 17 +- .../test-model-averaging-edge-cases.R | 22 +- .../test-model-averaging-plots-edge-cases.R | 22 +- tests/testthat/test-model-averaging.R | 21 +- tests/testthat/test-priors-coverage.R | 197 ++-- tests/testthat/test-priors-density.R | 19 +- tests/testthat/test-priors-informed.R | 17 +- tests/testthat/test-priors-plot.R | 19 +- tests/testthat/test-priors-print.R | 17 +- tests/testthat/test-priors-tools.R | 17 +- tests/testthat/test-priors.R | 144 +-- .../testthat/test-summary-tables-edge-cases.R | 38 +- tests/testthat/test-summary-tables-helpers.R | 17 +- tests/testthat/test-tools-evaluation.R | 76 ++ .../{test-tools.R => test-tools-input.R} | 170 +-- 62 files changed, 3299 insertions(+), 2461 deletions(-) create mode 100644 tests/testthat/test-tools-evaluation.R rename tests/testthat/{test-tools.R => test-tools-input.R} (80%) diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 754548e..31adeea 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -8,6 +8,57 @@ applyTo: "**/tests/testthat/*.R" Tests in BayesTools follow a structured organization where model fitting is centralized in `test-00-model-fits.R` and consumed by other test files. This approach ensures consistency, avoids duplication, and speeds up test execution. +**testthat Edition**: This package uses testthat Edition 3. Do not use `context()` calls. + +## Test File Structure + +### Naming Conventions + +| Pattern | Purpose | Example | +|---------|---------|---------| +| `test-{feature}.R` | Main evaluation tests | `test-priors.R` | +| `test-{feature}-input.R` | Input validation tests | `test-tools-input.R` | +| `test-{feature}-evaluation.R` | Behavior/evaluation tests | `test-tools-evaluation.R` | +| `test-{feature}-coverage.R` | Edge case coverage tests | `test-priors-coverage.R` | +| `test-{feature}-edge-cases.R` | Edge case tests | `test-model-averaging-edge-cases.R` | + +### File Header Template + +Every test file should include a standardized header for AI discoverability: + +```r +# ============================================================================ # +# TEST FILE: {Description} +# ============================================================================ # +# +# PURPOSE: +# {Brief description of what this file tests} +# +# DEPENDENCIES: +# - {package}: {Why needed} +# - common-functions.R: {What helpers used} +# +# SKIP CONDITIONS: +# - {skip condition and why} +# +# MODELS/FIXTURES: +# - {What pre-fitted models or fixtures are used} +# +# TAGS: @{category}, @{speed}, @{feature} +# ============================================================================ # +``` + +### Common Tags + +- `@input-validation`: Tests for input checking (fast) +- `@evaluation`: Tests for correct behavior/output +- `@visual`: Visual regression tests (vdiffr) +- `@coverage`: Gap-filling coverage tests +- `@edge-cases`: Edge case and error path tests +- `@fast`: Quick tests (< 1s) +- `@slow`: Long-running tests (JAGS fitting) +- `@priors`, `@JAGS`, `@model-averaging`: Feature tags + ## Key Principles ### 1. Single Source of Truth for Model Fitting @@ -64,12 +115,29 @@ marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.R **Note**: Marginal likelihoods are only computed for models with actual data (not spike-and-slab or mixture priors). -### 5. Helper Functions for Reference Files +### 5. Helper Functions in common-functions.R + +The shared helper file provides: + +```r +# Reference file testing +test_reference_table(table, filename, ...) +test_reference_text(text, filename, ...) + +# Prior distribution testing +test_prior(prior, skip_moments = FALSE) +test_weightfunction(prior, skip_moments = FALSE) +test_orthonormal(prior, skip_moments = FALSE) +test_meandif(prior, skip_moments = FALSE) + +# Skip helpers +skip_if_no_fits() +``` -# Define at the top of test files with reference outputs -# Load common test helpers that define test_reference_table() and test_reference_text() -REFERENCE_DIR <<- testthat::test_path("..", "results", "print") +Load at the top of test files: +```r source(testthat::test_path("common-functions.R")) +``` ### 6. Test File Organization @@ -93,6 +161,48 @@ All tests that use JAGS models (e.g., `test-model-averaging.R`, `test-JAGS-*.R`, - Changing to `TRUE` regenerates all reference files (tables, figures, etc.) and should only be done by the maintainer - **Outputs**: Reference files (`.txt`, `.svg`, `.png`, etc.) stored in `tests/results/` subdirectories +## Skip Condition Standards + +### Skip Condition Hierarchy + +Use the appropriate skip condition based on what your test needs: + +| Skip Condition | When to Use | Example Use Case | +|----------------|-------------|------------------| +| `skip_if_no_fits()` | Test loads pre-fitted models from `temp_fits_dir` | Model averaging tests, diagnostic plots | +| `skip_if_not_installed("rjags")` | Test requires JAGS execution (fitting or syntax) | JAGS syntax tests, marglik tests | +| `skip_if_not_installed("bridgesampling")` | Test computes marginal likelihoods | Ensemble inference tests | +| `skip_if_not_installed("vdiffr")` | Test uses visual regression | Prior plot tests | +| `skip_on_os(c("mac", "linux", "solaris"))` | Test involves multivariate sampling (meandif/orthonormal) | Multivariate prior tests | + +### File-Level vs Per-Test Skips + +**File-level skips** (after `source(common-functions.R)`): +```r +source(testthat::test_path("common-functions.R")) + +# File-level skips - ALL tests in this file need these +skip_if_no_fits() +skip_if_not_installed("rjags") +skip_if_not_installed("vdiffr") +``` + +**Per-test skips** (only when specific tests have additional requirements): +```r +test_that("multivariate sampling works", { + skip_on_os(c("mac", "linux", "solaris")) # Only this test needs OS skip + # ... +}) +``` + +### Important Notes + +1. **`common-functions.R` does NOT call `skip_on_cran()`** - each test file manages its own skip conditions +2. **`skip_if_no_fits()`** checks for `model_registry.RDS` in `temp_fits_dir` - use this for any test that loads pre-fitted models +3. **`skip_on_os()`** should ONLY be used for tests involving multivariate priors (meandif, orthonormal) where RNG differs across platforms +4. **Pure R tests** (e.g., `test-priors-print.R`, `test-tools-input.R`) should have NO file-level skips and can run on CRAN +``` + ## AI Agent Protocol When asked to write or refactor tests: @@ -101,12 +211,15 @@ When asked to write or refactor tests: 2. **Map requirements to existing models.** If the user needs a test for "diagnostic plots for factor priors", find an existing model with factor priors (e.g., `fit_formula_interaction_fac`). 3. **Refuse to create new models** unless the test requires a specific mathematical structure not present in the entire suite. 4. **Never** add a model to `test-00-model-fits.R` without explicitly explaining why none of the existing 15+ models suffice. +5. **Use descriptive test names** - never use line numbers or implementation details in test names. +6. **Follow file naming conventions** - split input validation into `-input.R` files. ## Maintenance Checklist **Adding a new model:** - [ ] Check for duplicates in `test-00-model-fits.R` - [ ] Add model to `test-00-model-fits.R` with `save_fit()` and appropriate metadata + **Using pre-fitted models:** - [ ] Load with `readRDS()`, never fit models outside `test-00-model-fits.R` - [ ] Add skip conditions for missing models/packages @@ -117,10 +230,7 @@ When asked to write or refactor tests: - [ ] Run tests to generate reference files - [ ] Review diffs carefully before committing - [ ] Reset flag to `FALSE` -- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES <- TRUE` -- [ ] Run tests to generate reference files -- [ ] Review diffs carefully before committing -- [ ] Reset flag to `FALSE` +- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES` ## Quick Examples @@ -142,19 +252,23 @@ if (file.exists(marglik_file)) { # 3. Add to test-summary-tables.R model_names vector model_names <- c(..., "fit_new") ``` + ## Common Pitfalls ❌ Fitting models outside `test-00-model-fits.R` ❌ Creating duplicate models with different parameters -❌ **Modifying `GENERATE_REFERENCE_FILES` flag** (maintainer only) +❌ **Modifying `GENERATE_REFERENCE_FILES` flag** (maintainer only) +❌ Using line numbers in test names (e.g., "line 115") +❌ Using `context()` calls (Edition 2 deprecated) ✅ Always load pre-fitted models with `readRDS()` ✅ Use one model per prior type -✅ Leave `GENERATE_REFERENCE_FILES <- FALSE` unchanged -✅ Set `GENERATE_REFERENCE_FILES <- TRUE` when updating formats +✅ Leave `GENERATE_REFERENCE_FILES <- FALSE` unchanged +✅ Use descriptive, behavior-focused test names +✅ Include standardized file headers + ## Troubleshooting - **"Pre-fitted models not available"**: Run `devtools::test(filter = "00-model-fits")` - **Summary table mismatch**: Contact maintainer; **do not** modify `GENERATE_REFERENCE_FILES` - **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture -- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture diff --git a/DESCRIPTION b/DESCRIPTION index 47f5a64..7712cb7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,7 +35,7 @@ Imports: rlang Suggests: scales, - testthat, + testthat (>= 3.0.0), vdiffr, covr, knitr, @@ -47,3 +47,4 @@ Suggests: rmarkdown RdMacros: Rdpack VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/R/marginal-distributions.R b/R/marginal-distributions.R index 3a1395a..8e55e30 100644 --- a/R/marginal-distributions.R +++ b/R/marginal-distributions.R @@ -854,6 +854,11 @@ marginal_posterior <- function(samples, parameter, formula = NULL, at = NULL, pr }else{ + # keep the same seed across levels + if(is.null(seed)){ + seed <- sample(666666, 1) + } + samples <- lapply(1:levels, function(i) .mix_priors.simple(priors, paste0(parameter, "[", i, "]"), seed, n_samples)) sample_ind <- attr(samples[[1]], "sample_ind") @@ -884,6 +889,11 @@ marginal_posterior <- function(samples, parameter, formula = NULL, at = NULL, pr }else{ + # keep the same seed across levels + if(is.null(seed)){ + seed <- sample(666666, 1) + } + samples <- lapply(1:levels, function(i) .mix_priors.simple(priors, paste0(parameter, "[", i, "]"), seed, n_samples)) sample_ind <- attr(samples[[1]], "sample_ind") diff --git a/R/model-averaging.R b/R/model-averaging.R index 1eff432..aadaa91 100644 --- a/R/model-averaging.R +++ b/R/model-averaging.R @@ -200,6 +200,12 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F prior_weights <- sapply(model_list, function(m) m[["prior_weights"]]) inference <- ensemble_inference(model_list, parameters, is_null_list, conditional) + + # set seed only once at the beginning -- not in the individual draws as the priors will end up completely correlated + if(!is.null(seed)){ + set.seed(seed) + } + out <- list() for(p in seq_along(parameters)){ @@ -224,7 +230,7 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F temp_priors[[i]][["prior_weights"]] <- temp_inference$prior_probs[i] } - out[[temp_parameter]] <- .mix_posteriors.weightfunction(fits, temp_priors, temp_parameter, temp_inference$post_probs, seed, n_samples) + out[[temp_parameter]] <- .mix_posteriors.weightfunction(fits, temp_priors, temp_parameter, temp_inference$post_probs, NULL, n_samples) }else if(any(sapply(temp_priors, is.prior.factor)) && all(sapply(temp_priors, is.prior.factor) | sapply(temp_priors, is.prior.point) | sapply(temp_priors, is.null))){ # factor priors @@ -241,7 +247,7 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F temp_priors[[i]][["prior_weights"]] <- temp_inference$prior_probs[i] } - out[[temp_parameter]] <- .mix_posteriors.factor(fits, temp_priors, temp_parameter, temp_inference$post_probs, seed, n_samples) + out[[temp_parameter]] <- .mix_posteriors.factor(fits, temp_priors, temp_parameter, temp_inference$post_probs, NULL, n_samples) }else if(any(sapply(temp_priors, is.prior.vector)) && all(sapply(temp_priors, is.prior.vector) | sapply(temp_priors, is.prior.point) | sapply(temp_priors, is.null))){ # vector priors: @@ -275,7 +281,7 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F temp_priors[[i]][["prior_weights"]] <- temp_inference$prior_probs[i] } - out[[temp_parameter]] <- .mix_posteriors.simple(fits, temp_priors, temp_parameter, temp_inference$post_probs, seed, n_samples) + out[[temp_parameter]] <- .mix_posteriors.simple(fits, temp_priors, temp_parameter, temp_inference$post_probs, NULL, n_samples) }else{ stop("The posterior samples cannot be mixed: unsupported mixture of prior distributions.") diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg index d01db1c..555643f 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-1.svg @@ -18,34 +18,34 @@ - + - - - - - - - + + + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + - - - - + + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 +0.4 Density @@ -54,9 +54,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg index d01db1c..555643f 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-i-2.svg @@ -18,34 +18,34 @@ - + - - - - - - - + + + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + - - - - + + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 +0.4 Density @@ -54,9 +54,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg index 5e12ae8..8843a9d 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg @@ -51,9 +51,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg index aa55270..0257fa8 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg @@ -33,12 +33,13 @@ - - - - - - + + + + + + + @@ -47,16 +48,17 @@ - - - - - + + + + + + - - - - + + + + 0 @@ -74,18 +76,20 @@ - - - - - + + + + + + --6 --4 --2 -0 -2 -4 +-8 +-6 +-4 +-2 +0 +2 +4 6 Density diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg index d787055..749dd9d 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg index eb0c1a1..bcef9fc 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg @@ -49,9 +49,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg index 8a2b113..0ec15ca 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg @@ -140,7 +140,7 @@ - + @@ -243,7 +243,7 @@ - + @@ -358,6 +358,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg index 1d553fe..b21da81 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-cont-p.svg @@ -59,87 +59,87 @@ - - - - + + + + - - - - + + + + - - + + - - - + + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - + + + + + + - - - + + + - - + + - + - - - + + + - - + + - + @@ -206,39 +206,39 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -263,7 +263,7 @@ - + @@ -307,86 +307,86 @@ 0.4 - - + + - - - - - - - - - + + + + + + + + + - - - - - - - - - - - - + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg index 3eea383..9714f2f 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg @@ -83,39 +83,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -139,7 +139,7 @@ - + @@ -208,38 +208,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + @@ -263,7 +263,7 @@ - + @@ -331,39 +331,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -387,6 +387,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg index 1fc6115..1651ca5 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-ind.svg @@ -30,26 +30,26 @@ Density - - - - - - --1 -0 -1 -2 -3 - + + + + + + +-1 +0 +1 +2 +3 + - - - + + + 0 -1 -2 -3 +1 +2 +3 @@ -57,48 +57,49 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -118,71 +119,71 @@ Density - - - - - - --1 -0 -1 -2 -3 - + + + + + + +-1 +0 +1 +2 +3 + - - - + + + 0 -1 -2 -3 +1 +2 +3 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -213,59 +214,59 @@ 1 2 3 - + - - - + + + 0 -1 -2 -3 +1 +2 +3 - - - - - - - - - + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg index a04f5b3..24e8df7 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-trt.svg @@ -30,21 +30,21 @@ Density - + - - - - - - + + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 @@ -65,68 +65,66 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -146,21 +144,21 @@ Density - + - - - - - - + + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 @@ -176,67 +174,65 @@ 10 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg index 1a1bb39..5ab653e 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-prior-weightfunction.svg @@ -159,55 +159,55 @@ 25 - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -256,55 +256,55 @@ 25 - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg index c4e55fb..af62a76 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-cond-fac.svg @@ -214,34 +214,34 @@ 0 2 4 - + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - + + + + + + + + - - - - - - - - + + + + + + + + @@ -272,34 +272,34 @@ 0 2 4 - + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - + + + + + + + + - - - - - - - - + + + + + + + + @@ -319,42 +319,45 @@ Density - - - - - --2 -0 -2 -4 - + + + + + + +-4 +-2 +0 +2 +4 + - - - + + + 0.0 -0.1 -0.2 -0.3 +0.1 +0.2 +0.3 - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg index f6fe2a4..60ea7c5 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p-exp.svg @@ -42,21 +42,21 @@ 0 5 10 - + - - - - - - + + + + + + 0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 @@ -104,47 +104,47 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -176,21 +176,21 @@ 0 5 10 - + - - - - - - + + + + + + 0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 @@ -233,47 +233,47 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -305,21 +305,21 @@ 0 5 10 - + - - - - - - + + + + + + 0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 @@ -362,46 +362,46 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg index 1ad0421..ecd9c3b 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-con-p.svg @@ -42,23 +42,23 @@ 0 5 10 - + - - - - - - - + + + + + + + 0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 -0.35 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +0.35 @@ -66,84 +66,84 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + @@ -177,17 +177,17 @@ 0 5 10 - + - - - - + + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 +0.4 @@ -213,39 +213,39 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -301,104 +301,104 @@ 0 5 10 - + - - - - - - - + + + + + + + 0.00 -0.05 -0.10 -0.15 -0.20 -0.25 -0.30 -0.35 +0.05 +0.10 +0.15 +0.20 +0.25 +0.30 +0.35 - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg index cd7781b..3044784 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-md-p.svg @@ -83,39 +83,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -208,38 +208,38 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + @@ -331,39 +331,39 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg index 5647463..2700610 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-mdi-p.svg @@ -63,83 +63,83 @@ - - + + - + - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - - - + + + - + - + @@ -185,85 +185,85 @@ 0.4 - + - - - + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - + @@ -311,83 +311,83 @@ - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - - + + - - + + @@ -459,37 +459,37 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + @@ -584,36 +584,36 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -708,38 +708,38 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + @@ -810,86 +810,86 @@ 0.4 - - - - - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + - - - - - + + + + + - - - - - - + + + + + + - - + + @@ -939,82 +939,82 @@ - - - - - + + + + + - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - + + + - - - - + + + + - + - - + + - - - + + + - - + + @@ -1061,85 +1061,85 @@ - - - + + + - - + + - - + + - - + + - - - - - + + + + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + - + - - - - - + + + + + - - + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg index 1a25506..b884ef1 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-fac-t-p.svg @@ -82,41 +82,41 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + @@ -201,50 +201,50 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg index 49a76da..fa772dd 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-form-int-p.svg @@ -32,17 +32,15 @@ 0 2 4 - + - - - - + + + 0.0 -0.1 -0.2 -0.3 -0.4 +0.1 +0.2 +0.3 @@ -51,22 +49,22 @@ - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg index b2fd41b..15833fb 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-con-p.svg @@ -34,23 +34,23 @@ 3 4 5 - + - - - - - - - + + + + + + + 0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 @@ -58,31 +58,31 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg index f1a7552..bac946b 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-ss-simple-fac-p.svg @@ -83,50 +83,47 @@ Density - - - - - + + + + --4 --2 -0 -2 +-2 +0 +2 4 - + - - - - - - + + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg index 388405d..3ecef6d 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg @@ -115,7 +115,7 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg index bcb1783..7da3f6c 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-int.svg @@ -49,7 +49,7 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg index 0907ac7..95c853c 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg @@ -52,9 +52,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg index 6cee19a..b9e45e7 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg @@ -18,21 +18,23 @@ - - - - - - - - --6 --4 --2 -0 -2 -4 -6 + + + + + + + + + +-8 +-6 +-4 +-2 +0 +2 +4 +6 @@ -54,14 +56,14 @@ - - + + A B - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg index 591d056..88d01f6 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg @@ -52,8 +52,8 @@ - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg index 1268467..fa8247e 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg @@ -52,8 +52,8 @@ - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg index 235f4ab..ba89a33 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg @@ -50,9 +50,9 @@ - - - + + + diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index e2d5db9..650cac8 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -11,11 +11,12 @@ if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") } -# Skip tests on CRAN as they require pre-fitted models -skip_on_cran() +# NOTE: File-level skip_on_cran() was removed intentionally. +# Each test file should manage its own skip conditions appropriately. +# Use skip_if_no_fits() for tests that need pre-fitted models. # ============================================================================ # -# HELPER FUNCTIONS +# HELPER FUNCTIONS: Reference File Testing # ============================================================================ # # Process reference file: save if GENERATE_REFERENCE_FILES=TRUE, test otherwise @@ -69,3 +70,226 @@ skip_if_no_fits <- function() { skip("Pre-fitted models not found. Run test-00-model-fits.R first.") } } + +# ============================================================================ # +# STANDARD TEST FIXTURES: Reusable Prior Definitions +# ============================================================================ # +# These fixtures reduce duplication across test files. Use these instead of +# creating new prior definitions when testing standard functionality. + +# Standard log_posterior function for marginal likelihood tests +# Returns 0 (log of 1) for prior-only models +STANDARD_LOG_POSTERIOR <- function(parameters, data) { + + return(0) +} + +# Standard simple priors (commonly used across tests) +STANDARD_PRIORS <- list( + normal = prior("normal", list(0, 1)), + normal_trunc = prior("normal", list(0, 1), list(0, Inf)), + lognormal = prior("lognormal", list(0, 0.5)), + t = prior("t", list(0, 0.5, 5)), + + cauchy = prior("Cauchy", list(0, 1)), + cauchy_trunc = prior("Cauchy", list(1, 0.1), list(-10, 0)), + gamma = prior("gamma", list(2, 1)), + invgamma = prior("invgamma", list(3, 2)), + invgamma_trunc = prior("invgamma", list(3, 2), list(1, 3)), + exp = prior("exp", list(1.5)), + beta = prior("beta", list(3, 2)), + uniform = prior("uniform", list(0, 1)), + spike = prior("spike", list(0)), + PET = prior_PET("normal", list(0, 1)), + PEESE = prior_PEESE("gamma", list(1, 1)) +) + +# Standard factor priors (for contrast testing) +STANDARD_FACTOR_PRIORS <- list( + orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), + meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), + treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), + independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent"), + orth_cauchy = prior_factor("mcauchy", list(location = 0, scale = 1), contrast = "orthonormal"), + orth_spike = prior_factor("point", list(0), contrast = "orthonormal") +) + +# Complete prior collections for comprehensive testing +ALL_SIMPLE_PRIORS <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(0, 1), list(1, Inf)), + p3 = prior("lognormal", list(0, 0.5)), + p4 = prior("t", list(0, 0.5, 5)), + p5 = prior("Cauchy", list(1, 0.1), list(-10, 0)), + p6 = prior("gamma", list(2, 1)), + p7 = prior("invgamma", list(3, 2), list(1, 3)), + p8 = prior("exp", list(1.5)), + p9 = prior("beta", list(3, 2)), + p10 = prior("uniform", list(1, 5)), + PET = prior_PET("normal", list(0, 1)), + PEESE = prior_PEESE("gamma", list(1, 1)) +) + +ALL_VECTOR_PRIORS <- list( + mnormal = prior("mnormal", list(mean = 0, sd = 1, K = 3)), + mcauchy = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)), + mt = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) +) + +ALL_FACTOR_PRIORS <- list( + orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), + meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), + treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), + independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent") +) + +# ============================================================================ # +# HELPER FUNCTIONS: Prior Distribution Testing +# ============================================================================ # + +#' Test a prior distribution for consistency +#' +#' Validates that a prior distribution's rng, pdf, cdf, quant, mean, and sd + +' functions work correctly and are mutually consistent. +#' +#' @param prior A prior object to test +#' @param skip_moments Logical; skip mean/sd validation (for distributions +#' with undefined moments like Cauchy) +#' @return invisible(); used for visual regression testing +test_prior <- function(prior, skip_moments = FALSE) { + set.seed(1) + # tests rng and print function (for plot) + samples <- rng(prior, 100000) + if (is.prior.discrete(prior)) { + barplot(table(samples) / length(samples), main = print(prior, plot = TRUE), + width = 1 / (max(samples) + 1), space = 0, + xlim = c(-0.25, max(samples) + 0.25)) + } else if (is.prior.spike_and_slab(prior)) { + xh <- hist(samples[samples != 0], breaks = 50, plot = FALSE) + xh$density <- xh$density * mean(samples != 0) + plot(xh, main = print(prior, plot = TRUE), freq = FALSE) + } else { + hist(samples, main = print(prior, plot = TRUE), breaks = 50, freq = FALSE) + } + # tests density function + lines(prior, individual = TRUE) + + # tests quantile function + if (!is.prior.spike_and_slab(prior) && !is.prior.mixture(prior)) { + abline(v = quant(prior, 0.5), col = "blue", lwd = 2) + } + # tests that cdf(quant(x)) == x + + if (!is.prior.point(prior) && !is.prior.discrete(prior) && + !is.prior.spike_and_slab(prior) && !is.prior.mixture(prior)) { + expect_equal(.25, cdf(prior, quant(prior, 0.25)), tolerance = 1e-4) + expect_equal(.25, ccdf(prior, quant(prior, 0.75)), tolerance = 1e-4) + } + # test mean and sd functions + if (!skip_moments) { + expect_equal(mean(samples), mean(prior), tolerance = 1e-2) + expect_equal(sd(samples), sd(prior), tolerance = 1e-2) + } + return(invisible()) +} + +#' Test a weight function prior distribution +#' +#' Validates weight function priors with multiple components. +#' +#' @param prior A weight function prior object +#' @param skip_moments Logical; skip moment validation +#' @return invisible() +test_weightfunction <- function(prior, skip_moments = FALSE) { + set.seed(1) + # tests rng and print function (for plot) + samples <- rng(prior, 10000) + densities <- density(prior, individual = TRUE) + + if (!all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))) { + quantiles <- mquant(prior, 0.5) + } + + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) + par(mfcol = c(1, ncol(samples) - 1)) + + for (i in 1:(ncol(samples) - 1)) { + hist(samples[, i], main = print(prior, plot = TRUE), breaks = 50, freq = FALSE) + lines(densities[[i]]) + if (!all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))) { + abline(v = quantiles[i], col = "blue", lwd = 2) + } + if (!grepl("fixed", prior$distribution) && + !all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))) { + expect_equal(.25, mcdf(prior, mquant(prior, 0.25)[, i])[, i], tolerance = 1e-5) + expect_equal(.25, mccdf(prior, mquant(prior, 0.75)[, i])[, i], tolerance = 1e-5) + } + if (!skip_moments) { + expect_equal(apply(samples, 2, mean), mean(prior), tolerance = 1e-2) + expect_equal(apply(samples, 2, sd), sd(prior), tolerance = 1e-2) + } + } + return(invisible()) +} + +#' Test an orthonormal contrast prior +#' +#' Validates orthonormal factor priors. +#' +#' @param prior An orthonormal prior object +#' @param skip_moments Logical; skip moment validation +#' @return invisible() +test_orthonormal <- function(prior, skip_moments = FALSE) { + set.seed(1) + # tests rng and print function (for plot) + samples <- rng(prior, 100000) + samples <- samples[abs(samples) < 10] + hist(samples, main = print(prior, plot = TRUE), breaks = 50, freq = FALSE) + # tests density function + lines(prior, individual = TRUE) + # tests quantile function + abline(v = mquant(prior, 0.5), col = "blue", lwd = 2) + # tests that mcdf(mquant(x)) == x + if (!is.prior.point(prior)) { + expect_equal(.25, mcdf(prior, mquant(prior, 0.25)), tolerance = 1e-5) + expect_equal(.25, mccdf(prior, mquant(prior, 0.75)), tolerance = 1e-5) + } + # test mean and sd functions + if (!skip_moments) { + expect_equal(mean(samples), mean(prior), tolerance = 1e-2) + expect_equal(sd(samples), sd(prior), tolerance = 1e-2) + } + return(invisible()) +} + +#' Test a mean difference contrast prior +#' +#' Validates meandif factor priors. +#' +#' @param prior A meandif prior object +#' @param skip_moments Logical; skip moment validation +#' @return invisible() +test_meandif <- function(prior, skip_moments = FALSE) { + set.seed(1) + # tests rng and print function (for plot) + samples <- rng(prior, 100000) + samples <- samples[abs(samples) < 10] + hist(samples, main = print(prior, plot = TRUE), breaks = 50, freq = FALSE) + # tests density function + lines(prior, individual = TRUE) + # tests quantile function + abline(v = mquant(prior, 0.5), col = "blue", lwd = 2) + # tests that mcdf(mquant(x)) == x + if (!is.prior.point(prior)) { + expect_equal(.25, mcdf(prior, mquant(prior, 0.25)), tolerance = 1e-5) + expect_equal(.25, mccdf(prior, mquant(prior, 0.75)), tolerance = 1e-5) + } + # test mean and sd functions + if (!skip_moments) { + expect_equal(mean(samples), mean(prior), tolerance = 1e-2) + expect_equal(sd(samples), sd(prior), tolerance = 1e-2) + } + return(invisible()) +} diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index f19f89b..7238f48 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -1,10 +1,33 @@ -context("Model fits for reuse across tests") +# ============================================================================ # +# TEST FILE: Model Fits for Reuse Across Tests +# ============================================================================ # +# +# PURPOSE: +# Centralized model fitting for all JAGS models used across the test suite. +# Fitted models are saved to temp directory for reuse in other test files. +# This reduces redundant MCMC sampling and speeds up the overall test suite. +# +# DEPENDENCIES: +# - rjags, runjags, bridgesampling: For model fitting +# +# SKIP CONDITIONS: +# - skip_on_cran(): Long-running model fitting +# - skip_if_not_installed("rjags") +# +# MODELS/FIXTURES: +# - Creates all pre-fitted models used by other test files +# - Models saved to BAYESTOOLS_TEST_FITS_DIR environment variable +# - Maintains model_registry.RDS with metadata +# +# TAGS: @slow, @JAGS, @model-fits +# ============================================================================ # # This file contains all model fitting procedures used across the test suite. # Fitted models are saved to a temporary directory for reuse in other tests. # This reduces redundant MCMC sampling and speeds up the overall test suite. skip_on_cran() +skip_if_not_installed("rjags") # Setup directory for saving fitted models temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") diff --git a/tests/testthat/test-JAGS-diagnostic-plots.R b/tests/testthat/test-JAGS-diagnostic-plots.R index d43efa7..a9161f7 100644 --- a/tests/testthat/test-JAGS-diagnostic-plots.R +++ b/tests/testthat/test-JAGS-diagnostic-plots.R @@ -1,13 +1,41 @@ -context("JAGS diagnostics") +# ============================================================================ # +# TEST FILE: JAGS Diagnostic Plot Functions +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for JAGS diagnostic plots (density, trace, +# autocorrelation plots). +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - rjags: JAGS model fitting +# - common-functions.R: temp_fits_dir, skip_if_no_fits +# +# SKIP CONDITIONS: +# - skip_if_no_fits(): Pre-fitted models required +# - skip_if_not_installed("rjags"): JAGS dependency +# - skip_if_not_installed("vdiffr"): Visual regression +# - skip_on_os(): Multivariate sampling differs across OSes +# +# MODELS/FIXTURES: +# - fit_formula_interaction_mix, fit_formula_interaction_fac +# - fit_pet, fit_wf_onesided, fit_factor_independent +# - fit_marginal_1, fit_complex_mixed +# +# TAGS: @evaluation, @visual, @JAGS, @diagnostics +# ============================================================================ # # Load common test helpers source(testthat::test_path("common-functions.R")) +# File-level skips: JAGS models required +skip_if_no_fits() +skip_if_not_installed("rjags") +skip_if_not_installed("vdiffr") + test_that("JAGS diagnostics work", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") # Load pre-fitted models fit_formula_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS")) @@ -138,8 +166,6 @@ test_that("JAGS diagnostics work", { test_that("JAGS diagnostics work (spike and slab)", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") # Use fit_complex_mixed which has spike and slab on x_cont1 fit <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) @@ -153,8 +179,6 @@ test_that("JAGS diagnostics work (spike and slab)", { test_that("JAGS diagnostics work (mixture priors)", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") # Use fit_complex_mixed which has mixture on intercept and x_fac3t fit <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) @@ -174,8 +198,6 @@ test_that("JAGS diagnostics work (mixture priors)", { test_that("JAGS diagnostics work (meandif and independent)", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") fit_independent <- readRDS(file.path(temp_fits_dir, "fit_factor_independent.RDS")) fit_meandif <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) # Has meandif factor priors @@ -244,8 +266,6 @@ test_that("JAGS diagnostics work (meandif and independent)", { test_that("JAGS diagnostics work (spike priors)", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") fit <- readRDS(file.path(temp_fits_dir, "fit_spike_factors.RDS")) fit_simple <- readRDS(file.path(temp_fits_dir, "fit_spike_slab_simple.RDS")) diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index e094c09..c334984 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1,4 +1,26 @@ -context("JAGS ensemble plot functions") +# ============================================================================ # +# TEST FILE: JAGS Ensemble Plot Functions +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for ensemble plot functions (plot_prior_list, +# plot_posterior, plot_models, etc.). +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - rjags, bridgesampling: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, skip_if_no_fits +# +# SKIP CONDITIONS: +# - First section (prior plots): Can run on CRAN (pure R) +# - Second section (posterior plots): skip_if_no_fits(), skip_if_not_installed() +# - skip_on_os(): Multivariate sampling differs across OSes +# +# MODELS/FIXTURES: +# - fit_simple_spike, fit_simple_normal, fit_summary*, fit_marginal_* +# +# TAGS: @evaluation, @visual, @JAGS, @model-averaging, @plots +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-ensemble-plots") source(testthat::test_path("common-functions.R")) @@ -161,8 +183,12 @@ test_that("prior plot functions (simple) work", { }) }) -# skip the rest as it takes too long +# ============================================================================ # +# SECTION: Tests requiring pre-fitted models (skip on CRAN) +# ============================================================================ # skip_on_cran() +skip_if_no_fits() +skip_if_not_installed("vdiffr") test_that("prior plot functions (PET-PEESE) work", { diff --git a/tests/testthat/test-JAGS-ensemble-tables.R b/tests/testthat/test-JAGS-ensemble-tables.R index 3423366..84152ec 100644 --- a/tests/testthat/test-JAGS-ensemble-tables.R +++ b/tests/testthat/test-JAGS-ensemble-tables.R @@ -1,10 +1,30 @@ -context("JAGS ensemble tables functions") +# ============================================================================ # +# TEST FILE: JAGS Ensemble Tables Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for ensemble table generation functions (ensemble_estimates_table, +# ensemble_inference_table, ensemble_diagnostics_table). +# +# DEPENDENCIES: +# - rjags, bridgesampling: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, skip_if_no_fits, test_reference_table +# +# SKIP CONDITIONS: +# - First section (empty tables): Can run on CRAN (pure R) +# - Second section (advanced features): skip_if_no_fits() +# +# MODELS/FIXTURES: +# - fit_summary0/1/2, fit_formula_interaction_mix/fac +# +# TAGS: @evaluation, @JAGS, @model-averaging, @tables +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-ensemble-tables") source(testthat::test_path("common-functions.R")) # ============================================================================ # -# SECTION 1: Test Empty Tables +# SECTION 1: Test Empty Tables (Can run on CRAN - pure R) # ============================================================================ # test_that("Empty summary tables work correctly", { @@ -12,9 +32,9 @@ test_that("Empty summary tables work correctly", { ensemble_inference_empty <- ensemble_inference_empty_table() ensemble_diagnostics_empty <- ensemble_diagnostics_empty_table() - expect_equivalent(nrow(ensemble_estimates_empty), 0) - expect_equivalent(nrow(ensemble_inference_empty), 0) - expect_equivalent(nrow(ensemble_diagnostics_empty), 0) + expect_equal(nrow(ensemble_estimates_empty), 0, ignore_attr = TRUE) + expect_equal(nrow(ensemble_inference_empty), 0, ignore_attr = TRUE) + expect_equal(nrow(ensemble_diagnostics_empty), 0, ignore_attr = TRUE) # Test that empty tables have correct structure expect_s3_class(ensemble_estimates_empty, "BayesTools_table") @@ -27,10 +47,11 @@ test_that("Empty summary tables work correctly", { }) # ============================================================================ # -# SECTION 2: Test Advanced Features (Transformations, Formula Handling, etc.) +# SECTION 2: Test Advanced Features (Requires pre-fitted models) # ============================================================================ # test_that("Summary table advanced features work correctly", { + skip_if_no_fits() skip_if_not_installed("rjags") skip_if_not_installed("bridgesampling") @@ -84,7 +105,7 @@ test_that("Summary table advanced features work correctly", { expect_equal(colnames(ensemble_diagnostics_empty), colnames(diagnostics_table.trimmed)) expect_equal(capture_output_lines(ensemble_diagnostics_empty, width = 150)[1], capture_output_lines(diagnostics_table.trimmed, width = 150)[1]) - # Test interpret + # # Test interpret interpretation <- interpret(inference, mixed_posteriors, list( list( inference = "m", diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 77b087c..55d5707 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -1,4 +1,24 @@ -context("JAGS fit edge cases and comprehensive tests") +# ============================================================================ # +# TEST FILE: JAGS Fit Edge Cases +# ============================================================================ # +# +# PURPOSE: +# Edge case and comprehensive tests for JAGS fitting functions including +# JAGS_add_priors, JAGS_fit, and related utilities. +# +# DEPENDENCIES: +# - rjags: For JAGS model syntax generation and testing +# - common-functions.R: REFERENCE_DIR, test_reference_text, skip_if_no_fits +# +# SKIP CONDITIONS: +# - skip_if_not_installed("rjags"): For all tests +# - skip_if_no_fits(): For tests using pre-fitted models +# +# MODELS/FIXTURES: +# - Some tests use pre-fitted models from test-00-model-fits.R +# +# TAGS: @evaluation, @edge-cases, @JAGS +# ============================================================================ # # Reference directory for text output comparisons REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-fit-edge-cases") diff --git a/tests/testthat/test-JAGS-formula.R b/tests/testthat/test-JAGS-formula.R index 9b5994e..e20adf4 100644 --- a/tests/testthat/test-JAGS-formula.R +++ b/tests/testthat/test-JAGS-formula.R @@ -1,9 +1,25 @@ -context("JAGS formula") - -# This file tests the JAGS formula functions -# - Helper functions for parameter naming and formula handling -# - JAGS_evaluate_formula function for prediction -# Uses pre-fitted models from test-00-model-fits.R per testing guidelines +# ============================================================================ # +# TEST FILE: JAGS Formula Handling +# ============================================================================ # +# +# PURPOSE: +# Tests for JAGS formula parsing, parameter naming, and prediction functions +# in R/JAGS-formula.R. Includes JAGS_evaluate_formula and helper utilities. +# +# DEPENDENCIES: +# - rjags: Required for JAGS model evaluation +# - common-functions.R: Test helpers and pre-fitted model access +# +# SKIP CONDITIONS: +# - First section (parameter name tools): Can run on CRAN (pure R) +# - Second section (JAGS evaluation): skip_if_not_installed("rjags") +# - skip_on_os(): Multivariate sampling consistency (meandif priors) +# +# MODELS/FIXTURES: +# - Uses pre-fitted models from test-00-model-fits.R via temp_fits_dir +# +# TAGS: @evaluation, @JAGS, @formula +# ============================================================================ # # Load common test helpers source(testthat::test_path("common-functions.R")) @@ -35,12 +51,15 @@ test_that("JAGS formula tools work", { }) +# ============================================================================ # +# SECTION: Tests requiring JAGS (skip conditions per test) +# ============================================================================ # + test_that("JAGS evaluate formula works", { # Test JAGS_evaluate_formula by comparing against lm() predictions using ML estimates. # This test constructs samples manually (from ML estimates) - no pre-fitted JAGS model needed. skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() skip_if_not_installed("rjags") # Setup: complex formula including scaling @@ -159,6 +178,7 @@ test_that("JAGS evaluate formula works with spike priors", { # Test JAGS_evaluate_formula with spike prior distributions using pre-fitted model skip_on_os(c("mac", "linux", "solaris")) skip_on_cran() + skip_if_no_fits() skip_if_not_installed("rjags") # Load pre-fitted model with spike factor priors (all 4 contrast types) @@ -186,9 +206,9 @@ test_that("JAGS evaluate formula works with spike priors", { # Row 1: A(1) + A(0) + A(ref=0) + B(0) = 1 # Row 2: B(1) + A(0) + B(2) + B(0) = 3 # Row 3: A(1) + B(0) + C(2) + C(0) = 3 - expect_equivalent(new_samples_mean[1], 1, tolerance = 0.01) - expect_equivalent(new_samples_mean[2], 3, tolerance = 0.01) - expect_equivalent(new_samples_mean[3], 3, tolerance = 0.01) + expect_equal(new_samples_mean[1], 1, tolerance = 0.01, ignore_attr = TRUE) + expect_equal(new_samples_mean[2], 3, tolerance = 0.01, ignore_attr = TRUE) + expect_equal(new_samples_mean[3], 3, tolerance = 0.01, ignore_attr = TRUE) }) @@ -197,6 +217,7 @@ test_that("JAGS evaluate formula works with spike-and-slab and mixture priors", # Test JAGS_evaluate_formula with spike-and-slab and mixture priors using pre-fitted model skip_on_os(c("mac", "linux", "solaris")) skip_on_cran() + skip_if_no_fits() skip_if_not_installed("rjags") # Load pre-fitted joint complex model (mixture intercept, spike-and-slab continuous, spike-and-slab factor) @@ -238,12 +259,12 @@ test_that("Expression handling functions work", { expect_equal(.extract_expressions(f5), list("x")) expect_equal(.extract_expressions(f6), list("x", "b")) - expect_equal(.remove_expressions(f1), formula(y ~ 1)) - expect_equal(.remove_expressions(f2), formula(y ~ z)) - expect_equal(.remove_expressions(f3), formula(y ~ 1)) - expect_equal(.remove_expressions(f4), formula(y ~ z)) - expect_equal(.remove_expressions(f5), formula(y ~ z)) - expect_equal(.remove_expressions(f6), formula(y ~ z)) + expect_equal(.remove_expressions(f1), formula(y ~ 1), ignore_formula_env = TRUE) + expect_equal(.remove_expressions(f2), formula(y ~ z), ignore_formula_env = TRUE) + expect_equal(.remove_expressions(f3), formula(y ~ 1), ignore_formula_env = TRUE) + expect_equal(.remove_expressions(f4), formula(y ~ z), ignore_formula_env = TRUE) + expect_equal(.remove_expressions(f5), formula(y ~ z), ignore_formula_env = TRUE) + expect_equal(.remove_expressions(f6), formula(y ~ z), ignore_formula_env = TRUE) }) test_that("Random effects handling functions work", { @@ -284,13 +305,13 @@ test_that("Random effects handling functions work", { expect_equal(.extract_random_effects(f6), t2) expect_equal(.extract_random_effects(f7), t3) - expect_equal(.remove_random_effects(f1), formula( ~ 1)) - expect_equal(.remove_random_effects(f2), formula( ~ x_cont1)) - expect_equal(.remove_random_effects(f3), formula( ~ 1)) - expect_equal(.remove_random_effects(f4), formula( ~ 1)) - expect_equal(.remove_random_effects(f5), formula( ~ x_cont1)) - expect_equal(.remove_random_effects(f6), formula( ~ x_cont1)) - expect_equal(.remove_random_effects(f7), formula( ~ x_cont1 + x_cont2)) + expect_equal(.remove_random_effects(f1), formula( ~ 1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f2), formula( ~ x_cont1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f3), formula( ~ 1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f4), formula( ~ 1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f5), formula( ~ x_cont1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f6), formula( ~ x_cont1), ignore_formula_env = TRUE) + expect_equal(.remove_random_effects(f7), formula( ~ x_cont1 + x_cont2), ignore_formula_env = TRUE) }) @@ -319,12 +340,12 @@ test_that("-1 (no intercept) formula handling works correctly", { expect_true(grepl("mu_intercept", result_basic$formula_syntax)) # Test 2: Helper function test - expect_equal(.add_intercept_to_formula(~ x - 1), ~ x) - expect_equal(.add_intercept_to_formula(~ x + y - 1), ~ x + y) - expect_equal(.add_intercept_to_formula(~ - 1), ~ 1) + expect_equal(.add_intercept_to_formula(~ x - 1), ~ x, ignore_formula_env = TRUE) + expect_equal(.add_intercept_to_formula(~ x + y - 1), ~ x + y, ignore_formula_env = TRUE) + expect_equal(.add_intercept_to_formula(~ - 1), ~ 1, ignore_formula_env = TRUE) - expect_equal(.add_intercept_to_formula(~ x + 0), ~ x) - expect_equal(.add_intercept_to_formula(~ x + y + 0), ~ x + y) - expect_equal(.add_intercept_to_formula(~ 0), ~ 1) + expect_equal(.add_intercept_to_formula(~ x + 0), ~ x, ignore_formula_env = TRUE) + expect_equal(.add_intercept_to_formula(~ x + y + 0), ~ x + y, ignore_formula_env = TRUE) + expect_equal(.add_intercept_to_formula(~ 0), ~ 1, ignore_formula_env = TRUE) }) diff --git a/tests/testthat/test-JAGS-marginal-distributions.R b/tests/testthat/test-JAGS-marginal-distributions.R index 3ffa36e..f606fe7 100644 --- a/tests/testthat/test-JAGS-marginal-distributions.R +++ b/tests/testthat/test-JAGS-marginal-distributions.R @@ -1,7 +1,25 @@ -context("JAGS marginal distributions") - -# This file tests marginal_posterior, ensemble_inference, mix_posteriors, -# and related functions. Uses pre-fitted models from test-00-model-fits.R. +# ============================================================================ # +# TEST FILE: JAGS Marginal Distributions +# ============================================================================ # +# +# PURPOSE: +# Tests for marginal_posterior, ensemble_inference, mix_posteriors, +# and related functions. Uses pre-fitted models from test-00-model-fits.R. +# +# DEPENDENCIES: +# - rjags, bridgesampling: JAGS model fitting and marginal likelihood +# - common-functions.R: temp_fits_dir, skip_if_no_fits, test_reference_table +# +# SKIP CONDITIONS: +# - skip_if_no_fits(): Pre-fitted models required +# - skip_if_not_installed("rjags"), skip_if_not_installed("bridgesampling") +# - skip_on_os(): Multivariate sampling differs across OSes (meandif priors) +# +# MODELS/FIXTURES: +# - fit_marginal_0, fit_marginal_1 +# +# TAGS: @evaluation, @JAGS, @model-averaging, @marginal +# ============================================================================ # # Reference directory for table outputs REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-marginal-distributions") @@ -9,12 +27,14 @@ REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-marginal-distributi # Load common test helpers source(testthat::test_path("common-functions.R")) +# File-level skips: All tests in this file require pre-fitted models +skip_if_no_fits() +skip_if_not_installed("rjags") +skip_if_not_installed("bridgesampling") + test_that("Marginal distribution prior and posterior functions work", { skip_on_os(c("mac", "linux", "solaris")) # multivariate sampling does not exactly match across OSes - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") # Load pre-fitted marginal distribution models fit0 <- readRDS(file.path(temp_fits_dir, "fit_marginal_0.RDS")) @@ -548,29 +568,29 @@ test_that("Marginal distribution prior and posterior functions work", { prior_samples = FALSE)), "there are no prior samples for the posterior distribution") # simple restricted prior - expect_warning(Savage_Dickey_BF(marg_post_sigma)) + suppressWarnings(expect_warning(Savage_Dickey_BF(marg_post_sigma))) BF.marg_post_sigma <- suppressWarnings(Savage_Dickey_BF(marg_post_sigma)) - expect_equivalent(BF.marg_post_sigma, NaN) + expect_equal(BF.marg_post_sigma, NaN, ignore_attr = TRUE) expect_equal(attr(BF.marg_post_sigma, "warnings"), c("Prior samples do not span both sides of the null hypothesis. Check whether the prior distribution contain the null hypothesis in the first place. The Savage-Dickey density ratio is likely to be invalid.", "Posterior samples do not span both sides of the null hypothesis. The Savage-Dickey density ratio is likely to be overestimated.")) # simple factor BF.marg_post_x_fac2t <- suppressWarnings(Savage_Dickey_BF(marg_post_simple_x_fac2t)) - expect_equivalent(BF.marg_post_x_fac2t, list("A" = 1, "B" = 0.1792675), tolerance = 1e-3) + expect_equal(BF.marg_post_x_fac2t, list("A" = 1, "B" = 0.1793), tolerance = 1e-3, ignore_attr = TRUE) expect_equal(attr(BF.marg_post_x_fac2t[["A"]], "warnings"), c("There is a considerable cluster of posterior samples at the exact null hypothesis values. The Savage-Dickey density ratio is likely to be invalid.", "There is a considerable cluster of prior samples at the exact null hypothesis values. The Savage-Dickey density ratio is likely to be invalid.")) BF.marg_post_x_fac3md <- Savage_Dickey_BF(marg_post_x_fac3md, silent = TRUE) - expect_equivalent(BF.marg_post_x_fac3md, list("A" = Inf, "B" = Inf, "C" = Inf)) + expect_equal(BF.marg_post_x_fac3md, list("A" = Inf, "B" = Inf, "C" = Inf), ignore_attr = TRUE) BF2.marg_post_x_fac3md <- Savage_Dickey_BF(marg_post_x_fac3md, null_hypothesis = 0.5) - expect_equivalent(BF2.marg_post_x_fac3md, list("A" = 4.498542, "B" = 0.1316045, "C" = 0.1651373), tolerance = 1e-3) + expect_equal(BF2.marg_post_x_fac3md, list("A" = 4.5, "B" = 0.1316, "C" = 0.165), tolerance = 1e-3, ignore_attr = TRUE) BF2.marg_post_x_fac3md <- Savage_Dickey_BF(marg_post_x_fac3md, null_hypothesis = 0.5, normal_approximation = TRUE) - expect_equal(BF2.marg_post_x_fac3md, list("A" = 0.5917503, "B" = 0.09956232, "C" = 0.1266085), tolerance = 1e-3) + expect_equal(BF2.marg_post_x_fac3md, list("A" = 0.5918, "B" = 0.0996, "C" = 0.1266), tolerance = 1e-3) ### marginal_inference ---- out <- marginal_inference( diff --git a/tests/testthat/test-JAGS-marglik.R b/tests/testthat/test-JAGS-marglik.R index d3cc548..c5a17da 100644 --- a/tests/testthat/test-JAGS-marglik.R +++ b/tests/testthat/test-JAGS-marglik.R @@ -1,4 +1,25 @@ -context("JAGS marginal likelihood functions") +# ============================================================================ # +# TEST FILE: JAGS Marginal Likelihood Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for JAGS marginal likelihood computation functions. +# Uses simple models where the log marginal likelihood is known to be 0 +# (for prior samples, the marginal likelihood for any proper prior is 1). +# +# DEPENDENCIES: +# - rjags: For JAGS model fitting +# - bridgesampling: For marginal likelihood computation +# +# SKIP CONDITIONS: +# - skip_if_not_installed("rjags") +# - Note: Creates fresh models, does not need pre-fitted models +# +# MODELS/FIXTURES: +# - Creates models with known analytical marginal likelihoods for validation +# +# TAGS: @evaluation, @JAGS, @marginal-likelihood +# ============================================================================ # # This file tests the JAGS marginal likelihood computation functions # It uses simple models where the log marginal likelihood is known to be 0 @@ -23,9 +44,7 @@ test_that("JAGS model functions work (simple)", { PEESE = prior_PEESE("gamma", list(1, 1)) #p12 = prior("bernoulli", list(0.75)) discrete priors are not supported with bridgesampling ) - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -54,9 +73,7 @@ test_that("JAGS model functions work (vector)", { p2 = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)), p3 = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) ) - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -93,9 +110,7 @@ test_that("JAGS model functions work (factor)", { attr(all_priors[[4]], "levels") <- 1 attr(all_priors[[5]], "levels") <- 3 attr(all_priors[[6]], "levels") <- 3 - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -122,9 +137,7 @@ test_that("JAGS model functions work (spike and slab)", { p3 = prior_spike_and_slab(prior("invgamma", list(4, 5)), prior_inclusion = prior("point", list(.3))) ) - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -151,9 +164,7 @@ test_that("JAGS model functions work (weightfunctions)", { prior_weightfunction("one.sided", list(c(.05, 0.60), c(1, 1), c(1, 5))), prior_weightfunction("two.sided", list(c(.05), c(1, 1))) ) - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -194,9 +205,7 @@ test_that("JAGS model functions work (spikes)", { attr(all_priors$p4.5, "levels") <- 2 attr(all_priors$p5.5, "levels") <- 2 nuisance_prior <- list(sigma = prior("normal", list(0, 1))) - log_posterior <- function(parameters, data){ - return(0) - } + log_posterior <- STANDARD_LOG_POSTERIOR for(i in seq_along(all_priors)){ @@ -327,7 +336,7 @@ test_that(".fit_to_posterior handles different input types", { model_syntax <- JAGS_add_priors("model{}", prior_list) monitor <- JAGS_to_monitor(prior_list) inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) - log_posterior <- function(parameters, data) return(0) + log_posterior <- STANDARD_LOG_POSTERIOR set.seed(1) model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) @@ -357,7 +366,7 @@ test_that(".fit_to_posterior handles jags.samples output", { model_syntax <- JAGS_add_priors("model{}", prior_list) monitor <- JAGS_to_monitor(prior_list) inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) - log_posterior <- function(parameters, data) return(0) + log_posterior <- STANDARD_LOG_POSTERIOR set.seed(1) model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) @@ -377,7 +386,7 @@ test_that(".fit_to_posterior handles vector parameters in jags.samples", { model_syntax <- JAGS_add_priors("model{}", prior_list) monitor <- JAGS_to_monitor(prior_list) inits <- JAGS_get_inits(prior_list, chains = 2, seed = 1) - log_posterior <- function(parameters, data) return(0) + log_posterior <- STANDARD_LOG_POSTERIOR set.seed(1) model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) @@ -395,7 +404,7 @@ test_that("JAGS_bridgesampling handles runjags output", { prior_list <- list(mu = prior("normal", list(0, 1))) model_syntax <- JAGS_add_priors("model{}", prior_list) - log_posterior <- function(parameters, data) return(0) + log_posterior <- STANDARD_LOG_POSTERIOR set.seed(1) fit <- suppressWarnings(runjags::run.jags( diff --git a/tests/testthat/test-JAGS-posterior-extraction.R b/tests/testthat/test-JAGS-posterior-extraction.R index 22482aa..9666ddf 100644 --- a/tests/testthat/test-JAGS-posterior-extraction.R +++ b/tests/testthat/test-JAGS-posterior-extraction.R @@ -1,9 +1,27 @@ -context("Posterior density extraction functions") +# ============================================================================ # +# TEST FILE: Posterior Density Extraction Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for posterior extraction helper functions including +# .extract_posterior_samples and .remove_auxiliary_parameters. +# +# DEPENDENCIES: +# - rjags, runjags, coda: For JAGS model handling +# +# SKIP CONDITIONS: +# - skip_if_not_installed("rjags"), skip_if_not_installed("runjags") +# - Note: Creates mock objects, does not need pre-fitted models +# +# MODELS/FIXTURES: +# - Creates mock runjags objects for testing +# +# TAGS: @evaluation, @JAGS, @posterior-extraction +# ============================================================================ # # Tests for posterior extraction helper functions test_that(".extract_posterior_samples extracts samples correctly", { - skip_on_cran() skip_if_not_installed("rjags") skip_if_not_installed("runjags") diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index bf988a2..0247c9e 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -1,4 +1,25 @@ -context("JAGS summary tables functions") +# ============================================================================ # +# TEST FILE: JAGS Summary Tables Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for runjags_estimates_table, runjags_inference_table, and related +# summary table generation functions. +# +# DEPENDENCIES: +# - rjags, bridgesampling: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, skip_if_no_fits, test_reference_table +# +# SKIP CONDITIONS: +# - First section (empty tables): Can run on CRAN (pure R) +# - Second section (advanced features): skip_if_no_fits() +# +# MODELS/FIXTURES: +# - fit_formula_interaction_cont, fit_factor_treatment, fit_spike_slab_factor +# - fit_factor_orthonormal +# +# TAGS: @evaluation, @JAGS, @summary-tables +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-summary-tables") source(testthat::test_path("common-functions.R")) @@ -10,7 +31,7 @@ test_that("Empty summary tables work correctly", { runjags_summary_empty <- runjags_estimates_empty_table() - expect_equivalent(nrow(runjags_summary_empty), 0) + expect_equal(nrow(runjags_summary_empty), 0, ignore_attr = TRUE) # Test that empty tables have correct structure expect_s3_class(runjags_summary_empty, "BayesTools_table") diff --git a/tests/testthat/test-distributions-mpoint.R b/tests/testthat/test-distributions-mpoint.R index aa85096..994adb0 100644 --- a/tests/testthat/test-distributions-mpoint.R +++ b/tests/testthat/test-distributions-mpoint.R @@ -1,4 +1,19 @@ -context("Distributions - Multivariate point") +# ============================================================================ # +# TEST FILE: Distributions - Multivariate Point +# ============================================================================ # +# +# PURPOSE: +# Tests for multivariate point distribution functions (dmpoint, rmpoint, +# pmpoint, qmpoint). +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @distributions, @multivariate +# ============================================================================ # test_that("Density function works", { diff --git a/tests/testthat/test-distributions-point.R b/tests/testthat/test-distributions-point.R index b2dcf64..97fa9a5 100644 --- a/tests/testthat/test-distributions-point.R +++ b/tests/testthat/test-distributions-point.R @@ -1,4 +1,18 @@ -context("Distributions - Point") +# ============================================================================ # +# TEST FILE: Distributions - Point +# ============================================================================ # +# +# PURPOSE: +# Tests for point distribution functions (dpoint, rpoint, ppoint, qpoint). +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @distributions, @point +# ============================================================================ # test_that("Density function works", { diff --git a/tests/testthat/test-distributions-tools.R b/tests/testthat/test-distributions-tools.R index 0aea7c5..90def75 100644 --- a/tests/testthat/test-distributions-tools.R +++ b/tests/testthat/test-distributions-tools.R @@ -1,4 +1,19 @@ -context("Distribution tools helpers") +# ============================================================================ # +# TEST FILE: Distribution Tools Helpers +# ============================================================================ # +# +# PURPOSE: +# Tests for internal distribution helper functions like .check_log, +# .check_log.p, and .check_lower.tail. +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @distributions, @tools +# ============================================================================ # test_that(".check_log works", { diff --git a/tests/testthat/test-distributions-weightfunctions.R b/tests/testthat/test-distributions-weightfunctions.R index 11bcce3..ab4eb44 100644 --- a/tests/testthat/test-distributions-weightfunctions.R +++ b/tests/testthat/test-distributions-weightfunctions.R @@ -1,4 +1,22 @@ -context("Distributions - Weight functions") +# ============================================================================ # +# TEST FILE: Distributions - Weight Functions +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for weight function distributions including +# one-sided and two-sided weight functions. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - extraDistr: Additional distributions for comparison +# +# SKIP CONDITIONS: +# - skip_if_not_installed("vdiffr") +# +# TAGS: @evaluation, @visual, @distributions, @weightfunctions +# ============================================================================ # + +skip_if_not_installed("vdiffr") test_that("Density function works", { diff --git a/tests/testthat/test-interpret.R b/tests/testthat/test-interpret.R index 6f6893f..cf04709 100644 --- a/tests/testthat/test-interpret.R +++ b/tests/testthat/test-interpret.R @@ -1,4 +1,19 @@ -context("Interpret functions") +# ============================================================================ # +# TEST FILE: Interpret Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for interpret and interpret2 functions that generate human-readable +# summaries of Bayesian inference results. +# +# DEPENDENCIES: +# - common-functions.R: test_reference_text, REFERENCE_DIR +# +# SKIP CONDITIONS: +# - None (can run on CRAN - pure R with reference file testing) +# +# TAGS: @evaluation, @interpret, @output +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "interpret") source(testthat::test_path("common-functions.R")) diff --git a/tests/testthat/test-model-averaging-edge-cases.R b/tests/testthat/test-model-averaging-edge-cases.R index 23819ea..55c87a3 100644 --- a/tests/testthat/test-model-averaging-edge-cases.R +++ b/tests/testthat/test-model-averaging-edge-cases.R @@ -1,4 +1,24 @@ -context("Model averaging edge cases and comprehensive tests") +# ============================================================================ # +# TEST FILE: Model Averaging Edge Cases +# ============================================================================ # +# +# PURPOSE: +# Edge case and comprehensive tests for model averaging functions including +# mix_posteriors, ensemble_inference, and related utilities. +# +# DEPENDENCIES: +# - rjags: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, skip_if_no_fits, test_reference_text +# +# SKIP CONDITIONS: +# - skip_if_no_fits(): Pre-fitted models required +# - skip_if_not_installed("rjags") +# +# MODELS/FIXTURES: +# - fit_simple_normal, fit_simple_spike, fit_formula_interaction_fac +# +# TAGS: @evaluation, @model-averaging, @edge-cases +# ============================================================================ # # Reference directory for text output comparisons REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-edge-cases") diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R index 7d3cae5..10719e9 100644 --- a/tests/testthat/test-model-averaging-plots-edge-cases.R +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -1,4 +1,24 @@ -context("Model averaging plots edge cases") +# ============================================================================ # +# TEST FILE: Model Averaging Plots Edge Cases +# ============================================================================ # +# +# PURPOSE: +# Edge case tests for plot_prior_list, plot_posterior, plot_models and +# related visualization functions. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - common-functions.R: REFERENCE_DIR, test_reference_table +# +# SKIP CONDITIONS: +# - skip_if_not_installed("vdiffr"): For visual tests +# - Note: First section (input validation) can run on CRAN (pure R) +# +# MODELS/FIXTURES: +# - None required (pure prior testing) +# +# TAGS: @evaluation, @edge-cases, @plots, @model-averaging +# ============================================================================ # # Reference directory for text output comparisons (if needed) REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-plots-edge-cases") diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R index cc6c9a2..53cb7f9 100644 --- a/tests/testthat/test-model-averaging.R +++ b/tests/testthat/test-model-averaging.R @@ -1,4 +1,23 @@ -context("Model averaging functions") +# ============================================================================ # +# TEST FILE: Model Averaging Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for compute_inference, ensemble_inference, and related Bayesian +# model averaging functions in R/model-averaging.R +# +# DEPENDENCIES: +# - bridgesampling: Required for marginal likelihood computation +# - common-functions.R: Test helpers +# +# SKIP CONDITIONS: +# - skip_if_not_installed("bridgesampling") +# +# MODELS/FIXTURES: +# - Uses pre-computed marginal likelihoods, not pre-fitted models +# +# TAGS: @evaluation, @model-averaging +# ============================================================================ # test_that("compute_inference works correctly", { diff --git a/tests/testthat/test-priors-coverage.R b/tests/testthat/test-priors-coverage.R index df90fa6..a726265 100644 --- a/tests/testthat/test-priors-coverage.R +++ b/tests/testthat/test-priors-coverage.R @@ -1,15 +1,39 @@ -context("Prior distribution coverage tests") - -# Targeted coverage tests for priors.R uncovered lines - - -test_that("Unknown distribution name error (line 115)", { +# ============================================================================ # +# TEST FILE: Prior Distribution Coverage Tests +# ============================================================================ # +# +# PURPOSE: +# Targeted tests to ensure code coverage for edge cases and error paths +# in R/priors.R that are not covered by main test-priors.R +# +# DEPENDENCIES: +# - No external packages required beyond testthat +# +# SKIP CONDITIONS: +# - None (fast, pure R tests) +# +# MODELS/FIXTURES: +# - None required +# +# TAGS: @coverage, @edge-cases, @priors +# ============================================================================ # + + +# ============================================================================ # +# SECTION: prior() constructor errors +# ============================================================================ # + +test_that("prior() rejects unknown distribution names", { expect_error(prior("unknown_dist", list(0, 1)), "The specified distribution name") }) -test_that("prior_factor orthonormal/meandif with non-vector prior error (lines 328, 334, 336)", { +# ============================================================================ # +# SECTION: prior_factor() contrast validation +# ============================================================================ # + +test_that("prior_factor() requires multivariate prior for orthonormal/meandif contrasts", { # orthonormal contrast requires multivariate distribution expect_error(prior_factor("normal", list(0, 1), contrast = "orthonormal"), "contrasts require multivariate prior") @@ -17,27 +41,24 @@ test_that("prior_factor orthonormal/meandif with non-vector prior error (lines 3 # meandif contrast requires multivariate distribution expect_error(prior_factor("normal", list(0, 1), contrast = "meandif"), "contrasts require multivariate prior") -}) - -test_that("prior_factor orthonormal/meandif with unsupported distribution (line 346)", -{ # bernoulli is not a valid multivariate distribution expect_error(prior_factor("bernoulli", list(0.5), contrast = "orthonormal"), "contrasts require multivariate prior") }) -test_that("prior_factor treatment contrast requires univariate (line 358)", { - # treatment contrast with multivariate dist should fail - # mnormal requires 3 params, so it fails earlier - use a valid multivariate prior +test_that("prior_factor() requires univariate prior for treatment contrast", { expect_error(prior_factor("mnormal", list(0, 1, 2), contrast = "treatment"), "contrasts require univariate prior") }) -test_that("prior_spike_and_slab with factor prior (lines 402-408)", { - # spike_and_slab with factor prior as variable +# ============================================================================ # +# SECTION: spike_and_slab prior construction and helpers +# ============================================================================ # + +test_that("prior_spike_and_slab() works with factor priors", { p_factor <- prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal") p_factor$parameters[["K"]] <- 2 @@ -51,13 +72,12 @@ test_that("prior_spike_and_slab with factor prior (lines 402-408)", { }) -test_that(".set_spike_and_slab_variable_attr (lines 486-497)", { +test_that(".set_spike_and_slab_variable_attr() sets attributes correctly", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) ) - # Set an attribute on the variable component p_ss2 <- BayesTools:::.set_spike_and_slab_variable_attr(p_ss, "test_attr", "test_value") expect_true(is.prior.spike_and_slab(p_ss2)) @@ -67,20 +87,23 @@ test_that(".set_spike_and_slab_variable_attr (lines 486-497)", { }) -test_that(".get_spike_and_slab_variable error (line 459)", { +test_that(".get_spike_and_slab_variable() requires spike_and_slab prior", { expect_error(BayesTools:::.get_spike_and_slab_variable(prior("normal", list(0, 1))), "only works with spike_and_slab priors") }) -test_that(".get_spike_and_slab_inclusion error (lines 471, 476)", { +test_that(".get_spike_and_slab_inclusion() requires spike_and_slab prior", { expect_error(BayesTools:::.get_spike_and_slab_inclusion(prior("normal", list(0, 1))), "only works with spike_and_slab priors") }) -test_that("prior_mixture with factor prior containing spike (lines 522, 538)", { - # Mixture of factor priors where one is a spike +# ============================================================================ # +# SECTION: prior_mixture() construction +# ============================================================================ # + +test_that("prior_mixture() creates factor_mixture with spike component", { p1 <- prior("spike", list(0)) p2 <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p2$parameters[["K"]] <- 2 @@ -91,8 +114,7 @@ test_that("prior_mixture with factor prior containing spike (lines 522, 538)", { }) -test_that("prior_mixture with prior_none factor (line 576)", { - # Mixture with prior_none that should be converted to factor spike +test_that("prior_mixture() handles prior_none in factor mixtures", { p1 <- prior_none() p2 <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p2$parameters[["K"]] <- 2 @@ -103,8 +125,7 @@ test_that("prior_mixture with prior_none factor (line 576)", { }) -test_that("prior_mixture bias mixture (lines 585, 600)", { - # PET/PEESE/weightfunction mixture +test_that("prior_mixture() creates bias_mixture for PET/PEESE/weightfunction", { p_pet <- prior_PET("normal", list(0, 1)) p_wf <- prior_weightfunction("one.sided", list(steps = c(0.05), alpha = c(1, 1))) @@ -114,13 +135,21 @@ test_that("prior_mixture bias mixture (lines 585, 600)", { }) -test_that("Uniform prior with a > b error (line 843)", { +# ============================================================================ # +# SECTION: Distribution parameter validation +# ============================================================================ # + +test_that("uniform prior requires a < b", { expect_error(prior("uniform", list(a = 5, b = 1)), "lower than") }) -test_that("rng spike_and_slab sample_components (line 1155)", { +# ============================================================================ # +# SECTION: rng() function with sample_components +# ============================================================================ # + +test_that("rng() spike_and_slab returns component indicators", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) @@ -134,7 +163,7 @@ test_that("rng spike_and_slab sample_components (line 1155)", { }) -test_that("rng mixture sample_components (line 1190)", { +test_that("rng() mixture returns component indicators", { p_mix <- prior_mixture( list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), components = c("a", "b") @@ -148,7 +177,7 @@ test_that("rng mixture sample_components (line 1190)", { }) -test_that("rng factor_mixture (lines 1221, 1236, 1240, 1244-1247)", { +test_that("rng() factor_mixture with transform_factor_samples", { p_mix <- prior_mixture( list( prior("spike", list(0)), @@ -161,18 +190,16 @@ test_that("rng factor_mixture (lines 1221, 1236, 1240, 1244-1247)", { } set.seed(1) - # Default: transform_factor_samples = FALSE samples <- rng(p_mix, 10, transform_factor_samples = FALSE) expect_true(is.matrix(samples)) - # With transform_factor_samples = TRUE samples2 <- rng(p_mix, 10, transform_factor_samples = TRUE) expect_true(is.matrix(samples2)) expect_equal(ncol(samples2), 3) # K+1 columns }) -test_that("rng orthonormal/meandif transform (line 1284)", { +test_that("rng() orthonormal prior with transform_factor_samples", { p <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p$parameters[["K"]] <- 2 @@ -184,7 +211,11 @@ test_that("rng orthonormal/meandif transform (line 1284)", { }) -test_that("cdf with truncation for spike_and_slab error (lines 1329, 1333)", { +# ============================================================================ # +# SECTION: cdf() function edge cases +# ============================================================================ # + +test_that("cdf() not implemented for spike_and_slab", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) @@ -194,44 +225,50 @@ test_that("cdf with truncation for spike_and_slab error (lines 1329, 1333)", { }) -test_that("cdf with truncation for simple prior (lines 1363, 1365, 1367, 1369)", { +test_that("cdf() handles truncated priors correctly", { p <- prior("normal", list(0, 1), truncation = list(-2, 2)) - # Test cdf at various points expect_true(cdf(p, 0) > 0) expect_true(cdf(p, -3) == 0) # Below truncation - expect_true(cdf(p, 3) >= 1 - 1e-6) # Above truncation (approx 1) + expect_true(cdf(p, 3) >= 1 - 1e-6) # Above truncation }) -test_that("ccdf errors and truncation (lines 1385, 1389, 1419-1425)", { +# ============================================================================ # +# SECTION: ccdf() function edge cases +# ============================================================================ # + +test_that("ccdf() not implemented for spike_and_slab or mixture", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) ) - expect_error(ccdf(p_ss, 0), "No ccdf are implemented for spike and slab") - # Mixture error p_mix <- prior_mixture( list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), components = c("a", "b") ) expect_error(ccdf(p_mix, 0), "No ccdf are implemented for prior mixtures") +}) + - # ccdf with truncation +test_that("ccdf() handles truncated priors correctly", { p <- prior("normal", list(0, 1), truncation = list(-2, 2)) expect_true(ccdf(p, 0) > 0) expect_true(ccdf(p, 3) == 0) # Above truncation }) -test_that("lpdf spike_and_slab and mixture errors (lines 1442, 1446, 1496, 1498)", { +# ============================================================================ # +# SECTION: lpdf() function edge cases +# ============================================================================ # + +test_that("lpdf() not implemented for spike_and_slab or mixture", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) ) - expect_error(lpdf(p_ss, 0), "No lpdf are implemented for spike and slab") p_mix <- prior_mixture( @@ -242,12 +279,15 @@ test_that("lpdf spike_and_slab and mixture errors (lines 1442, 1446, 1496, 1498) }) -test_that("quant spike_and_slab and mixture errors (lines 1528, 1532)", { +# ============================================================================ # +# SECTION: quant() function edge cases +# ============================================================================ # + +test_that("quant() not implemented for spike_and_slab or mixture", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), prior_inclusion = prior("beta", list(1, 1)) ) - expect_error(quant(p_ss, 0.5), "No quant(ile)? functions? are implemented for spike and slab") p_mix <- prior_mixture( @@ -258,14 +298,12 @@ test_that("quant spike_and_slab and mixture errors (lines 1528, 1532)", { }) -test_that("quant with non-default truncation optimization (lines 1561, 1582, 1584)", { - # Truncated prior that requires optimization in quant +test_that("quant() handles truncated priors with optimization", { p <- prior("normal", list(0, 1), truncation = list(0.5, 2)) q <- quant(p, 0.5) expect_true(q > 0.5 && q < 2) - # Also test edge quantiles q_low <- quant(p, 0.01) q_high <- quant(p, 0.99) expect_true(q_low >= 0.5) @@ -273,15 +311,17 @@ test_that("quant with non-default truncation optimization (lines 1561, 1582, 158 }) -test_that("mcdf for orthonormal/meandif (lines 1681, 1685, 1689, 1711-1722)", { - # orthonormal prior +# ============================================================================ # +# SECTION: Multivariate distribution functions (mcdf, mccdf, mlpdf, mquant) +# ============================================================================ # + +test_that("mcdf() works for orthonormal and meandif priors", { p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p_orth$parameters[["K"]] <- 2 cdf_val <- mcdf(p_orth, 0) expect_true(cdf_val >= 0 && cdf_val <= 1) - # meandif prior p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") p_md$parameters[["K"]] <- 2 @@ -290,7 +330,7 @@ test_that("mcdf for orthonormal/meandif (lines 1681, 1685, 1689, 1711-1722)", { }) -test_that("mccdf for orthonormal/meandif (lines 1760-1801)", { +test_that("mccdf() works for orthonormal and meandif priors", { p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p_orth$parameters[["K"]] <- 2 @@ -305,7 +345,7 @@ test_that("mccdf for orthonormal/meandif (lines 1760-1801)", { }) -test_that("mlpdf for orthonormal/meandif (lines 1840, 1844, 1870, 1874)", { +test_that("mlpdf() works for orthonormal and meandif priors", { p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p_orth$parameters[["K"]] <- 2 @@ -320,7 +360,7 @@ test_that("mlpdf for orthonormal/meandif (lines 1840, 1844, 1870, 1874)", { }) -test_that("mquant for orthonormal/meandif (lines 1933, 1937, 1963, 1967)", { +test_that("mquant() works for orthonormal and meandif priors", { p_orth <- prior_factor("mnormal", list(0, 1), contrast = "orthonormal") p_orth$parameters[["K"]] <- 2 @@ -335,18 +375,24 @@ test_that("mquant for orthonormal/meandif (lines 1933, 1937, 1963, 1967)", { }) -test_that("pdf.default passes through to stats::dnorm for vectors", { - # pdf.default calls stats::dnorm for numeric vectors, not an error - # This tests the generic S3 dispatch working correctly +# ============================================================================ # +# SECTION: S3 dispatch and generic functions +# ============================================================================ # + +test_that("pdf() S3 dispatch works for prior objects", { p <- prior("normal", list(0, 1)) expect_true(is.numeric(pdf(p, 0))) }) -test_that("mean.prior for spike_and_slab (line 2123)", { +# ============================================================================ # +# SECTION: mean() function edge cases +# ============================================================================ # + +test_that("mean() works for spike_and_slab priors", { p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(1, 1)), - prior_inclusion = prior("point", list(0.5)) # Fixed inclusion probability + prior_inclusion = prior("point", list(0.5)) ) m <- mean(p_ss) @@ -355,21 +401,21 @@ test_that("mean.prior for spike_and_slab (line 2123)", { }) -test_that("mean.prior for truncated distributions (lines 2148, 2153)", { +test_that("mean() handles truncated distributions and undefined moments", { # Truncated normal p <- prior("normal", list(0, 1), truncation = list(0, Inf)) m <- mean(p) expect_true(m > 0) - # Truncated t with df <= 1 should return NaN + # Truncated t with df <= 1 returns NaN p_t <- prior("t", list(0, 1, 1), truncation = list(-1, 1)) m_t <- mean(p_t) expect_true(is.nan(m_t)) }) -test_that("mean.prior for orthonormal/meandif with mt df<=1 (lines 2181, 2185, 2189)", { - p_mt <- prior_factor("mt", list(0, 1, 1), contrast = "orthonormal") # df = 1 +test_that("mean() returns NaN for multivariate t with df <= 1", { + p_mt <- prior_factor("mt", list(0, 1, 1), contrast = "orthonormal") p_mt$parameters[["K"]] <- 2 m <- mean(p_mt) @@ -377,14 +423,17 @@ test_that("mean.prior for orthonormal/meandif with mt df<=1 (lines 2181, 2185, 2 }) -test_that("var dispatches to stats::var for vectors", { - # var.default calls stats::var for numeric vectors +# ============================================================================ # +# SECTION: var() function edge cases +# ============================================================================ # + +test_that("var() S3 dispatch works for numeric vectors", { x <- c(1, 2, 3, 4, 5) expect_equal(var(x), stats::var(x)) }) -test_that("var.prior for spike_and_slab (lines 2276-2291)", { +test_that("var() works for spike_and_slab priors", { # spike_and_slab with beta inclusion p_ss <- prior_spike_and_slab( prior_parameter = prior("normal", list(0, 1)), @@ -404,33 +453,33 @@ test_that("var.prior for spike_and_slab (lines 2276-2291)", { }) -test_that("var.prior for truncated distributions (lines 2316, 2321)", { - # t with df <= 2 should return NaN for variance +test_that("var() returns NaN for distributions with undefined variance", { + # t with df <= 2 returns NaN for variance p_t <- prior("t", list(0, 1, 2), truncation = list(-1, 1)) v <- var(p_t) expect_true(is.nan(v)) - # invgamma with shape <= 2 should return NaN + # invgamma with shape <= 2 returns NaN p_ig <- prior("invgamma", list(2, 1), truncation = list(0.1, 10)) v_ig <- var(p_ig) expect_true(is.nan(v_ig)) }) -test_that("var.prior for orthonormal/meandif (lines 2350-2368)", { - # orthonormal with mpoint +test_that("var() works for orthonormal and meandif priors", { + # orthonormal with mpoint returns 0 p_mp <- prior_factor("mpoint", list(0), contrast = "orthonormal") p_mp$parameters[["K"]] <- 2 v <- var(p_mp) expect_equal(v, 0) - # orthonormal with mt and df <= 2 + # orthonormal with mt and df <= 2 returns NaN p_mt <- prior_factor("mt", list(0, 1, 2), contrast = "orthonormal") p_mt$parameters[["K"]] <- 2 v_mt <- var(p_mt) expect_true(is.nan(v_mt)) - # meandif with mnormal + # meandif with mnormal returns positive variance p_md <- prior_factor("mnormal", list(0, 1), contrast = "meandif") p_md$parameters[["K"]] <- 2 v_md <- var(p_md) @@ -438,7 +487,7 @@ test_that("var.prior for orthonormal/meandif (lines 2350-2368)", { }) -test_that("var.prior for mixture error", { +test_that("var() not implemented for mixture priors", { p_mix <- prior_mixture( list(prior("normal", list(0, 1)), prior("normal", list(3, 1))), components = c("a", "b") diff --git a/tests/testthat/test-priors-density.R b/tests/testthat/test-priors-density.R index 68b3460..a1b8885 100644 --- a/tests/testthat/test-priors-density.R +++ b/tests/testthat/test-priors-density.R @@ -1,4 +1,21 @@ -context("Prior density") +# ============================================================================ # +# TEST FILE: Prior Density Function +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for the density.prior S3 method including +# various transformation options. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# +# SKIP CONDITIONS: +# - skip_if_not_installed("vdiffr") +# +# TAGS: @evaluation, @visual, @priors, @density +# ============================================================================ # + +skip_if_not_installed("vdiffr") test_that("Prior density function density", { set.seed(1) diff --git a/tests/testthat/test-priors-informed.R b/tests/testthat/test-priors-informed.R index d1ddbd2..0b27ff5 100644 --- a/tests/testthat/test-priors-informed.R +++ b/tests/testthat/test-priors-informed.R @@ -1,4 +1,19 @@ -context("Prior informed function") +# ============================================================================ # +# TEST FILE: Prior Informed Function +# ============================================================================ # +# +# PURPOSE: +# Tests for prior_informed function that creates priors based on +# published informed prior specifications (Oosterwijk, van Erp, medicine). +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @priors, @informed +# ============================================================================ # test_that("Informed prior distributions match the specification", { diff --git a/tests/testthat/test-priors-plot.R b/tests/testthat/test-priors-plot.R index 5aec244..7f6bf11 100644 --- a/tests/testthat/test-priors-plot.R +++ b/tests/testthat/test-priors-plot.R @@ -1,4 +1,21 @@ -context("Prior plot function") +# ============================================================================ # +# TEST FILE: Prior Plot Function +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for the plot.prior S3 method including +# base graphics and ggplot2 output. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# +# SKIP CONDITIONS: +# - skip_if_not_installed("vdiffr") +# +# TAGS: @evaluation, @visual, @priors, @plots +# ============================================================================ # + +skip_if_not_installed("vdiffr") test_that("Prior plot (simple) function works", { diff --git a/tests/testthat/test-priors-print.R b/tests/testthat/test-priors-print.R index c9e6376..707d0ac 100644 --- a/tests/testthat/test-priors-print.R +++ b/tests/testthat/test-priors-print.R @@ -1,4 +1,19 @@ -context("Prior print function") +# ============================================================================ # +# TEST FILE: Prior Print Function +# ============================================================================ # +# +# PURPOSE: +# Tests for the print.prior S3 method including input validation, +# formatting options, and output correctness. +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @priors, @print +# ============================================================================ # test_that("Prior print function input validation", { diff --git a/tests/testthat/test-priors-tools.R b/tests/testthat/test-priors-tools.R index ffb0e2b..680854b 100644 --- a/tests/testthat/test-priors-tools.R +++ b/tests/testthat/test-priors-tools.R @@ -1,4 +1,19 @@ -context("Prior distribution tool functions") +# ============================================================================ # +# TEST FILE: Prior Distribution Tool Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for prior handling utilities, parameter checks, and prior type +# detection functions. +# +# DEPENDENCIES: +# - None (pure R) +# +# SKIP CONDITIONS: +# - None (can run on CRAN) +# +# TAGS: @evaluation, @priors, @tools +# ============================================================================ # test_that("Prior handling works", { diff --git a/tests/testthat/test-priors.R b/tests/testthat/test-priors.R index 8e94887..36529dd 100644 --- a/tests/testthat/test-priors.R +++ b/tests/testthat/test-priors.R @@ -1,119 +1,33 @@ -context("Prior distribution functions") - -# each test checks that a corresponding prior distribution can be created and the following functions work: -# - random number generator -# - quantile function -# - density function -# - distribution function -# - print function -# - mean and sd functions -test_prior <- function(prior, skip_moments = FALSE){ - set.seed(1) - # tests rng and print function (for plot) - samples <- rng(prior, 100000) - if(is.prior.discrete(prior)){ - barplot(table(samples)/length(samples), main = print(prior, plot = T), width = 1/(max(samples)+1), space = 0, xlim = c(-0.25, max(samples)+0.25)) - }else if(is.prior.spike_and_slab(prior)){ - xh <- hist(samples[samples != 0], breaks = 50, plot = FALSE) - xh$density <- xh$density * mean(samples != 0) - plot(xh, main = print(prior, plot = T), freq = FALSE) - }else{ - hist(samples, main = print(prior, plot = T), breaks = 50, freq = FALSE) - } - # tests density function - lines(prior, individual = TRUE) - - # tests quantile function - if(!is.prior.spike_and_slab(prior) && !is.prior.mixture(prior)){ - abline(v = quant(prior, 0.5), col = "blue", lwd = 2) - } - # tests that pdf(q(x)) == x - if(!is.prior.point(prior) && !is.prior.discrete(prior) && !is.prior.spike_and_slab(prior) && !is.prior.mixture(prior)){ - expect_equal(.25, cdf(prior, quant(prior, 0.25)), tolerance = 1e-4) - expect_equal(.25, ccdf(prior, quant(prior, 0.75)), tolerance = 1e-4) - } - # test mean and sd functions - if(!skip_moments){ - expect_equal(mean(samples), mean(prior), tolerance = 1e-2) - expect_equal(sd(samples), sd(prior), tolerance = 1e-2) - } - return(invisible()) -} -test_weightfunction <- function(prior, skip_moments = FALSE){ - set.seed(1) - # tests rng and print function (for plot) - samples <- rng(prior, 10000) - densities <- density(prior, individual = TRUE) - - if(!all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))){ - quantiles <- mquant(prior, 0.5) - } +# ============================================================================ # +# TEST FILE: Prior Distribution Evaluation Tests +# ============================================================================ # +# +# PURPOSE: +# Visual regression tests for prior distribution functions (rng, pdf, cdf, +# quant, mean, sd). Each test validates a distribution type works correctly. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - common-functions.R: test_prior, test_weightfunction, test_orthonormal, +# test_meandif helper functions +# +# SKIP CONDITIONS: +# - skip_on_os(c("mac", "linux", "solaris")): Multivariate sampling tests +# (orthonormal, meandif priors only) +# - Note: Pure R tests - can run on CRAN +# +# MODELS/FIXTURES: +# - None required (pure prior testing) +# +# TAGS: @evaluation, @visual, @priors +# ============================================================================ # + +# Load test helper functions +source(testthat::test_path("common-functions.R")) + +# File-level skips for visual regression +skip_if_not_installed("vdiffr") - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mfcol = oldpar[["mfcol"]])) - par(mfcol = c(1, ncol(samples)-1)) - - for(i in 1:(ncol(samples)-1)){ - hist(samples[,i], main = print(prior, plot = T), breaks = 50, freq = FALSE) - lines(densities[[i]]) - if(!all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))){ - abline(v = quantiles[i], col = "blue", lwd = 2) - } - if(!grepl("fixed", prior$distribution) & !all(names(prior$parameters) %in% c("steps", "alpha1", "alpha2"))){ - expect_equal(.25, mcdf(prior, mquant(prior, 0.25)[,i])[,i], tolerance = 1e-5) - expect_equal(.25, mccdf.prior(prior, mquant(prior, 0.75)[,i])[,i], tolerance = 1e-5) - } - if(!skip_moments){ - expect_equal(apply(samples, 2, mean), mean(prior), tolerance = 1e-2) - expect_equal(apply(samples, 2, sd), sd(prior) , tolerance = 1e-2) - } - } - return(invisible()) -} -test_orthonormal <- function(prior, skip_moments = FALSE){ - set.seed(1) - # tests rng and print function (for plot) - samples <- rng(prior, 100000) - samples <- samples[abs(samples) < 10] - hist(samples, main = print(prior, plot = T), breaks = 50, freq = FALSE) - # tests density function - lines(prior, individual = TRUE) - # tests quantile function - abline(v = mquant(prior, 0.5), col = "blue", lwd = 2) - # tests that pdf(q(x)) == x - if(!is.prior.point(prior)){ - expect_equal(.25, mcdf(prior, mquant(prior, 0.25)), tolerance = 1e-5) - expect_equal(.25, mccdf(prior, mquant(prior, 0.75)), tolerance = 1e-5) - } - # test mean and sd functions - if(!skip_moments){ - expect_equal(mean(samples), mean(prior), tolerance = 1e-2) - expect_equal(sd(samples), sd(prior), tolerance = 1e-2) - } - return(invisible()) -} -test_meandif <- function(prior, skip_moments = FALSE){ - set.seed(1) - # tests rng and print function (for plot) - samples <- rng(prior, 100000) - samples <- samples[abs(samples) < 10] - hist(samples, main = print(prior, plot = T), breaks = 50, freq = FALSE) - # tests density function - lines(prior, individual = TRUE) - # tests quantile function - abline(v = mquant(prior, 0.5), col = "blue", lwd = 2) - # tests that pdf(q(x)) == x - if(!is.prior.point(prior)){ - expect_equal(.25, mcdf(prior, mquant(prior, 0.25)), tolerance = 1e-5) - expect_equal(.25, mccdf(prior, mquant(prior, 0.75)), tolerance = 1e-5) - } - # test mean and sd functions - if(!skip_moments){ - expect_equal(mean(samples), mean(prior), tolerance = 1e-2) - expect_equal(sd(samples), sd(prior), tolerance = 1e-2) - } - return(invisible()) -} test_that("Normal prior distribution works", { diff --git a/tests/testthat/test-summary-tables-edge-cases.R b/tests/testthat/test-summary-tables-edge-cases.R index 369ff19..3a20087 100644 --- a/tests/testthat/test-summary-tables-edge-cases.R +++ b/tests/testthat/test-summary-tables-edge-cases.R @@ -1,28 +1,36 @@ -context("Summary tables edge cases and comprehensive tests") +# ============================================================================ # +# TEST FILE: Summary Tables Edge Cases +# ============================================================================ # +# +# PURPOSE: +# Edge case and comprehensive tests for summary table functions including +# ensemble_estimates_table, ensemble_inference_table, and print methods. +# +# DEPENDENCIES: +# - rjags, bridgesampling: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, test_reference_table +# +# SKIP CONDITIONS: +# - skip_if_no_fits(): Pre-fitted models required for most tests +# - skip_if_not_installed("rjags"), skip_if_not_installed("bridgesampling") +# +# MODELS/FIXTURES: +# - fit_summary*, fit_simple_normal, fit_simple_spike +# +# TAGS: @evaluation, @edge-cases, @summary-tables +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables-edge-cases") source(testthat::test_path("common-functions.R")) -# Helper to skip if pre-fitted models aren't available -skip_if_no_fits <- function() { - skip_if_not_installed("rjags") - skip_if_not_installed("bridgesampling") - if (!dir.exists(temp_fits_dir)) { - skip("Pre-fitted models directory not found. Run test-00-model-fits.R first.") - } - if (!file.exists(file.path(temp_fits_dir, "fit_simple_normal.RDS"))) { - skip("Pre-fitted models not found. Run test-00-model-fits.R first.") - } -} - # ============================================================================ # # SECTION 1: ensemble_estimates_table edge cases # ============================================================================ # test_that("ensemble_estimates_table handles matrix posteriors", { - skip_if_not_installed("rjags") - skip_on_cran() skip_if_no_fits() + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") # Load fits with margliks for creating mixed posteriors fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) diff --git a/tests/testthat/test-summary-tables-helpers.R b/tests/testthat/test-summary-tables-helpers.R index a769522..9cdc837 100644 --- a/tests/testthat/test-summary-tables-helpers.R +++ b/tests/testthat/test-summary-tables-helpers.R @@ -1,4 +1,19 @@ -context("Summary tables helper functions") +# ============================================================================ # +# TEST FILE: Summary Tables Helper Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for format_BF, format_estimates, and other summary table +# formatting utilities. +# +# DEPENDENCIES: +# - common-functions.R: test_reference_table, REFERENCE_DIR +# +# SKIP CONDITIONS: +# - None (can run on CRAN - pure R with reference file testing) +# +# TAGS: @evaluation, @summary-tables, @formatting +# ============================================================================ # REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables-helpers") source(testthat::test_path("common-functions.R")) diff --git a/tests/testthat/test-tools-evaluation.R b/tests/testthat/test-tools-evaluation.R new file mode 100644 index 0000000..906c83d --- /dev/null +++ b/tests/testthat/test-tools-evaluation.R @@ -0,0 +1,76 @@ +# ============================================================================ # +# TEST FILE: Utility Functions Evaluation Tests +# ============================================================================ # +# +# PURPOSE: +# Tests for utility functions behavior (not input validation). +# Includes .is.wholenumber, transformation checks, stan extraction, etc. +# +# DEPENDENCIES: +# - No external packages required beyond testthat +# +# SKIP CONDITIONS: +# - None (fast, pure R tests) +# +# MODELS/FIXTURES: +# - None required +# +# TAGS: @evaluation, @fast +# ============================================================================ # + + +test_that(".is.wholenumber works correctly", { + + # Positive cases + + expect_true(BayesTools:::.is.wholenumber(0)) + expect_true(BayesTools:::.is.wholenumber(5)) + expect_true(BayesTools:::.is.wholenumber(-3)) + expect_true(BayesTools:::.is.wholenumber(1e10)) + + # Negative cases + expect_false(BayesTools:::.is.wholenumber(0.5)) + expect_false(BayesTools:::.is.wholenumber(1.1)) + expect_false(BayesTools:::.is.wholenumber(-3.5)) + + # NA handling + expect_true(is.na(BayesTools:::.is.wholenumber(NA))) + expect_equal(BayesTools:::.is.wholenumber(NA, na.rm = TRUE), logical(0)) + + # Vector input + expect_equal(BayesTools:::.is.wholenumber(c(1, 2, 3.5)), c(TRUE, TRUE, FALSE)) + expect_equal(BayesTools:::.is.wholenumber(c(1, NA, 3.5)), c(TRUE, NA, FALSE)) +}) + + +test_that("transformation input validation works", { + + # Valid transformation + expect_null(.check_transformation_input(transformation = list( + "fun" = function(x) exp(x), + "inv" = function(x) log(x), + "jac" = function(x) exp(x) + ), NULL, FALSE)) + + # Missing 'jac' component + expect_error(.check_transformation_input(transformation = list( + "fun" = function(x) exp(x), + "inv" = function(x) log(x), + "err" = function(x) exp(x) + ), NULL, FALSE), "The 'jac' objects are missing in the 'transformation' argument.") + + # Invalid format + expect_error(.check_transformation_input(transformation = 1, NULL, FALSE), + "Uknown format of the 'transformation' argument.") +}) + + +test_that("stan extraction requires rstan fit", { + expect_error(.extract_stan(NULL), "'fit' must be an rstan fit") +}) + + +test_that("depreciation warnings work", { + expect_warning(.depreciate.transform_orthonormal(TRUE, FALSE), + "'transform_orthonormal' argument will be depreciated in favor of 'transform_factors' argument.") +}) diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools-input.R similarity index 80% rename from tests/testthat/test-tools.R rename to tests/testthat/test-tools-input.R index df1e322..287fb61 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools-input.R @@ -1,9 +1,30 @@ -context("Tools") +# ============================================================================ # +# TEST FILE: Input Validation Tests for Tools +# ============================================================================ # +# +# PURPOSE: +# Tests for input validation functions (check_bool, check_char, check_real, +# check_int, check_list) in R/tools.R +# +# DEPENDENCIES: +# - No external packages required beyond testthat +# - Tests the check_* functions exported from BayesTools +# +# SKIP CONDITIONS: +# - None (fast, pure R tests) +# +# MODELS/FIXTURES: +# - None required +# +# TAGS: @input-validation, @fast +# ============================================================================ # + + +test_that("check_bool validates logical inputs", { + + + # Valid inputs - -test_that("Check booleans", { - - # these should be allowed expect_null(check_bool(NULL, "", allow_NULL = TRUE)) expect_null(check_bool(TRUE, "")) expect_null(check_bool(FALSE, "")) @@ -11,40 +32,47 @@ test_that("Check booleans", { expect_null(check_bool(c(FALSE, FALSE), "", check_length = 2)) expect_null(check_bool(NA, "")) - # these should fail + # Invalid type: matrix expect_error( check_bool(as.matrix(as.logical(rbinom(5, 1, .5))), "test object"), "The 'test object' argument must be a logical vector." ) + # Invalid type: string expect_error( check_bool("string", "test object"), "The 'test object' argument must be a logical vector." ) + # Invalid type: numeric expect_error( check_bool(1, "test object"), "The 'test object' argument must be a logical vector." ) + # Invalid type: list expect_error( check_bool(list(TRUE), "test object"), "The 'test object' argument must be a logical vector." ) + # Invalid length expect_error( check_bool(TRUE, "test object", check_length = 2), "The 'test object' argument must have length '2'." ) + # NULL not allowed expect_error( check_bool(NULL, "test object"), "The 'test object' argument cannot be NULL." ) + # NA not allowed expect_error( check_bool(NA, "test object", allow_NA = FALSE), "The 'test object' argument cannot contain NA/NaN values." ) }) -test_that("Check strings", { - # these should be allowed +test_that("check_char validates character inputs", { + + # Valid inputs expect_null(check_char(NULL, "", allow_NULL = TRUE)) expect_null(check_char("string", "")) expect_null(check_char(c("string", "string1"), "", check_length = 0)) @@ -52,44 +80,52 @@ test_that("Check strings", { expect_null(check_char(c("string", "string1"), "", check_length = 0, allow_values = c("string", "string1"))) expect_null(check_char(c(NA, ""), "", check_length = 2)) - # these should fail + # Invalid type: matrix expect_error( check_char(as.matrix(as.logical(as.character(5, 1, .5))), "test object"), "The 'test object' argument must be a character vector." ) + # Invalid type: logical expect_error( check_char(TRUE, "test object"), "The 'test object' argument must be a character vector." ) + # Invalid type: numeric expect_error( check_char(1, "test object"), "The 'test object' argument must be a character vector." ) + # Invalid type: list expect_error( check_char(list("string"), "test object"), "The 'test object' argument must be a character vector." ) + # Invalid length expect_error( check_char("string", "test object", check_length = 2), "The 'test object' argument must have length '2'." ) + # Invalid allowed values expect_error( check_char(c("string", "string1"), "test object", check_length = 0, allow_values = c("string")), "The 'string1' values are not recognized by the 'test object' argument." ) + # NULL not allowed expect_error( check_char(NULL, "test object"), "The 'test object' argument cannot be NULL." ) + # NA not allowed expect_error( check_char(c("a", NA), "test object", allow_NA = FALSE, check_length = FALSE), "The 'test object' argument cannot contain NA/NaN values." ) }) -test_that("Check reals", { - # these should be allowed +test_that("check_real validates numeric inputs", { + + # Valid inputs expect_null(check_real(NULL, "", allow_NULL = TRUE)) expect_null(check_real(pi, "")) expect_null(check_real(c(pi, 2), "", check_length = 0)) @@ -99,56 +135,67 @@ test_that("Check reals", { expect_null(check_real(c(0, 1), "", lower = 0, upper = 1, check_length = 2)) expect_null(check_real(c(NA, NaN), "", check_length = 2)) - # these should fail + # Invalid type: matrix expect_error( check_real(as.matrix(stats::rnorm(4, 1, .5)), "test object", check_length = FALSE), "The 'test object' argument must be a numeric vector." ) + # Invalid type: logical expect_error( check_real(TRUE, "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid type: string expect_error( check_real("string", "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid type: list expect_error( check_real(list(3.2), "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid length expect_error( check_real(1, "test object", check_length = 2), "The 'test object' argument must have length '2'." ) + # Upper bound violation expect_error( check_real(stats::rgamma(1, 1, 1), "test object", upper = 0), "The 'test object' must be equal or lower than 0." ) + # Lower bound violation expect_error( check_real(stats::rbeta(1, 1, 1), "test object", lower = 1), "The 'test object' must be equal or higher than 1." ) + # Boundary not allowed (lower) expect_error( check_real(0, "test object", lower = 0, upper = 1, allow_bound = FALSE), "The 'test object' must be higher than 0." ) + # Boundary not allowed (upper) expect_error( check_real(1, "test object", lower = 0, upper = 1, allow_bound = FALSE), "The 'test object' must be lower than 1." ) + # NULL not allowed expect_error( check_real(NULL, "test object"), "The 'test object' argument cannot be NULL." ) + # NA not allowed expect_error( check_real(NaN, "test object", allow_NA = FALSE), "The 'test object' argument cannot contain NA/NaN values." ) }) -test_that("Check integers", { - # these should be allowed +test_that("check_int validates integer inputs", { + + # Valid inputs expect_null(check_int(NULL, "", allow_NULL = TRUE)) expect_null(check_int(0, "")) expect_null(check_int(c(-1, 2), "", check_length = 0)) @@ -158,56 +205,70 @@ test_that("Check integers", { expect_null(check_int(c(-3, -1), "", lower = -3, upper = -1, check_length = 2)) expect_null(check_int(c(NA, NaN), "", check_length = 2)) - # these should fail + # Invalid type: matrix expect_error( check_int(as.matrix(stats::rpois(4, 1)), "test object", check_length = FALSE), "The 'test object' argument must be a numeric vector." ) + # Invalid type: logical expect_error( check_int(TRUE, "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid type: string expect_error( check_int("string", "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid type: list expect_error( check_int(list(3.2), "test object"), "The 'test object' argument must be a numeric vector." ) + # Invalid length expect_error( check_int(1, "test object", check_length = 2), "The 'test object' argument must have length '2'." ) + # Upper bound violation expect_error( check_int(1, "test object", upper = 0), "The 'test object' must be equal or lower than 0." ) + # Lower bound violation expect_error( check_int(0, "test object", lower = 1), "The 'test object' must be equal or higher than 1." ) + # Boundary not allowed (lower) expect_error( check_int(0, "test object", lower = 0, upper = 1, allow_bound = FALSE), "The 'test object' must be higher than 0." ) + # Boundary not allowed (upper) expect_error( check_int(1, "test object", lower = 0, upper = 1, allow_bound = FALSE), "The 'test object' must be lower than 1." ) + # NULL not allowed expect_error( check_int(NULL, "test object"), "The 'test object' argument cannot be NULL." ) + # NA not allowed expect_error( check_int(c(1, NA), "test object", allow_NA = FALSE, check_length = FALSE), "The 'test object' argument cannot contain NA/NaN values." ) + # Non-integer values rejected + expect_error(check_int(1.5, "test"), "must be an integer") + expect_error(check_int(c(1, 2.5, 3), "test", check_length = 3), "must be an integer") }) -test_that("Check lists", { - # these should be allowed +test_that("check_list validates list inputs", { + + # Valid inputs expect_null(check_list(NULL, "", allow_NULL = TRUE)) expect_null(check_list(list(), "", allow_NULL = TRUE)) expect_null(check_list(list("a" = c("a", "b"), "b" = 1), "")) @@ -217,115 +278,61 @@ test_that("Check lists", { expect_null(check_list(list("a" = c("a", "b"), "b" = 1), "", check_length = 2)) expect_null(check_list(list("a" = c("a", "b"), "b" = 1, "c" = c("a", "b")), "", check_names = c("a", "b"), all_objects = TRUE, allow_other = TRUE)) - # these should fail + # Invalid type: string expect_error( check_list("string", "test object"), "The 'test object' argument must be a list." ) + # Invalid type: numeric expect_error( check_list(1, "test object"), "The 'test object' argument must be a list." ) + # Invalid type: logical expect_error( check_list(TRUE, "test object"), "The 'test object' argument must be a list." ) + # Empty list with length requirement expect_error( check_list(list(), "test object", check_length = 2), "The 'test object' argument cannot be NULL." ) + # Unrecognized names expect_error( check_list(list("c" = c("a", "b")), "test object", check_names = c("a", "b")), "The 'c' objects are not recognized by the 'test object' argument." ) + # Missing required names expect_error( check_list(list("a" = c("a", "b")), "test object", check_names = c("a", "b"), all_objects = TRUE), "The 'b' objects are missing in the 'test object' argument." ) + # NULL not allowed expect_error( check_list(NULL, "test object"), "The 'test object' argument cannot be NULL." ) }) -test_that("Other tools",{ - - expect_warning(.depreciate.transform_orthonormal(TRUE, FALSE), - "'transform_orthonormal' argument will be depreciated in favor of 'transform_factors' argument.") - - - expect_error(.extract_stan(NULL), "'fit' must be an rstan fit") - - - expect_null(.check_transformation_input(transformation = list( - "fun" = function(x) exp(x), - "inv" = function(x) log(x), - "jac" = function(x) exp(x) - ), NULL, FALSE)) - - expect_error(.check_transformation_input(transformation = list( - "fun" = function(x) exp(x), - "inv" = function(x) log(x), - "err" = function(x) exp(x) - ), NULL, FALSE), "The 'jac' objects are missing in the 'transformation' argument.") - - expect_error(.check_transformation_input(transformation = 1, NULL, FALSE), "Uknown format of the 'transformation' argument.") - -}) - - -test_that(".is.wholenumber works correctly", { - - expect_true(BayesTools:::.is.wholenumber(0)) - expect_true(BayesTools:::.is.wholenumber(5)) - expect_true(BayesTools:::.is.wholenumber(-3)) - expect_true(BayesTools:::.is.wholenumber(1e10)) - - expect_false(BayesTools:::.is.wholenumber(0.5)) - expect_false(BayesTools:::.is.wholenumber(1.1)) - expect_false(BayesTools:::.is.wholenumber(-3.5)) - - # NA handling - expect_true(is.na(BayesTools:::.is.wholenumber(NA))) - # When na.rm = TRUE and input is just NA, result is logical(0) - expect_equal(BayesTools:::.is.wholenumber(NA, na.rm = TRUE), logical(0)) - - # Vector input - expect_equal(BayesTools:::.is.wholenumber(c(1, 2, 3.5)), c(TRUE, TRUE, FALSE)) - - # Vector input with NA - expect_equal(BayesTools:::.is.wholenumber(c(1, NA, 3.5)), c(TRUE, NA, FALSE)) - -}) - - -test_that("check_int rejects non-integer values", { - - # Non-integer values should fail - expect_error(check_int(1.5, "test"), "must be an integer") - expect_error(check_int(c(1, 2.5, 3), "test", check_length = 3), "must be an integer") - -}) - test_that("check functions handle empty vectors correctly", { - # Empty vectors should be treated like NULL + # Empty vectors treated like NULL expect_error(check_bool(logical(0), "test")) expect_error(check_char(character(0), "test")) expect_error(check_real(numeric(0), "test")) expect_error(check_int(integer(0), "test")) - # But should succeed with allow_NULL + # Empty vectors allowed with allow_NULL expect_null(check_bool(logical(0), "test", allow_NULL = TRUE)) expect_null(check_char(character(0), "test", allow_NULL = TRUE)) expect_null(check_real(numeric(0), "test", allow_NULL = TRUE)) expect_null(check_int(integer(0), "test", allow_NULL = TRUE)) - }) -test_that("check functions custom error prefix works", { +test_that("check functions support custom error prefix", { expect_error( check_bool("string", "test", call = "[custom] "), @@ -347,5 +354,4 @@ test_that("check functions custom error prefix works", { check_list("a", "test", call = "[custom] "), "\\[custom\\] The 'test' argument must be a list" ) - }) From fc5bda8461f7656425d5555da2516cde9feb461b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 18 Dec 2025 20:55:53 +0100 Subject: [PATCH 15/38] further refactoring --- .../marginal_estimates_BF01.txt | 2 - .../marginal_estimates_basic.txt | 2 - .../marginal_estimates_logBF.txt | 2 - .../runjags_estimates_conditional.txt | 4 - .../runjags_estimates_factor.txt | 3 - .../runjags_estimates_factor_transform.txt | 4 - .../runjags_estimates_remove_inclusion.txt | 3 - .../runjags_estimates_spike_slab.txt | 4 - .../runjags_estimates_weightfunction.txt | 3 - .../JAGS_add_priors_factor.txt | 0 .../JAGS_add_priors_peese_mixture.txt | 0 .../JAGS_add_priors_pet_mixture.txt | 0 .../JAGS_add_priors_point.txt | 0 .../JAGS_add_priors_simple.txt | 0 .../JAGS_add_priors_truncated.txt | 0 .../JAGS_add_priors_weightfunction.txt | 0 .../JAGS_to_monitor_factor.txt | 0 .../JAGS_to_monitor_point.txt | 0 .../JAGS_to_monitor_simple.txt | 0 .../runjags_estimates_param_m.txt | 0 .../runjags_estimates_simple.txt | 0 .../advanced_custom_probs.txt | 6 - .../fit_spike_factors_alt_model_summary.txt | 6 - ...it_spike_factors_alt_runjags_estimates.txt | 5 - .../fit_spike_factors_null_model_summary.txt | 6 - ...t_spike_factors_null_runjags_estimates.txt | 3 - .../runjags_formula_inference.txt | 2 - .../as_mixed_posteriors_info.txt | 4 - .../inclusion_BF_edge_cases.txt | 4 - .../mix_posteriors_conditional_info.txt | 3 - .../mix_posteriors_factor_info.txt | 3 - .../mix_posteriors_weightfunction_info.txt | 4 - .../weightfunctions_mapping_info.txt | 7 +- .../ensemble_inference_conditional.txt | 0 .../ensemble_inference_int_spec.txt | 0 .../mix_posteriors_simple_info.txt | 0 .../models_inference_output.txt | 0 .../ensemble_diagnostics_basic.txt | 3 - .../ensemble_diagnostics_no_spike.txt | 3 - .../ensemble_diagnostics_short_name.txt | 3 - .../ensemble_estimates_basic.txt | 4 - .../ensemble_estimates_custom_probs.txt | 4 - .../ensemble_estimates_transform_factors.txt | 4 - .../ensemble_inference_BF01.txt | 3 - .../ensemble_inference_basic.txt | 3 - .../ensemble_inference_both.txt | 3 - .../ensemble_inference_logBF.txt | 3 - .../ensemble_summary_basic.txt | 3 - .../ensemble_summary_bf_options.txt | 3 - .../ensemble_summary_no_spike.txt | 3 - .../ensemble_summary_short_name.txt | 3 - .../model_summary_basic.txt | 6 - .../model_summary_no_spike.txt | 6 - .../model_summary_short_name.txt | 6 - .../update_table_BF01.txt | 3 - .../update_table_footnotes.txt | 4 - .../update_table_logBF.txt | 3 - .../update_table_new_title.txt | 4 - .../update_table_warnings.txt | 4 - .../ensemble_diagnostics_basic.txt | 0 .../ensemble_diagnostics_no_spike.txt | 0 .../ensemble_diagnostics_short_name.txt | 0 .../ensemble_estimates_basic.txt | 0 .../ensemble_estimates_custom_probs.txt | 0 ...nsemble_estimates_formula_prefix_false.txt | 0 ...ensemble_estimates_formula_prefix_true.txt | 0 .../ensemble_estimates_transform_factors.txt | 0 .../ensemble_inference_BF01.txt | 0 .../ensemble_inference_basic.txt | 0 .../ensemble_inference_both.txt | 0 .../ensemble_inference_logBF.txt | 0 .../ensemble_summary_basic.txt | 0 .../ensemble_summary_bf_options.txt | 0 .../ensemble_summary_no_spike.txt | 0 .../ensemble_summary_params_list.txt | 0 .../ensemble_summary_short_name.txt | 0 .../marginal_estimates_BF01.txt | 0 .../marginal_estimates_basic.txt | 0 .../marginal_estimates_logBF.txt | 0 .../model_summary_basic.txt | 0 .../model_summary_no_spike.txt | 0 .../model_summary_short_name.txt | 0 .../update_table_BF01.txt | 0 .../update_table_footnotes.txt | 0 .../update_table_logBF.txt | 0 .../update_table_new_title.txt | 0 .../update_table_warnings.txt | 0 .../geom-prior-list-add.svg | 0 .../lines-prior-list-add.svg | 0 .../lines-prior-list-xlim.svg | 0 .../plot-factor-transformation.svg | 0 .../plot-factor-with-spike-trans-settings.svg | 0 .../plot-factor-with-spike-trans.svg | 0 .../plot-factor-with-spike.svg | 0 .../plot-models-basic.svg | 0 .../plot-models-ggplot.svg | 0 .../plot-models-order-decreasing-estimate.svg | 0 .../plot-models-order-decreasing-prob.svg | 0 .../plot-models-order-increasing-bf.svg | 0 .../plot-models-order-trans-ggplot.svg | 0 .../plot-models-order-trans-prior-ggplot.svg | 0 .../plot-models-order-trans-prior.svg | 0 .../plot-models-order-trans.svg | 0 .../plot-models-orthonormal-2.svg | 0 .../plot-models-orthonormal-3.svg | 0 .../plot-models-orthonormal.svg | 0 .../plot-posterior-ggplot.svg | 0 .../plot-posterior-omega.svg | 0 .../plot-posterior-simple.svg | 0 .../plot-posterior-with-prior.svg | 0 .../plot-posterior-xlim.svg | 0 .../plot-prior-list-dual-axis-ggplot.svg | 0 .../plot-prior-list-dual-axis.svg | 0 .../plot-prior-list-gamma.svg | 0 .../plot-prior-list-meandif-base.svg | 0 .../plot-prior-list-meandif-ggplot.svg | 0 .../plot-prior-list-multi.svg | 0 .../plot-prior-list-orthonormal-base.svg | 0 .../plot-prior-list-orthonormal-ggplot.svg | 0 ...-prior-list-orthonormal-spike-and-slab.svg | 0 .../plot-prior-list-orthonormal-spike.svg | 0 .../plot-prior-list-orthonormal2-ggplot.svg | 0 .../plot-prior-list-single-normal.svg | 0 .../plot-prior-list-weightfunction-ggplot.svg | 0 .../plot-prior-list-weightfunction.svg | 0 tests/testthat/test-JAGS-fit-edge-cases.R | 690 ++---------------- tests/testthat/test-JAGS-fit.R | 573 +++++++++++++++ .../test-model-averaging-edge-cases.R | 407 ++--------- .../test-model-averaging-plots-edge-cases.R | 561 +------------- tests/testthat/test-model-averaging-plots.R | 538 ++++++++++++++ tests/testthat/test-model-averaging.R | 307 +++++++- ...les-edge-cases.R => test-summary-tables.R} | 33 +- 132 files changed, 1606 insertions(+), 1664 deletions(-) delete mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt delete mode 100644 tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_factor.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_peese_mixture.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_pet_mixture.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_point.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_simple.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_truncated.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_add_priors_weightfunction.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_to_monitor_factor.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_to_monitor_point.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/JAGS_to_monitor_simple.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/runjags_estimates_param_m.txt (100%) rename tests/results/{JAGS-fit-edge-cases => JAGS-fit}/runjags_estimates_simple.txt (100%) delete mode 100644 tests/results/JAGS-summary-tables/advanced_custom_probs.txt delete mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt delete mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt delete mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt delete mode 100644 tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt delete mode 100644 tests/results/JAGS-summary-tables/runjags_formula_inference.txt delete mode 100644 tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt delete mode 100644 tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt delete mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt delete mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt delete mode 100644 tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt rename tests/results/{model-averaging-edge-cases => model-averaging}/ensemble_inference_conditional.txt (100%) rename tests/results/{model-averaging-edge-cases => model-averaging}/ensemble_inference_int_spec.txt (100%) rename tests/results/{model-averaging-edge-cases => model-averaging}/mix_posteriors_simple_info.txt (100%) rename tests/results/{model-averaging-edge-cases => model-averaging}/models_inference_output.txt (100%) delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_both.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt delete mode 100644 tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt delete mode 100644 tests/results/summary-tables-edge-cases/model_summary_basic.txt delete mode 100644 tests/results/summary-tables-edge-cases/model_summary_no_spike.txt delete mode 100644 tests/results/summary-tables-edge-cases/model_summary_short_name.txt delete mode 100644 tests/results/summary-tables-edge-cases/update_table_BF01.txt delete mode 100644 tests/results/summary-tables-edge-cases/update_table_footnotes.txt delete mode 100644 tests/results/summary-tables-edge-cases/update_table_logBF.txt delete mode 100644 tests/results/summary-tables-edge-cases/update_table_new_title.txt delete mode 100644 tests/results/summary-tables-edge-cases/update_table_warnings.txt rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_diagnostics_basic.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_diagnostics_no_spike.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_diagnostics_short_name.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_estimates_basic.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_estimates_custom_probs.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/ensemble_estimates_formula_prefix_false.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/ensemble_estimates_formula_prefix_true.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_estimates_transform_factors.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_inference_BF01.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_inference_basic.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_inference_both.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_inference_logBF.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_summary_basic.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_summary_bf_options.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_summary_no_spike.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/ensemble_summary_params_list.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/ensemble_summary_short_name.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/marginal_estimates_BF01.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/marginal_estimates_basic.txt (100%) rename tests/results/{summary-tables-edge-cases => summary-tables}/marginal_estimates_logBF.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/model_summary_basic.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/model_summary_no_spike.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/model_summary_short_name.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/update_table_BF01.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/update_table_footnotes.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/update_table_logBF.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/update_table_new_title.txt (100%) rename tests/results/{JAGS-fit-edge-cases => summary-tables}/update_table_warnings.txt (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/geom-prior-list-add.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/lines-prior-list-add.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/lines-prior-list-xlim.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-factor-transformation.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-factor-with-spike-trans-settings.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-factor-with-spike-trans.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-factor-with-spike.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-basic.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-decreasing-estimate.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-decreasing-prob.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-increasing-bf.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-trans-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-trans-prior-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-trans-prior.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-order-trans.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-orthonormal-2.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-orthonormal-3.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-models-orthonormal.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-posterior-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-posterior-omega.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-posterior-simple.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-posterior-with-prior.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-posterior-xlim.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-dual-axis-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-dual-axis.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-gamma.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-meandif-base.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-meandif-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-multi.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-orthonormal-base.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-orthonormal-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-orthonormal-spike-and-slab.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-orthonormal-spike.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-orthonormal2-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-single-normal.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-weightfunction-ggplot.svg (100%) rename tests/testthat/_snaps/{model-averaging-plots-edge-cases => model-averaging-plots}/plot-prior-list-weightfunction.svg (100%) create mode 100644 tests/testthat/test-JAGS-fit.R create mode 100644 tests/testthat/test-model-averaging-plots.R rename tests/testthat/{test-summary-tables-edge-cases.R => test-summary-tables.R} (95%) diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt deleted file mode 100644 index aec9b32..0000000 --- a/tests/results/JAGS-fit-edge-cases/marginal_estimates_BF01.txt +++ /dev/null @@ -1,2 +0,0 @@ - Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 0.400 diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt deleted file mode 100644 index 340696f..0000000 --- a/tests/results/JAGS-fit-edge-cases/marginal_estimates_basic.txt +++ /dev/null @@ -1,2 +0,0 @@ - Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 2.500 diff --git a/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt b/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt deleted file mode 100644 index 64ea4ce..0000000 --- a/tests/results/JAGS-fit-edge-cases/marginal_estimates_logBF.txt +++ /dev/null @@ -1,2 +0,0 @@ - Mean Median 0.025 0.95 Inclusion BF -mu[] -0.936 -0.936 -0.936 -0.936 0.916 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt deleted file mode 100644 index e4f1345..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_conditional.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean SD lCI Median uCI -beta (inclusion) 0.527 NA NA NA NA -beta[1] 0.064 1.028 -2.061 0.077 1.948 -beta[2] 0.010 0.994 -1.967 0.012 1.998 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt deleted file mode 100644 index 52e0bfe..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor.txt +++ /dev/null @@ -1,3 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[1] 0.017 0.977 -1.862 0.031 1.936 0.03092 0.032 1000 1.000 -p1[2] 0.050 1.002 -1.998 0.074 1.966 0.03171 0.032 1000 1.001 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt deleted file mode 100644 index cff708f..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_factor_transform.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 0.02589 0.032 1000 1.001 -p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 0.02517 0.032 1000 0.999 -p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 0.02565 0.032 1000 1.002 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt deleted file mode 100644 index a3f7134..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_remove_inclusion.txt +++ /dev/null @@ -1,3 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 -beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt deleted file mode 100644 index c8bb523..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_spike_slab.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -beta (inclusion) 0.527 NA NA NA NA NA NA NA NA -beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 -beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt b/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt deleted file mode 100644 index dcfb027..0000000 --- a/tests/results/JAGS-fit-edge-cases/runjags_estimates_weightfunction.txt +++ /dev/null @@ -1,3 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.510 0.283 0.037 0.525 0.968 0.00894 0.032 1000 0.999 diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt b/tests/results/JAGS-fit/JAGS_add_priors_factor.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_factor.txt rename to tests/results/JAGS-fit/JAGS_add_priors_factor.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt b/tests/results/JAGS-fit/JAGS_add_priors_peese_mixture.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_peese_mixture.txt rename to tests/results/JAGS-fit/JAGS_add_priors_peese_mixture.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt b/tests/results/JAGS-fit/JAGS_add_priors_pet_mixture.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_pet_mixture.txt rename to tests/results/JAGS-fit/JAGS_add_priors_pet_mixture.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt b/tests/results/JAGS-fit/JAGS_add_priors_point.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_point.txt rename to tests/results/JAGS-fit/JAGS_add_priors_point.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt b/tests/results/JAGS-fit/JAGS_add_priors_simple.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_simple.txt rename to tests/results/JAGS-fit/JAGS_add_priors_simple.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt b/tests/results/JAGS-fit/JAGS_add_priors_truncated.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_truncated.txt rename to tests/results/JAGS-fit/JAGS_add_priors_truncated.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt b/tests/results/JAGS-fit/JAGS_add_priors_weightfunction.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_add_priors_weightfunction.txt rename to tests/results/JAGS-fit/JAGS_add_priors_weightfunction.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt b/tests/results/JAGS-fit/JAGS_to_monitor_factor.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_factor.txt rename to tests/results/JAGS-fit/JAGS_to_monitor_factor.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt b/tests/results/JAGS-fit/JAGS_to_monitor_point.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_point.txt rename to tests/results/JAGS-fit/JAGS_to_monitor_point.txt diff --git a/tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt b/tests/results/JAGS-fit/JAGS_to_monitor_simple.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/JAGS_to_monitor_simple.txt rename to tests/results/JAGS-fit/JAGS_to_monitor_simple.txt diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt b/tests/results/JAGS-fit/runjags_estimates_param_m.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/runjags_estimates_param_m.txt rename to tests/results/JAGS-fit/runjags_estimates_param_m.txt diff --git a/tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt b/tests/results/JAGS-fit/runjags_estimates_simple.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/runjags_estimates_simple.txt rename to tests/results/JAGS-fit/runjags_estimates_simple.txt diff --git a/tests/results/JAGS-summary-tables/advanced_custom_probs.txt b/tests/results/JAGS-summary-tables/advanced_custom_probs.txt deleted file mode 100644 index 3d5f3d2..0000000 --- a/tests/results/JAGS-summary-tables/advanced_custom_probs.txt +++ /dev/null @@ -1,6 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 -(mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 -(mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 -(mu) x_cont1:x_cont2 -0.391 0.149 -0.685 -0.390 -0.104 0.00495 0.033 914 1.003 -sigma 1.040 0.077 0.905 1.033 1.203 0.00364 0.047 451 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt deleted file mode 100644 index d3f942a..0000000 --- a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_model_summary.txt +++ /dev/null @@ -1,6 +0,0 @@ - - Model 1 Parameter prior distributions - Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) - log(marglik) -138.42 (mu) x_fac3md ~ mean difference contrast: mNormal(0, 0.25) - Post. prob. 1.000 sigma ~ Lognormal(0, 1) - Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt deleted file mode 100644 index ccd089b..0000000 --- a/tests/results/JAGS-summary-tables/fit_spike_factors_alt_runjags_estimates.txt +++ /dev/null @@ -1,5 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.102 0.092 -0.068 0.101 0.284 0.00314 0.034 912 1.000 -(mu) x_fac3md[1] -0.106 0.112 -0.331 -0.102 0.104 0.00356 0.032 1000 1.000 -(mu) x_fac3md[2] 0.029 0.112 -0.197 0.036 0.237 0.00356 0.032 1000 1.000 -sigma 0.915 0.069 0.797 0.909 1.066 0.00312 0.045 489 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt deleted file mode 100644 index 6d17f8d..0000000 --- a/tests/results/JAGS-summary-tables/fit_spike_factors_null_model_summary.txt +++ /dev/null @@ -1,6 +0,0 @@ - - Model 1 Parameter prior distributions - Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) - log(marglik) -137.33 sigma ~ Lognormal(0, 1) - Post. prob. 1.000 - Inclusion BF Inf diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt deleted file mode 100644 index 7718867..0000000 --- a/tests/results/JAGS-summary-tables/fit_spike_factors_null_runjags_estimates.txt +++ /dev/null @@ -1,3 +0,0 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.110 0.090 -0.068 0.111 0.288 0.00286 0.032 1000 1.002 -sigma 0.905 0.069 0.785 0.899 1.049 0.00291 0.042 560 0.999 diff --git a/tests/results/JAGS-summary-tables/runjags_formula_inference.txt b/tests/results/JAGS-summary-tables/runjags_formula_inference.txt deleted file mode 100644 index 4601b45..0000000 --- a/tests/results/JAGS-summary-tables/runjags_formula_inference.txt +++ /dev/null @@ -1,2 +0,0 @@ -[1] Prior prob. Post. prob. Inclusion BF -<0 rows> (or 0-length row.names) diff --git a/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt b/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt deleted file mode 100644 index 67b8a14..0000000 --- a/tests/results/model-averaging-edge-cases/as_mixed_posteriors_info.txt +++ /dev/null @@ -1,4 +0,0 @@ -Class: list, as_mixed_posteriors, mixed_posteriors -Parameters: m, s -Has prior_list for m: TRUE -Has prior_list for s: TRUE diff --git a/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt b/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt deleted file mode 100644 index a990970..0000000 --- a/tests/results/model-averaging-edge-cases/inclusion_BF_edge_cases.txt +++ /dev/null @@ -1,4 +0,0 @@ -All null models BF: 0 -All alternative models BF: Inf -Single alternative model BF: Inf -Equal margliks BF: 1 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt deleted file mode 100644 index c74ff0b..0000000 --- a/tests/results/model-averaging-edge-cases/mix_posteriors_conditional_info.txt +++ /dev/null @@ -1,3 +0,0 @@ -Class: list, mixed_posteriors -Parameters: m -Sample size m: 1000 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt deleted file mode 100644 index 5f1edf7..0000000 --- a/tests/results/model-averaging-edge-cases/mix_posteriors_factor_info.txt +++ /dev/null @@ -1,3 +0,0 @@ -Class: list, mixed_posteriors -Parameter: mu_x_fac3o -Sample size: 2000 diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt b/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt deleted file mode 100644 index e74301f..0000000 --- a/tests/results/model-averaging-edge-cases/mix_posteriors_weightfunction_info.txt +++ /dev/null @@ -1,4 +0,0 @@ -Class: list, mixed_posteriors -Parameters: m, omega -Sample size m: 1000 -Sample size omega: 3000 diff --git a/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt b/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt index 6ce45a5..423b2e8 100644 --- a/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt +++ b/tests/results/model-averaging-edge-cases/weightfunctions_mapping_info.txt @@ -1,4 +1,3 @@ -One-sided mapping length: 1 -Two-sided mapping length: 1 -Two-sided with one_sided=TRUE length: 1 -Cuts: 0, 0.05, 1 +Mixed mapping length: 2 +Inx 1: 2,2,1,1,1 +Inx 2: 3,2,1,2,3 diff --git a/tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt b/tests/results/model-averaging/ensemble_inference_conditional.txt similarity index 100% rename from tests/results/model-averaging-edge-cases/ensemble_inference_conditional.txt rename to tests/results/model-averaging/ensemble_inference_conditional.txt diff --git a/tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt b/tests/results/model-averaging/ensemble_inference_int_spec.txt similarity index 100% rename from tests/results/model-averaging-edge-cases/ensemble_inference_int_spec.txt rename to tests/results/model-averaging/ensemble_inference_int_spec.txt diff --git a/tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt b/tests/results/model-averaging/mix_posteriors_simple_info.txt similarity index 100% rename from tests/results/model-averaging-edge-cases/mix_posteriors_simple_info.txt rename to tests/results/model-averaging/mix_posteriors_simple_info.txt diff --git a/tests/results/model-averaging-edge-cases/models_inference_output.txt b/tests/results/model-averaging/models_inference_output.txt similarity index 100% rename from tests/results/model-averaging-edge-cases/models_inference_output.txt rename to tests/results/model-averaging/models_inference_output.txt diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt deleted file mode 100644 index 9f9f098..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_basic.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) - 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 - 2 Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt deleted file mode 100644 index 4dff192..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_no_spike.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) - 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.00199 0.043 540 1.005 - 2 Spike(0) Normal(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt b/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt deleted file mode 100644 index a4332ca..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_diagnostics_short_name.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s max[error(MCMC)] max[error(MCMC)/SD] min(ESS) max(R-hat) - 1 N(0, 1) N(0, 1)[0, Inf] 0.00199 0.043 540 1.005 - 2 N(0, 1)[0, Inf] 0.00191 0.044 509 1.002 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt deleted file mode 100644 index 8410bd5..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_estimates_basic.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean Median 0.025 0.95 -m 0.173 0.179 -0.221 0.494 -omega[0,0.05] 1.000 1.000 1.000 1.000 -omega[0.05,1] 0.692 0.834 0.031 1.000 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt deleted file mode 100644 index 43c9431..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_estimates_custom_probs.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean Median 0.1 0.5 0.9 -m 0.173 0.179 -0.107 0.179 0.427 -omega[0,0.05] 1.000 1.000 1.000 1.000 1.000 -omega[0.05,1] 0.692 0.834 0.137 0.834 1.000 diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt b/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt deleted file mode 100644 index 0fd1795..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_estimates_transform_factors.txt +++ /dev/null @@ -1,4 +0,0 @@ - Mean Median 0.025 0.95 -(mu) x_fac3o [dif: A] 0.023 0.020 -0.185 0.188 -(mu) x_fac3o [dif: B] -0.306 -0.322 -0.520 0.000 -(mu) x_fac3o [dif: C] 0.282 0.289 0.000 0.476 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt deleted file mode 100644 index 2e884ef..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_inference_BF01.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. Exclusion BF -m 2/2 1.000 1.000 0.000 -omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt deleted file mode 100644 index 218ac8c..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_inference_basic.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. Inclusion BF -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt deleted file mode 100644 index f02847b..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_inference_both.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. log(Exclusion BF) -m 2/2 1.000 1.000 -Inf -omega 1/2 0.500 0.638 -0.565 diff --git a/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt b/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt deleted file mode 100644 index f4dd627..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_inference_logBF.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. log(Inclusion BF) -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt deleted file mode 100644 index b5b3576..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_summary_basic.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF - 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 - 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt deleted file mode 100644 index 0dd2bec..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_summary_bf_options.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s Prior prob. log(marglik) Post. prob. log(Exclusion BF) - 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 2.461 - 2 Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 -2.461 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt deleted file mode 100644 index c5be715..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_summary_no_spike.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF - 1 Normal(0, 1) Normal(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 - 2 Spike(0) Normal(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt b/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt deleted file mode 100644 index 9043a08..0000000 --- a/tests/results/summary-tables-edge-cases/ensemble_summary_short_name.txt +++ /dev/null @@ -1,3 +0,0 @@ - Model Prior m Prior s Prior prob. log(marglik) Post. prob. Inclusion BF - 1 N(0, 1) N(0, 1)[0, Inf] 0.500 -31.95 0.079 0.085 - 2 N(0, 1)[0, Inf] 0.500 -29.49 0.921 11.717 diff --git a/tests/results/summary-tables-edge-cases/model_summary_basic.txt b/tests/results/summary-tables-edge-cases/model_summary_basic.txt deleted file mode 100644 index acc0bb8..0000000 --- a/tests/results/summary-tables-edge-cases/model_summary_basic.txt +++ /dev/null @@ -1,6 +0,0 @@ - - Model 1 Parameter prior distributions - Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] - log(marglik) -29.49 - Post. prob. 1.000 - Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt b/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt deleted file mode 100644 index acc0bb8..0000000 --- a/tests/results/summary-tables-edge-cases/model_summary_no_spike.txt +++ /dev/null @@ -1,6 +0,0 @@ - - Model 1 Parameter prior distributions - Prior prob. 1.000 s ~ Normal(0, 1)[0, Inf] - log(marglik) -29.49 - Post. prob. 1.000 - Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/model_summary_short_name.txt b/tests/results/summary-tables-edge-cases/model_summary_short_name.txt deleted file mode 100644 index ef7083e..0000000 --- a/tests/results/summary-tables-edge-cases/model_summary_short_name.txt +++ /dev/null @@ -1,6 +0,0 @@ - - Model 1 Parameter prior distributions - Prior prob. 1.000 s ~ N(0, 1)[0, Inf] - log(marglik) -29.49 - Post. prob. 1.000 - Inclusion BF Inf diff --git a/tests/results/summary-tables-edge-cases/update_table_BF01.txt b/tests/results/summary-tables-edge-cases/update_table_BF01.txt deleted file mode 100644 index 2e884ef..0000000 --- a/tests/results/summary-tables-edge-cases/update_table_BF01.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. Exclusion BF -m 2/2 1.000 1.000 0.000 -omega 1/2 0.500 0.638 0.568 diff --git a/tests/results/summary-tables-edge-cases/update_table_footnotes.txt b/tests/results/summary-tables-edge-cases/update_table_footnotes.txt deleted file mode 100644 index 54a6071..0000000 --- a/tests/results/summary-tables-edge-cases/update_table_footnotes.txt +++ /dev/null @@ -1,4 +0,0 @@ - Models Prior prob. Post. prob. Inclusion BF -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 1.759 -This is a footnote diff --git a/tests/results/summary-tables-edge-cases/update_table_logBF.txt b/tests/results/summary-tables-edge-cases/update_table_logBF.txt deleted file mode 100644 index f4dd627..0000000 --- a/tests/results/summary-tables-edge-cases/update_table_logBF.txt +++ /dev/null @@ -1,3 +0,0 @@ - Models Prior prob. Post. prob. log(Inclusion BF) -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 0.565 diff --git a/tests/results/summary-tables-edge-cases/update_table_new_title.txt b/tests/results/summary-tables-edge-cases/update_table_new_title.txt deleted file mode 100644 index 3103bf8..0000000 --- a/tests/results/summary-tables-edge-cases/update_table_new_title.txt +++ /dev/null @@ -1,4 +0,0 @@ -Updated Title - Models Prior prob. Post. prob. Inclusion BF -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 1.759 diff --git a/tests/results/summary-tables-edge-cases/update_table_warnings.txt b/tests/results/summary-tables-edge-cases/update_table_warnings.txt deleted file mode 100644 index 70b177c..0000000 --- a/tests/results/summary-tables-edge-cases/update_table_warnings.txt +++ /dev/null @@ -1,4 +0,0 @@ - Models Prior prob. Post. prob. Inclusion BF -m 2/2 1.000 1.000 Inf -omega 1/2 0.500 0.638 1.759 -This is a warning diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt b/tests/results/summary-tables/ensemble_diagnostics_basic.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_basic.txt rename to tests/results/summary-tables/ensemble_diagnostics_basic.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt b/tests/results/summary-tables/ensemble_diagnostics_no_spike.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_no_spike.txt rename to tests/results/summary-tables/ensemble_diagnostics_no_spike.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt b/tests/results/summary-tables/ensemble_diagnostics_short_name.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_diagnostics_short_name.txt rename to tests/results/summary-tables/ensemble_diagnostics_short_name.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt b/tests/results/summary-tables/ensemble_estimates_basic.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_estimates_basic.txt rename to tests/results/summary-tables/ensemble_estimates_basic.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt b/tests/results/summary-tables/ensemble_estimates_custom_probs.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_estimates_custom_probs.txt rename to tests/results/summary-tables/ensemble_estimates_custom_probs.txt diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt b/tests/results/summary-tables/ensemble_estimates_formula_prefix_false.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_false.txt rename to tests/results/summary-tables/ensemble_estimates_formula_prefix_false.txt diff --git a/tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt b/tests/results/summary-tables/ensemble_estimates_formula_prefix_true.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/ensemble_estimates_formula_prefix_true.txt rename to tests/results/summary-tables/ensemble_estimates_formula_prefix_true.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt b/tests/results/summary-tables/ensemble_estimates_transform_factors.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_estimates_transform_factors.txt rename to tests/results/summary-tables/ensemble_estimates_transform_factors.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt b/tests/results/summary-tables/ensemble_inference_BF01.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_inference_BF01.txt rename to tests/results/summary-tables/ensemble_inference_BF01.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt b/tests/results/summary-tables/ensemble_inference_basic.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_inference_basic.txt rename to tests/results/summary-tables/ensemble_inference_basic.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt b/tests/results/summary-tables/ensemble_inference_both.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_inference_both.txt rename to tests/results/summary-tables/ensemble_inference_both.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt b/tests/results/summary-tables/ensemble_inference_logBF.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_inference_logBF.txt rename to tests/results/summary-tables/ensemble_inference_logBF.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt b/tests/results/summary-tables/ensemble_summary_basic.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_summary_basic.txt rename to tests/results/summary-tables/ensemble_summary_basic.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt b/tests/results/summary-tables/ensemble_summary_bf_options.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_summary_bf_options.txt rename to tests/results/summary-tables/ensemble_summary_bf_options.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt b/tests/results/summary-tables/ensemble_summary_no_spike.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_summary_no_spike.txt rename to tests/results/summary-tables/ensemble_summary_no_spike.txt diff --git a/tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt b/tests/results/summary-tables/ensemble_summary_params_list.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/ensemble_summary_params_list.txt rename to tests/results/summary-tables/ensemble_summary_params_list.txt diff --git a/tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt b/tests/results/summary-tables/ensemble_summary_short_name.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/ensemble_summary_short_name.txt rename to tests/results/summary-tables/ensemble_summary_short_name.txt diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt b/tests/results/summary-tables/marginal_estimates_BF01.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/marginal_estimates_BF01.txt rename to tests/results/summary-tables/marginal_estimates_BF01.txt diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt b/tests/results/summary-tables/marginal_estimates_basic.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/marginal_estimates_basic.txt rename to tests/results/summary-tables/marginal_estimates_basic.txt diff --git a/tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt b/tests/results/summary-tables/marginal_estimates_logBF.txt similarity index 100% rename from tests/results/summary-tables-edge-cases/marginal_estimates_logBF.txt rename to tests/results/summary-tables/marginal_estimates_logBF.txt diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_basic.txt b/tests/results/summary-tables/model_summary_basic.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/model_summary_basic.txt rename to tests/results/summary-tables/model_summary_basic.txt diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt b/tests/results/summary-tables/model_summary_no_spike.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/model_summary_no_spike.txt rename to tests/results/summary-tables/model_summary_no_spike.txt diff --git a/tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt b/tests/results/summary-tables/model_summary_short_name.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/model_summary_short_name.txt rename to tests/results/summary-tables/model_summary_short_name.txt diff --git a/tests/results/JAGS-fit-edge-cases/update_table_BF01.txt b/tests/results/summary-tables/update_table_BF01.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/update_table_BF01.txt rename to tests/results/summary-tables/update_table_BF01.txt diff --git a/tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt b/tests/results/summary-tables/update_table_footnotes.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/update_table_footnotes.txt rename to tests/results/summary-tables/update_table_footnotes.txt diff --git a/tests/results/JAGS-fit-edge-cases/update_table_logBF.txt b/tests/results/summary-tables/update_table_logBF.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/update_table_logBF.txt rename to tests/results/summary-tables/update_table_logBF.txt diff --git a/tests/results/JAGS-fit-edge-cases/update_table_new_title.txt b/tests/results/summary-tables/update_table_new_title.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/update_table_new_title.txt rename to tests/results/summary-tables/update_table_new_title.txt diff --git a/tests/results/JAGS-fit-edge-cases/update_table_warnings.txt b/tests/results/summary-tables/update_table_warnings.txt similarity index 100% rename from tests/results/JAGS-fit-edge-cases/update_table_warnings.txt rename to tests/results/summary-tables/update_table_warnings.txt diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg b/tests/testthat/_snaps/model-averaging-plots/geom-prior-list-add.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/geom-prior-list-add.svg rename to tests/testthat/_snaps/model-averaging-plots/geom-prior-list-add.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg b/tests/testthat/_snaps/model-averaging-plots/lines-prior-list-add.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-add.svg rename to tests/testthat/_snaps/model-averaging-plots/lines-prior-list-add.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg b/tests/testthat/_snaps/model-averaging-plots/lines-prior-list-xlim.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/lines-prior-list-xlim.svg rename to tests/testthat/_snaps/model-averaging-plots/lines-prior-list-xlim.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg b/tests/testthat/_snaps/model-averaging-plots/plot-factor-transformation.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-transformation.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-factor-transformation.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg b/tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike-trans-settings.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans-settings.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike-trans-settings.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg b/tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike-trans.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike-trans.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike-trans.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg b/tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-factor-with-spike.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-factor-with-spike.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-basic.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-basic.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-basic.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-decreasing-estimate.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-estimate.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-decreasing-estimate.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-decreasing-prob.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-decreasing-prob.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-decreasing-prob.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-increasing-bf.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-increasing-bf.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-increasing-bf.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-prior-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-prior-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-prior.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans-prior.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans-prior.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-order-trans.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-order-trans.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal-2.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-2.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal-2.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal-3.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal-3.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal-3.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg b/tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-models-orthonormal.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-models-orthonormal.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-posterior-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-posterior-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg b/tests/testthat/_snaps/model-averaging-plots/plot-posterior-omega.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-omega.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-posterior-omega.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg b/tests/testthat/_snaps/model-averaging-plots/plot-posterior-simple.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-simple.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-posterior-simple.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg b/tests/testthat/_snaps/model-averaging-plots/plot-posterior-with-prior.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-with-prior.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-posterior-with-prior.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg b/tests/testthat/_snaps/model-averaging-plots/plot-posterior-xlim.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-posterior-xlim.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-posterior-xlim.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-dual-axis-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-dual-axis-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-dual-axis.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-dual-axis.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-dual-axis.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-gamma.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-gamma.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-gamma.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-meandif-base.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-base.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-meandif-base.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-meandif-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-meandif-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-meandif-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-multi.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-multi.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-multi.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-base.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-base.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-base.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-spike-and-slab.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike-and-slab.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-spike-and-slab.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-spike.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal-spike.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal-spike.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal2-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-orthonormal2-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-orthonormal2-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-single-normal.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-single-normal.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-single-normal.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-weightfunction-ggplot.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction-ggplot.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-weightfunction-ggplot.svg diff --git a/tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg b/tests/testthat/_snaps/model-averaging-plots/plot-prior-list-weightfunction.svg similarity index 100% rename from tests/testthat/_snaps/model-averaging-plots-edge-cases/plot-prior-list-weightfunction.svg rename to tests/testthat/_snaps/model-averaging-plots/plot-prior-list-weightfunction.svg diff --git a/tests/testthat/test-JAGS-fit-edge-cases.R b/tests/testthat/test-JAGS-fit-edge-cases.R index 55d5707..dc8c3a2 100644 --- a/tests/testthat/test-JAGS-fit-edge-cases.R +++ b/tests/testthat/test-JAGS-fit-edge-cases.R @@ -3,8 +3,8 @@ # ============================================================================ # # # PURPOSE: -# Edge case and comprehensive tests for JAGS fitting functions including -# JAGS_add_priors, JAGS_fit, and related utilities. +# Edge case tests for JAGS fitting functions including input validation, +# error handling, and boundary conditions. # # DEPENDENCIES: # - rjags: For JAGS model syntax generation and testing @@ -12,12 +12,11 @@ # # SKIP CONDITIONS: # - skip_if_not_installed("rjags"): For all tests -# - skip_if_no_fits(): For tests using pre-fitted models # # MODELS/FIXTURES: # - Some tests use pre-fitted models from test-00-model-fits.R # -# TAGS: @evaluation, @edge-cases, @JAGS +# TAGS: @edge-cases, @JAGS, @input-validation # ============================================================================ # # Reference directory for text output comparisons @@ -27,302 +26,44 @@ source(testthat::test_path("common-functions.R")) # ============================================================================ # -# SECTION 1: JAGS_add_priors tests +# SECTION 1: Input validation tests # ============================================================================ # -test_that("JAGS_add_priors handles various prior types", { - - skip_if_not_installed("rjags") - - # Test with simple priors - syntax_simple <- "model{}" - priors_simple <- list( - mu = prior("normal", list(0, 1)), - sigma = prior("gamma", list(2, 1)) - ) - - result_simple <- JAGS_add_priors(syntax_simple, priors_simple) - test_reference_text(result_simple, "JAGS_add_priors_simple.txt") - - # Test with truncated priors - priors_truncated <- list( - mu = prior("normal", list(0, 1), list(0, Inf)) - ) - - result_truncated <- JAGS_add_priors(syntax_simple, priors_truncated) - test_reference_text(result_truncated, "JAGS_add_priors_truncated.txt") - - # Test with point prior - priors_point <- list( - mu = prior("point", list(0)) - ) - - result_point <- JAGS_add_priors(syntax_simple, priors_point) - test_reference_text(result_point, "JAGS_add_priors_point.txt") - - # Test with factor priors - priors_factor <- list( - p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") - ) - attr(priors_factor[[1]], "levels") <- 3 - - result_factor <- JAGS_add_priors(syntax_simple, priors_factor) - test_reference_text(result_factor, "JAGS_add_priors_factor.txt") - - # Test with weightfunction priors - priors_wf <- list( - omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - ) - - result_wf <- JAGS_add_priors(syntax_simple, priors_wf) - test_reference_text(result_wf, "JAGS_add_priors_weightfunction.txt") - -}) - - -# ============================================================================ # -# SECTION 2: JAGS_get_inits tests -# ============================================================================ # -test_that("JAGS_get_inits handles various prior types", { - - skip_if_not_installed("rjags") - - # Test with simple priors - priors_simple <- list( - mu = prior("normal", list(0, 1)), - sigma = prior("gamma", list(2, 1)) - ) - - inits1 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) - expect_equal(length(inits1), 2) - expect_true("mu" %in% names(inits1[[1]])) - expect_true("sigma" %in% names(inits1[[1]])) - - # Same seed should give same results - inits2 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) - expect_equal(inits1, inits2) - - # Different seeds should give different results - inits3 <- JAGS_get_inits(priors_simple, chains = 2, seed = 123) - expect_false(isTRUE(all.equal(inits1, inits3))) - - # Test with truncated priors - priors_truncated <- list( - mu = prior("normal", list(0, 1), list(0, Inf)) - ) - - inits_truncated <- JAGS_get_inits(priors_truncated, chains = 2, seed = 1) - expect_true(all(sapply(inits_truncated, function(i) i$mu >= 0))) - - # Test with point prior - priors_point <- list( - mu = prior("point", list(5)) - ) - - inits_point <- JAGS_get_inits(priors_point, chains = 2, seed = 1) - # Point priors should not generate inits (they're fixed) - expect_true(!("mu" %in% names(inits_point[[1]])) || all(sapply(inits_point, function(i) i$mu == 5))) - - # Test with factor priors - priors_factor <- list( - p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") - ) - attr(priors_factor[[1]], "levels") <- 3 - - inits_factor <- JAGS_get_inits(priors_factor, chains = 2, seed = 1) - expect_true("p1" %in% names(inits_factor[[1]])) - -}) - - -# ============================================================================ # -# SECTION 3: JAGS_check_convergence tests -# ============================================================================ # -test_that("JAGS_check_convergence works with fitted models", { - - skip_if_not_installed("rjags") - skip_if_no_fits() - - fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - prior_list <- attr(fit_simple, "prior_list") - - # Test convergence check with prior_list - convergence <- JAGS_check_convergence(fit_simple, prior_list = prior_list) - expect_true(is.logical(convergence) || is.list(convergence)) - - # Test with NULL prior_list - convergence_null <- JAGS_check_convergence(fit_simple, prior_list = NULL) - expect_true(is.logical(convergence_null) || is.list(convergence_null)) - -}) - - -# ============================================================================ # -# SECTION 4: JAGS_to_monitor tests -# ============================================================================ # -test_that("JAGS_to_monitor generates correct monitor strings", { - - skip_if_not_installed("rjags") - - # Test with simple priors - priors_simple <- list( - mu = prior("normal", list(0, 1)), - sigma = prior("gamma", list(2, 1)) - ) - - monitor <- JAGS_to_monitor(priors_simple) - test_reference_text(paste(sort(monitor), collapse = ","), "JAGS_to_monitor_simple.txt") - - # Test with point prior - priors_with_point <- list( - mu = prior("normal", list(0, 1)), - fixed = prior("point", list(0)) - ) - - monitor_point <- JAGS_to_monitor(priors_with_point) - test_reference_text(paste(sort(monitor), collapse = ", "), "JAGS_to_monitor_point.txt") - - # Test with factor priors - priors_factor <- list( - p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") - ) - attr(priors_factor[[1]], "levels") <- 3 - - monitor_factor <- JAGS_to_monitor(priors_factor) - test_reference_text(paste(sort(monitor_factor), collapse = ","), "JAGS_to_monitor_factor.txt") - -}) - - -# ============================================================================ # -# SECTION 5: JAGS_fit attribute preservation -# ============================================================================ # -test_that("JAGS_fit preserves attributes", { - - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) +test_that("JAGS_add_priors input validation works", { - # Check that prior_list attribute is preserved - prior_list <- attr(fit_simple, "prior_list") - expect_true(!is.null(prior_list)) - expect_true(is.list(prior_list)) + # Empty prior_list returns original syntax + expect_equal(JAGS_add_priors("model{}", list()), "model{}") - # Check class - expect_true(inherits(fit_simple, "BayesTools_fit") || inherits(fit_simple, "runjags")) + # prior_list must be a list of priors + expect_error(JAGS_add_priors("model{}", list(x = 1)), "'prior_list' must be a list of priors.") + expect_error(JAGS_add_priors("model{}", prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") }) -# ============================================================================ # -# SECTION 6: runjags_estimates_table tests (diagnostics via summary-tables) -# ============================================================================ # -test_that("runjags_estimates_table works with fitted models", { - - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) +test_that("JAGS_get_inits input validation works", { - # Test basic estimates table - estimates_table <- runjags_estimates_table(fit_simple) - test_reference_table(estimates_table, "runjags_estimates_simple.txt") + # Empty prior_list returns empty list + expect_equal(JAGS_get_inits(list(), chains = 2, seed = 1), list()) - # Test without specific parameters - estimates_table_param <- runjags_estimates_table(fit_simple, remove_parameters = "m") - test_reference_table(estimates_table_param, "runjags_estimates_param_m.txt") + # Input validation + expect_error(JAGS_get_inits(list(x = 1), chains = 2, seed = 1), "'prior_list' must be a list of priors.") + expect_error(JAGS_get_inits(prior("normal", list(0, 1)), chains = 2, seed = 1), "'prior_list' must be a list of priors.") }) -# ============================================================================ # -# SECTION 7: JAGS_extend tests -# ============================================================================ # -test_that("JAGS_extend works correctly", { - - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - - # Test extending a fitted model - fit_extended <- JAGS_extend( - fit_simple, - autofit_control = list( - max_Rhat = 1.05, - min_ESS = 100, - max_error = 0.01, - max_SD_error = 0.05, - max_time = list(time = 1, unit = "mins"), - sample_extend = 100, - restarts = 2, - max_extend = 2 - ), - silent = TRUE, - seed = 1 - ) - - # Test extending a fitted model - fit_extended2 <- JAGS_extend( - fit_simple, - autofit_control = list( - max_Rhat = 1.05, - min_ESS = 100, - max_error = 0.01, - max_SD_error = 0.05, - max_time = list(time = 1, unit = "mins"), - sample_extend = 100, - restarts = 2, - max_extend = 2 - ), - parallel = TRUE, - cores = 2, - silent = TRUE, - seed = 1 - ) - - # Check that the extended fit is still a BayesTools_fit - - expect_true(inherits(fit_extended, "BayesTools_fit")) - expect_true(inherits(fit_extended, "runjags")) - expect_true(inherits(fit_extended2, "BayesTools_fit")) - expect_true(inherits(fit_extended2, "runjags")) - - # Check that attributes are preserved - expect_true(!is.null(attr(fit_extended, "prior_list"))) - expect_true(!is.null(attr(fit_extended, "model_syntax"))) - expect_true(!is.null(attr(fit_extended2, "prior_list"))) - expect_true(!is.null(attr(fit_extended2, "model_syntax"))) - - # Check that the extended fit has more samples - original_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_simple))) - extended_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_extended))) - extended_samples2 <- nrow(suppressWarnings(coda::as.mcmc(fit_extended2))) - expect_true(extended_samples >= original_samples) - expect_true(extended_samples2 >= original_samples) - -}) - -test_that("JAGS_extend error handling", { +test_that("JAGS_to_monitor input validation works", { - skip_if_not_installed("rjags") - skip_on_cran() + # Empty prior_list returns empty string + expect_equal(JAGS_to_monitor(list()), "") - # Test error when fit is not a BayesTools_fit - expect_error( - JAGS_extend(list(), autofit_control = list()), - "'fit' must be a 'BayesTools_fit'" - ) + # Input validation + expect_error(JAGS_to_monitor(list(x = 1)), "'prior_list' must be a list of priors.") + expect_error(JAGS_to_monitor(prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") }) -# ============================================================================ # -# SECTION 8: .check_JAGS_syntax error handling -# ============================================================================ # test_that(".check_JAGS_syntax validates syntax correctly", { # Test with valid syntax @@ -355,145 +96,23 @@ test_that(".check_JAGS_syntax validates syntax correctly", { }) -# ============================================================================ # -# SECTION 9: JAGS_fit with is_JASP mode -# ============================================================================ # -test_that("JAGS_fit works with is_JASP mode", { +test_that("JAGS_extend error handling", { skip_if_not_installed("rjags") skip_on_cran() - # Simple model for testing is_JASP mode - set.seed(1) - data <- list( - y = rnorm(20, 0.5, 1), - N = 20 - ) - - prior_list <- list( - mu = prior("normal", list(0, 1)), - sigma = prior("normal", list(0, 1), list(0, Inf)) - ) - - model_syntax <- "model{ - for(i in 1:N){ - y[i] ~ dnorm(mu, 1/pow(sigma, 2)) - } - }" - - # Mock JASP progress bar functions (they should be skipped if not available) - # The is_JASP mode should work but simply skip progress bars if functions don't exist - - fit_jasp <- capture.output(tryCatch({ - suppressWarnings(JAGS_fit( - model_syntax = model_syntax, - data = data, - prior_list = prior_list, - chains = 1, - adapt = 50, - burnin = 50, - sample = 100, - seed = 1, - silent = TRUE, - is_JASP = TRUE, - is_JASP_prefix = "Test" - )) - }, error = function(e) { - # If JASP functions don't exist, this should still produce a fit - # or fail gracefully - if (grepl("JASP", e$message)) { - skip("JASP progress bar functions not available") - } - stop(e) - })) - - test_reference_text(paste0(fit_jasp, collapse = ","), "fit_jasp.txt") - -}) - - -# ============================================================================ # -# SECTION 10: .JAGS_prior.mixture with PEESE prior -# ============================================================================ # -test_that("JAGS_add_priors handles mixture with PEESE prior", { - - skip_if_not_installed("rjags") - - # Create a bias mixture with PEESE prior - bias_mixture <- prior_mixture(list( - prior_none(prior_weights = 1), - prior_PEESE("normal", list(0, 1), prior_weights = 1) - )) - - priors_peese <- list( - bias = bias_mixture - ) - - result_peese <- JAGS_add_priors("model{}", priors_peese) - test_reference_text(result_peese, "JAGS_add_priors_peese_mixture.txt") - -}) - -test_that("JAGS_add_priors handles mixture with PET prior", { - - skip_if_not_installed("rjags") - - # Create a bias mixture with PET prior - bias_mixture <- prior_mixture(list( - prior_none(prior_weights = 1), - prior_PET("normal", list(0, 1), prior_weights = 1) - )) - - priors_pet <- list( - bias = bias_mixture + # Test error when fit is not a BayesTools_fit + expect_error( + JAGS_extend(list(), autofit_control = list()), + "'fit' must be a 'BayesTools_fit'" ) - result_pet <- JAGS_add_priors("model{}", priors_pet) - test_reference_text(result_pet, "JAGS_add_priors_pet_mixture.txt") - }) # ============================================================================ # -# SECTION 11: Additional coverage tests for uncovered code paths +# SECTION 2: Convergence edge cases # ============================================================================ # - -test_that("JAGS_add_priors input validation works", { - - # Empty prior_list returns original syntax - expect_equal(JAGS_add_priors("model{}", list()), "model{}") - - # prior_list must be a list of priors - expect_error(JAGS_add_priors("model{}", list(x = 1)), "'prior_list' must be a list of priors.") - expect_error(JAGS_add_priors("model{}", prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") - -}) - - -test_that("JAGS_get_inits input validation works", { - - # Empty prior_list returns empty list - expect_equal(JAGS_get_inits(list(), chains = 2, seed = 1), list()) - - # Input validation - expect_error(JAGS_get_inits(list(x = 1), chains = 2, seed = 1), "'prior_list' must be a list of priors.") - expect_error(JAGS_get_inits(prior("normal", list(0, 1)), chains = 2, seed = 1), "'prior_list' must be a list of priors.") - -}) - - -test_that("JAGS_to_monitor input validation works", { - - # Empty prior_list returns empty string - expect_equal(JAGS_to_monitor(list()), "") - - # Input validation - expect_error(JAGS_to_monitor(list(x = 1)), "'prior_list' must be a list of priors.") - expect_error(JAGS_to_monitor(prior("normal", list(0, 1))), "'prior_list' must be a list of priors.") - -}) - - test_that("JAGS_check_convergence handles single chain (R-hat warning)", { skip_if_not_installed("rjags") @@ -557,222 +176,57 @@ test_that("JAGS_check_convergence handles ESS and error checks", { }) -test_that("JAGS_check_and_list_autofit_settings validates all parameters", { - - # Valid settings - valid_settings <- list( - max_Rhat = 1.05, - min_ESS = 500, - max_error = 0.01, - max_SD_error = 0.05, - max_time = list(time = 1, unit = "mins"), - sample_extend = 100, - restarts = 3, - max_extend = 10 - ) - expect_silent(JAGS_check_and_list_autofit_settings(valid_settings)) - - # max_time without names - should auto-assign - unnamed_time <- list( - max_Rhat = 1.05, min_ESS = 500, max_error = 0.01, max_SD_error = 0.05, - max_time = list(1, "mins"), sample_extend = 100 - ) - expect_silent(JAGS_check_and_list_autofit_settings(unnamed_time)) - -}) - - -test_that("JAGS_add_priors handles spike_and_slab priors", { +# ============================================================================ # +# SECTION 3: JAGS_fit with is_JASP mode +# ============================================================================ # +test_that("JAGS_fit works with is_JASP mode", { skip_if_not_installed("rjags") + skip_on_cran() - priors_sas <- list( - mu = prior_spike_and_slab( - prior("normal", list(0, 1)), - prior_inclusion = prior("beta", list(1, 1)) - ) + # Simple model for testing is_JASP mode + set.seed(1) + data <- list( + y = rnorm(20, 0.5, 1), + N = 20 ) - result <- JAGS_add_priors("model{}", priors_sas) - expect_true(grepl("mu_variable", result)) - expect_true(grepl("mu_inclusion", result)) - expect_true(grepl("mu_indicator", result)) - - # Test inits - inits <- JAGS_get_inits(priors_sas, chains = 2, seed = 1) - expect_true("mu_variable" %in% names(inits[[1]]) || "mu_inclusion" %in% names(inits[[1]])) - - # Test monitor - monitor <- JAGS_to_monitor(priors_sas) - expect_true("mu_indicator" %in% monitor) - -}) - - -test_that("JAGS_add_priors handles standard prior_mixture (non-bias)", { - - skip_if_not_installed("rjags") - - # Standard mixture (not bias mixture) - mix <- prior_mixture(list( - prior("normal", list(0, 0.5)), - prior("normal", list(0, 1)) - ), is_null = c(TRUE, FALSE)) - - priors_mix <- list(mu = mix) - - result <- JAGS_add_priors("model{}", priors_mix) - expect_true(grepl("mu_indicator", result)) - expect_true(grepl("mu_component_1", result)) - expect_true(grepl("mu_component_2", result)) - - # Test inits - inits <- JAGS_get_inits(priors_mix, chains = 2, seed = 1) - expect_true("mu_indicator" %in% names(inits[[1]])) - - # Test monitor - monitor <- JAGS_to_monitor(priors_mix) - expect_true("mu_indicator" %in% monitor) - expect_true("mu" %in% monitor) - -}) - - -test_that("JAGS handles invgamma prior", { - - skip_if_not_installed("rjags") - - priors_inv <- list(tau = prior("invgamma", list(3, 2))) - - # Test syntax - result <- JAGS_add_priors("model{}", priors_inv) - expect_true(grepl("inv_tau", result)) - expect_true(grepl("dgamma", result)) - - # Test inits - inits <- JAGS_get_inits(priors_inv, chains = 2, seed = 1) - expect_true("inv_tau" %in% names(inits[[1]])) - - # Test monitor - monitor <- JAGS_to_monitor(priors_inv) - expect_true("tau" %in% monitor) - -}) - - -test_that("JAGS handles weightfunction one.sided with alpha1/alpha2", { - - skip_if_not_installed("rjags") - - # One-sided with steps crossing 0.5 uses alpha1/alpha2 parametrization - priors_wf2 <- list(omega = prior_weightfunction("one.sided", list(c(0.05, 0.60), c(1, 1), c(1, 1)))) - - # Test syntax - result <- JAGS_add_priors("model{}", priors_wf2) - expect_true(grepl("eta1", result)) - expect_true(grepl("eta2", result)) - - # Test inits - inits <- JAGS_get_inits(priors_wf2, chains = 2, seed = 1) - expect_true("eta1" %in% names(inits[[1]])) - expect_true("eta2" %in% names(inits[[1]])) - - # Test monitor - monitor <- JAGS_to_monitor(priors_wf2) - expect_true("eta1" %in% monitor) - expect_true("eta2" %in% monitor) - -}) - - -test_that("JAGS handles weightfunction fixed prior", { - - skip_if_not_installed("rjags") - - priors_wf_fixed <- list(omega = prior_weightfunction("one.sided.fixed", list(steps = c(0.05), omega = c(1, 0.5)))) - - # Test syntax - fixed weightfunction has no eta parameters to sample - result <- JAGS_add_priors("model{}", priors_wf_fixed) - expect_true(grepl("omega", result)) - - # Test inits - fixed weightfunction should return empty inits for eta - inits <- JAGS_get_inits(priors_wf_fixed, chains = 2, seed = 1) - # Should not have eta since it's fixed - expect_true(!("eta" %in% names(inits[[1]]))) - - # Test monitor - monitor <- JAGS_to_monitor(priors_wf_fixed) - expect_true("omega" %in% monitor) - -}) - - -test_that("JAGS handles factor treatment/independent priors", { - - skip_if_not_installed("rjags") - - # Treatment contrast - prior_treat <- prior_factor("normal", list(0, 1), contrast = "treatment") - attr(prior_treat, "levels") <- 3 - - priors_treat <- list(fac = prior_treat) - result_treat <- JAGS_add_priors("model{}", priors_treat) - expect_true(grepl("fac\\[i\\]", result_treat)) - - # Independent contrast - prior_indep <- prior_factor("gamma", list(2, 1), contrast = "independent") - attr(prior_indep, "levels") <- 2 - - priors_indep <- list(fac = prior_indep) - result_indep <- JAGS_add_priors("model{}", priors_indep) - expect_true(grepl("dgamma", result_indep)) - -}) - - -test_that("JAGS handles vector mt prior", { - - skip_if_not_installed("rjags") - - prior_mt <- prior("mt", list(location = 0, scale = 1, df = 5, K = 2)) - priors_mt <- list(p = prior_mt) - - # Test syntax - result <- JAGS_add_priors("model{}", priors_mt) - expect_true(grepl("prior_par_s_p", result)) - expect_true(grepl("prior_par_z_p", result)) - - # Test inits - inits <- JAGS_get_inits(priors_mt, chains = 2, seed = 1) - expect_true("prior_par_s_p" %in% names(inits[[1]])) - expect_true("prior_par_z_p" %in% names(inits[[1]])) - -}) - - -test_that("JAGS handles bias mixture with weightfunction", { - - skip_if_not_installed("rjags") - - bias_mix_wf <- prior_mixture(list( - prior_none(prior_weights = 1), - prior_weightfunction("one.sided", list(c(0.05), c(1, 1)), prior_weights = 1) - )) - - priors_bias_wf <- list(bias = bias_mix_wf) + prior_list <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("normal", list(0, 1), list(0, Inf)) + ) - result <- JAGS_add_priors("model{}", priors_bias_wf) - expect_true(grepl("bias_indicator", result)) - expect_true(grepl("omega", result)) - expect_true(grepl("eta", result)) + model_syntax <- "model{ + for(i in 1:N){ + y[i] ~ dnorm(mu, 1/pow(sigma, 2)) + } + }" - # Test inits - inits <- JAGS_get_inits(priors_bias_wf, chains = 2, seed = 1) - expect_true("bias_indicator" %in% names(inits[[1]])) + # Mock JASP progress bar functions (they should be skipped if not available) + # The is_JASP mode should work but simply skip progress bars if functions don't exist + fit_jasp <- capture.output(tryCatch({ + suppressWarnings(JAGS_fit( + model_syntax = model_syntax, + data = data, + prior_list = prior_list, + chains = 1, + adapt = 50, + burnin = 50, + sample = 100, + seed = 1, + silent = TRUE, + is_JASP = TRUE, + is_JASP_prefix = "Test" + )) + }, error = function(e) { + # If JASP functions don't exist, this should still produce a fit + # or fail gracefully + if (grepl("JASP", e$message)) { + skip("JASP progress bar functions not available") + } + stop(e) + })) - # Test monitor - monitor <- JAGS_to_monitor(priors_bias_wf) - expect_true("bias_indicator" %in% monitor) - expect_true("omega" %in% monitor) + test_reference_text(paste0(fit_jasp, collapse = ","), "fit_jasp.txt") }) diff --git a/tests/testthat/test-JAGS-fit.R b/tests/testthat/test-JAGS-fit.R new file mode 100644 index 0000000..deadc98 --- /dev/null +++ b/tests/testthat/test-JAGS-fit.R @@ -0,0 +1,573 @@ +# ============================================================================ # +# TEST FILE: JAGS Fit Functions +# ============================================================================ # +# +# PURPOSE: +# Tests for JAGS fitting functions including JAGS_add_priors, JAGS_get_inits, +# JAGS_to_monitor, JAGS_check_convergence, JAGS_extend, and related utilities. +# +# DEPENDENCIES: +# - rjags: For JAGS model syntax generation and testing +# - common-functions.R: REFERENCE_DIR, test_reference_text, skip_if_no_fits +# +# SKIP CONDITIONS: +# - skip_if_not_installed("rjags"): For all tests +# - skip_if_no_fits(): For tests using pre-fitted models +# +# MODELS/FIXTURES: +# - Some tests use pre-fitted models from test-00-model-fits.R +# +# TAGS: @evaluation, @JAGS +# ============================================================================ # + +# Reference directory for text output comparisons +REFERENCE_DIR <<- testthat::test_path("..", "results", "JAGS-fit") + +source(testthat::test_path("common-functions.R")) + + +# ============================================================================ # +# SECTION 1: JAGS_add_priors tests +# ============================================================================ # +test_that("JAGS_add_priors handles various prior types", { + + skip_if_not_installed("rjags") + + # Test with simple priors + syntax_simple <- "model{}" + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + result_simple <- JAGS_add_priors(syntax_simple, priors_simple) + test_reference_text(result_simple, "JAGS_add_priors_simple.txt") + + # Test with truncated priors + priors_truncated <- list( + mu = prior("normal", list(0, 1), list(0, Inf)) + ) + + result_truncated <- JAGS_add_priors(syntax_simple, priors_truncated) + test_reference_text(result_truncated, "JAGS_add_priors_truncated.txt") + + # Test with point prior + priors_point <- list( + mu = prior("point", list(0)) + ) + + result_point <- JAGS_add_priors(syntax_simple, priors_point) + test_reference_text(result_point, "JAGS_add_priors_point.txt") + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + result_factor <- JAGS_add_priors(syntax_simple, priors_factor) + test_reference_text(result_factor, "JAGS_add_priors_factor.txt") + + # Test with weightfunction priors + priors_wf <- list( + omega = prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + ) + + result_wf <- JAGS_add_priors(syntax_simple, priors_wf) + test_reference_text(result_wf, "JAGS_add_priors_weightfunction.txt") + +}) + + +test_that("JAGS_add_priors handles spike_and_slab priors", { + + skip_if_not_installed("rjags") + + priors_sas <- list( + mu = prior_spike_and_slab( + prior("normal", list(0, 1)), + prior_inclusion = prior("beta", list(1, 1)) + ) + ) + + result <- JAGS_add_priors("model{}", priors_sas) + expect_true(grepl("mu_variable", result)) + expect_true(grepl("mu_inclusion", result)) + expect_true(grepl("mu_indicator", result)) + + # Test inits + inits <- JAGS_get_inits(priors_sas, chains = 2, seed = 1) + expect_true("mu_variable" %in% names(inits[[1]]) || "mu_inclusion" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_sas) + expect_true("mu_indicator" %in% monitor) + +}) + + +test_that("JAGS_add_priors handles standard prior_mixture (non-bias)", { + + skip_if_not_installed("rjags") + + # Standard mixture (not bias mixture) + mix <- prior_mixture(list( + prior("normal", list(0, 0.5)), + prior("normal", list(0, 1)) + ), is_null = c(TRUE, FALSE)) + + priors_mix <- list(mu = mix) + + result <- JAGS_add_priors("model{}", priors_mix) + expect_true(grepl("mu_indicator", result)) + expect_true(grepl("mu_component_1", result)) + expect_true(grepl("mu_component_2", result)) + + # Test inits + inits <- JAGS_get_inits(priors_mix, chains = 2, seed = 1) + expect_true("mu_indicator" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_mix) + expect_true("mu_indicator" %in% monitor) + expect_true("mu" %in% monitor) + +}) + + +test_that("JAGS_add_priors handles mixture with PEESE prior", { + + skip_if_not_installed("rjags") + + # Create a bias mixture with PEESE prior + bias_mixture <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PEESE("normal", list(0, 1), prior_weights = 1) + )) + + priors_peese <- list( + bias = bias_mixture + ) + + result_peese <- JAGS_add_priors("model{}", priors_peese) + test_reference_text(result_peese, "JAGS_add_priors_peese_mixture.txt") + +}) + + +test_that("JAGS_add_priors handles mixture with PET prior", { + + skip_if_not_installed("rjags") + + # Create a bias mixture with PET prior + bias_mixture <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PET("normal", list(0, 1), prior_weights = 1) + )) + + priors_pet <- list( + bias = bias_mixture + ) + + result_pet <- JAGS_add_priors("model{}", priors_pet) + test_reference_text(result_pet, "JAGS_add_priors_pet_mixture.txt") + +}) + + +# ============================================================================ # +# SECTION 2: JAGS_get_inits tests +# ============================================================================ # +test_that("JAGS_get_inits handles various prior types", { + + skip_if_not_installed("rjags") + + # Test with simple priors + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + inits1 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) + expect_equal(length(inits1), 2) + expect_true("mu" %in% names(inits1[[1]])) + expect_true("sigma" %in% names(inits1[[1]])) + + # Same seed should give same results + inits2 <- JAGS_get_inits(priors_simple, chains = 2, seed = 1) + expect_equal(inits1, inits2) + + # Different seeds should give different results + inits3 <- JAGS_get_inits(priors_simple, chains = 2, seed = 123) + expect_false(isTRUE(all.equal(inits1, inits3))) + + # Test with truncated priors + priors_truncated <- list( + mu = prior("normal", list(0, 1), list(0, Inf)) + ) + + inits_truncated <- JAGS_get_inits(priors_truncated, chains = 2, seed = 1) + expect_true(all(sapply(inits_truncated, function(i) i$mu >= 0))) + + # Test with point prior + priors_point <- list( + mu = prior("point", list(5)) + ) + + inits_point <- JAGS_get_inits(priors_point, chains = 2, seed = 1) + # Point priors should not generate inits (they're fixed) + expect_true(!("mu" %in% names(inits_point[[1]])) || all(sapply(inits_point, function(i) i$mu == 5))) + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + inits_factor <- JAGS_get_inits(priors_factor, chains = 2, seed = 1) + expect_true("p1" %in% names(inits_factor[[1]])) + +}) + + +# ============================================================================ # +# SECTION 3: JAGS_check_convergence tests +# ============================================================================ # +test_that("JAGS_check_convergence works with fitted models", { + + skip_if_not_installed("rjags") + skip_if_no_fits() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + prior_list <- attr(fit_simple, "prior_list") + + # Test convergence check with prior_list + convergence <- JAGS_check_convergence(fit_simple, prior_list = prior_list) + expect_true(is.logical(convergence) || is.list(convergence)) + + # Test with NULL prior_list + convergence_null <- JAGS_check_convergence(fit_simple, prior_list = NULL) + expect_true(is.logical(convergence_null) || is.list(convergence_null)) + +}) + + +# ============================================================================ # +# SECTION 4: JAGS_to_monitor tests +# ============================================================================ # +test_that("JAGS_to_monitor generates correct monitor strings", { + + skip_if_not_installed("rjags") + + # Test with simple priors + priors_simple <- list( + mu = prior("normal", list(0, 1)), + sigma = prior("gamma", list(2, 1)) + ) + + monitor <- JAGS_to_monitor(priors_simple) + test_reference_text(paste(sort(monitor), collapse = ","), "JAGS_to_monitor_simple.txt") + + # Test with point prior + priors_with_point <- list( + mu = prior("normal", list(0, 1)), + fixed = prior("point", list(0)) + ) + + monitor_point <- JAGS_to_monitor(priors_with_point) + test_reference_text(paste(sort(monitor), collapse = ", "), "JAGS_to_monitor_point.txt") + + # Test with factor priors + priors_factor <- list( + p1 = prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + ) + attr(priors_factor[[1]], "levels") <- 3 + + monitor_factor <- JAGS_to_monitor(priors_factor) + test_reference_text(paste(sort(monitor_factor), collapse = ","), "JAGS_to_monitor_factor.txt") + +}) + + +# ============================================================================ # +# SECTION 5: JAGS_fit attribute preservation +# ============================================================================ # +test_that("JAGS_fit preserves attributes", { + + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Check that prior_list attribute is preserved + prior_list <- attr(fit_simple, "prior_list") + expect_true(!is.null(prior_list)) + expect_true(is.list(prior_list)) + + # Check class + expect_true(inherits(fit_simple, "BayesTools_fit") || inherits(fit_simple, "runjags")) + +}) + + +# ============================================================================ # +# SECTION 6: runjags_estimates_table tests +# ============================================================================ # +test_that("runjags_estimates_table works with fitted models", { + + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Test basic estimates table + estimates_table <- runjags_estimates_table(fit_simple) + test_reference_table(estimates_table, "runjags_estimates_simple.txt") + + # Test without specific parameters + estimates_table_param <- runjags_estimates_table(fit_simple, remove_parameters = "m") + test_reference_table(estimates_table_param, "runjags_estimates_param_m.txt") + +}) + + +# ============================================================================ # +# SECTION 7: JAGS_extend tests +# ============================================================================ # +test_that("JAGS_extend works correctly", { + + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + fit_simple <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # Test extending a fitted model + fit_extended <- JAGS_extend( + fit_simple, + autofit_control = list( + max_Rhat = 1.05, + min_ESS = 100, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 2, + max_extend = 2 + ), + silent = TRUE, + seed = 1 + ) + + # Test extending a fitted model with parallel + fit_extended2 <- JAGS_extend( + fit_simple, + autofit_control = list( + max_Rhat = 1.05, + min_ESS = 100, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 2, + max_extend = 2 + ), + parallel = TRUE, + cores = 2, + silent = TRUE, + seed = 1 + ) + + # Check that the extended fit is still a BayesTools_fit + expect_true(inherits(fit_extended, "BayesTools_fit")) + expect_true(inherits(fit_extended, "runjags")) + expect_true(inherits(fit_extended2, "BayesTools_fit")) + expect_true(inherits(fit_extended2, "runjags")) + + # Check that attributes are preserved + expect_true(!is.null(attr(fit_extended, "prior_list"))) + expect_true(!is.null(attr(fit_extended, "model_syntax"))) + expect_true(!is.null(attr(fit_extended2, "prior_list"))) + expect_true(!is.null(attr(fit_extended2, "model_syntax"))) + + # Check that the extended fit has more samples + original_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_simple))) + extended_samples <- nrow(suppressWarnings(coda::as.mcmc(fit_extended))) + extended_samples2 <- nrow(suppressWarnings(coda::as.mcmc(fit_extended2))) + expect_true(extended_samples >= original_samples) + expect_true(extended_samples2 >= original_samples) + +}) + + +# ============================================================================ # +# SECTION 8: JAGS handles specific prior types +# ============================================================================ # +test_that("JAGS handles invgamma prior", { + + skip_if_not_installed("rjags") + + priors_inv <- list(tau = prior("invgamma", list(3, 2))) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_inv) + expect_true(grepl("inv_tau", result)) + expect_true(grepl("dgamma", result)) + + # Test inits + inits <- JAGS_get_inits(priors_inv, chains = 2, seed = 1) + expect_true("inv_tau" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_inv) + expect_true("tau" %in% monitor) + +}) + + +test_that("JAGS handles weightfunction one.sided with alpha1/alpha2", { + + skip_if_not_installed("rjags") + + # One-sided with steps crossing 0.5 uses alpha1/alpha2 parametrization + priors_wf2 <- list(omega = prior_weightfunction("one.sided", list(c(0.05, 0.60), c(1, 1), c(1, 1)))) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_wf2) + expect_true(grepl("eta1", result)) + expect_true(grepl("eta2", result)) + + # Test inits + inits <- JAGS_get_inits(priors_wf2, chains = 2, seed = 1) + expect_true("eta1" %in% names(inits[[1]])) + expect_true("eta2" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_wf2) + expect_true("eta1" %in% monitor) + expect_true("eta2" %in% monitor) + +}) + + +test_that("JAGS handles weightfunction fixed prior", { + + skip_if_not_installed("rjags") + + priors_wf_fixed <- list(omega = prior_weightfunction("one.sided.fixed", list(steps = c(0.05), omega = c(1, 0.5)))) + + # Test syntax - fixed weightfunction has no eta parameters to sample + result <- JAGS_add_priors("model{}", priors_wf_fixed) + expect_true(grepl("omega", result)) + + # Test inits - fixed weightfunction should return empty inits for eta + inits <- JAGS_get_inits(priors_wf_fixed, chains = 2, seed = 1) + # Should not have eta since it's fixed + expect_true(!("eta" %in% names(inits[[1]]))) + + # Test monitor + monitor <- JAGS_to_monitor(priors_wf_fixed) + expect_true("omega" %in% monitor) + +}) + + +test_that("JAGS handles factor treatment/independent priors", { + + skip_if_not_installed("rjags") + + # Treatment contrast + prior_treat <- prior_factor("normal", list(0, 1), contrast = "treatment") + attr(prior_treat, "levels") <- 3 + + priors_treat <- list(fac = prior_treat) + result_treat <- JAGS_add_priors("model{}", priors_treat) + expect_true(grepl("fac\\[i\\]", result_treat)) + + # Independent contrast + prior_indep <- prior_factor("gamma", list(2, 1), contrast = "independent") + attr(prior_indep, "levels") <- 2 + + priors_indep <- list(fac = prior_indep) + result_indep <- JAGS_add_priors("model{}", priors_indep) + expect_true(grepl("dgamma", result_indep)) + +}) + + +test_that("JAGS handles vector mt prior", { + + skip_if_not_installed("rjags") + + prior_mt <- prior("mt", list(location = 0, scale = 1, df = 5, K = 2)) + priors_mt <- list(p = prior_mt) + + # Test syntax + result <- JAGS_add_priors("model{}", priors_mt) + expect_true(grepl("prior_par_s_p", result)) + expect_true(grepl("prior_par_z_p", result)) + + # Test inits + inits <- JAGS_get_inits(priors_mt, chains = 2, seed = 1) + expect_true("prior_par_s_p" %in% names(inits[[1]])) + expect_true("prior_par_z_p" %in% names(inits[[1]])) + +}) + + +test_that("JAGS handles bias mixture with weightfunction", { + + skip_if_not_installed("rjags") + + bias_mix_wf <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_weightfunction("one.sided", list(c(0.05), c(1, 1)), prior_weights = 1) + )) + + priors_bias_wf <- list(bias = bias_mix_wf) + + result <- JAGS_add_priors("model{}", priors_bias_wf) + expect_true(grepl("bias_indicator", result)) + expect_true(grepl("omega", result)) + expect_true(grepl("eta", result)) + + # Test inits + inits <- JAGS_get_inits(priors_bias_wf, chains = 2, seed = 1) + expect_true("bias_indicator" %in% names(inits[[1]])) + + # Test monitor + monitor <- JAGS_to_monitor(priors_bias_wf) + expect_true("bias_indicator" %in% monitor) + expect_true("omega" %in% monitor) + +}) + + +# ============================================================================ # +# SECTION 9: JAGS_check_and_list_autofit_settings +# ============================================================================ # +test_that("JAGS_check_and_list_autofit_settings validates all parameters", { + + # Valid settings + valid_settings <- list( + max_Rhat = 1.05, + min_ESS = 500, + max_error = 0.01, + max_SD_error = 0.05, + max_time = list(time = 1, unit = "mins"), + sample_extend = 100, + restarts = 3, + max_extend = 10 + ) + expect_silent(JAGS_check_and_list_autofit_settings(valid_settings)) + + # max_time without names - should auto-assign + unnamed_time <- list( + max_Rhat = 1.05, min_ESS = 500, max_error = 0.01, max_SD_error = 0.05, + max_time = list(1, "mins"), sample_extend = 100 + ) + expect_silent(JAGS_check_and_list_autofit_settings(unnamed_time)) + +}) diff --git a/tests/testthat/test-model-averaging-edge-cases.R b/tests/testthat/test-model-averaging-edge-cases.R index 55c87a3..9b55be2 100644 --- a/tests/testthat/test-model-averaging-edge-cases.R +++ b/tests/testthat/test-model-averaging-edge-cases.R @@ -3,21 +3,19 @@ # ============================================================================ # # # PURPOSE: -# Edge case and comprehensive tests for model averaging functions including -# mix_posteriors, ensemble_inference, and related utilities. +# Edge case tests for model averaging functions including input validation, +# boundary conditions for Bayes factors, and weightfunction mapping edge cases. # # DEPENDENCIES: -# - rjags: For tests using pre-fitted models -# - common-functions.R: temp_fits_dir, skip_if_no_fits, test_reference_text +# - common-functions.R: test_reference_text # # SKIP CONDITIONS: -# - skip_if_no_fits(): Pre-fitted models required -# - skip_if_not_installed("rjags") +# - None (these are simple edge case tests that don't require fitted models) # # MODELS/FIXTURES: -# - fit_simple_normal, fit_simple_spike, fit_formula_interaction_fac +# - None required # -# TAGS: @evaluation, @model-averaging, @edge-cases +# TAGS: @edge-cases, @model-averaging, @input-validation # ============================================================================ # # Reference directory for text output comparisons @@ -25,389 +23,146 @@ REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-edge-cas source(testthat::test_path("common-functions.R")) + # ============================================================================ # -# SECTION 1: mix_posteriors edge cases +# SECTION 1: inclusion_BF boundary conditions # ============================================================================ # -test_that("mix_posteriors handles various prior types correctly", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # Load fits with margliks - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) +test_that("inclusion_BF handles all-null models", { - fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) - - # Create model list for simple priors - models_simple <- list( - list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), - list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) - ) - - # Test mix_posteriors with simple priors - mixed <- mix_posteriors( - model_list = models_simple, - parameters = c("m", "s"), - is_null_list = list("m" = c(FALSE, TRUE), "s" = c(FALSE, FALSE)), - seed = 1, - n_samples = 1000 - ) + # All null models - should return 0 + prior_probs <- c(0.5, 0.5) + post_probs <- c(0.5, 0.5) + is_null <- c(TRUE, TRUE) - expect_true(inherits(mixed, "mixed_posteriors")) - # Capture a summary of the mixed posteriors structure for reference - mixed_info <- paste0( - "Class: ", paste(class(mixed), collapse = ", "), "\n", - "Parameters: ", paste(names(mixed), collapse = ", "), "\n", - "Sample size m: ", length(mixed$m), "\n", - "Sample size s: ", length(mixed$s) - ) - test_reference_text(mixed_info, "mix_posteriors_simple_info.txt") - expect_equal(length(mixed$m), 1000) - expect_equal(length(mixed$s), 1000) - - # Test with conditional = TRUE - mixed_conditional <- mix_posteriors( - model_list = models_simple, - parameters = c("m"), - is_null_list = list("m" = c(FALSE, TRUE)), - conditional = TRUE, - seed = 1, - n_samples = 1000 - ) + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, 0) - expect_true(inherits(mixed_conditional, "mixed_posteriors")) }) -test_that("mix_posteriors handles weightfunction priors", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # Load summary models which have weightfunction priors - fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) +test_that("inclusion_BF handles all-alternative models", { - fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) - marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) - - models_wf <- list( - list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), - list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1), - list(fit = fit_summary2, marglik = marglik_summary2, prior_weights = 1) - ) + # All alternative models - should return Inf + prior_probs <- c(0.5, 0.5) + post_probs <- c(0.5, 0.5) + is_null <- c(FALSE, FALSE) - mixed_wf <- mix_posteriors( - model_list = models_wf, - parameters = c("m", "omega"), - is_null_list = list("m" = c(FALSE, FALSE, FALSE), "omega" = c(TRUE, FALSE, FALSE)), - seed = 1, - n_samples = 1000 - ) + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, Inf) - expect_true(inherits(mixed_wf, "mixed_posteriors")) }) -test_that("mix_posteriors handles factor priors", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # Load the orthonormal factor models (have both factor priors and marginal likelihoods) - fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) - - fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) +test_that("inclusion_BF handles single model case", { - # Create model list with two different models - models_factor <- list( - list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), - list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) - ) - - # Get the parameters from the model - prior_list <- attr(fit_orthonormal_1, "prior_list") - param_names <- names(prior_list) - - # Filter to factor parameters only - factor_params <- param_names[sapply(prior_list, is.prior.factor)] + prior_probs <- 1 + post_probs <- 1 + is_null <- FALSE + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, Inf) - mixed_factor <- mix_posteriors( - model_list = models_factor, - parameters = factor_params[1], # Just test one - is_null_list = setNames(list(c(TRUE, FALSE)), factor_params[1]), - seed = 1, - n_samples = 1000 - ) + # Single null model + is_null <- TRUE + BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) + expect_equal(BF, 0) - expect_true(inherits(mixed_factor, "mixed_posteriors")) }) -test_that("mix_posteriors handles vector priors", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - +test_that("inclusion_BF works with marginal likelihoods only", { - # Load vector prior models - fit_vector_mnormal <- readRDS(file.path(temp_fits_dir, "fit_vector_mnormal.RDS")) - - # Create a mock marglik for testing (we only need the structure) - mock_marglik <- structure( - list(logml = -100, niter = 1000, method = "warp3"), - class = "bridge" - ) - - models_vector <- list( - list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1), - list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1) - ) + # Test with marginal likelihoods instead of posterior probs + prior_probs <- c(0.5, 0.5) + margliks <- c(-10, -10) # Equal margliks + is_null <- c(TRUE, FALSE) - prior_list <- attr(fit_vector_mnormal, "prior_list") - vector_params <- names(prior_list)[sapply(prior_list, is.prior.vector)] + BF <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) + expect_equal(BF, 1) - mixed_vector <- mix_posteriors( - model_list = models_vector, - parameters = vector_params[1], - is_null_list = setNames(list(c(FALSE, FALSE)), vector_params[1]), - seed = 1, - n_samples = 1000 - ) + # Unequal margliks - alternative has higher marglik + margliks <- c(-10, -8) # Alternative model is better + BF <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) + expect_true(BF > 1) - expect_true(inherits(mixed_vector, "mixed_posteriors")) + # Unequal margliks - null has higher marglik + margliks <- c(-8, -10) # Null model is better + BF <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) + expect_true(BF < 1) }) # ============================================================================ # -# SECTION 2: ensemble_inference edge cases +# SECTION 2: weightfunctions_mapping edge cases # ============================================================================ # -test_that("ensemble_inference handles different configurations", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # Load fits with margliks - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) - - fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) - - models <- list( - list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), - list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) - ) - - # Test with integer is_null specification - inference_int <- ensemble_inference( - model_list = models, - parameters = "m", - is_null_list = list("m" = 2) # Second model is null - ) - - expect_true(inherits(inference_int$m, "inference")) - inference_int_info <- paste0( - "BF: ", round(inference_int$m$BF, 4), "\n", - "is_null: ", paste(attr(inference_int$m, "is_null"), collapse = ", "), "\n", - "prior_probs: ", paste(round(inference_int$m$prior_probs, 4), collapse = ", "), "\n", - "post_probs: ", paste(round(inference_int$m$post_probs, 4), collapse = ", ") - ) - test_reference_text(inference_int_info, "ensemble_inference_int_spec.txt") - - # Test conditional inference - inference_cond <- ensemble_inference( - model_list = models, - parameters = "m", - is_null_list = list("m" = c(FALSE, TRUE)), - conditional = TRUE - ) - - expect_true(attr(inference_cond, "conditional")) - inference_cond_info <- paste0( - "Conditional: ", attr(inference_cond, "conditional"), "\n", - "BF: ", round(inference_cond$m$BF, 4) - ) - test_reference_text(inference_cond_info, "ensemble_inference_conditional.txt") +test_that("weightfunctions_mapping handles one-sided priors", { -}) - - -test_that("models_inference computes correctly", { - - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # Load fits with margliks - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) - - fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) - - models <- list( - list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), - list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 2) - ) - - models_with_inference <- models_inference(models) - - # Check that inference was added to each model - expect_true("inference" %in% names(models_with_inference[[1]])) - expect_true("inference" %in% names(models_with_inference[[2]])) - - # Create reference output for models_inference structure - models_inf_info <- paste0( - "Model 1 inference:\n", - " m_number: ", models_with_inference[[1]]$inference$m_number, "\n", - " prior_prob: ", round(models_with_inference[[1]]$inference$prior_prob, 6), "\n", - " post_prob: ", round(models_with_inference[[1]]$inference$post_prob, 6), "\n", - "Model 2 inference:\n", - " m_number: ", models_with_inference[[2]]$inference$m_number, "\n", - " prior_prob: ", round(models_with_inference[[2]]$inference$prior_prob, 6), "\n", - " post_prob: ", round(models_with_inference[[2]]$inference$post_prob, 6), "\n", - "Total post_prob: ", round(sum(sapply(models_with_inference, function(m) m$inference$post_prob)), 6) - ) - test_reference_text(models_inf_info, "models_inference_output.txt") + # Create one-sided weightfunction prior + wf_onesided <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - # Check prior probs reflect weights (1:2 ratio) - expect_equal(models_with_inference[[1]]$inference$prior_prob, 1/3, tolerance = 1e-10) - expect_equal(models_with_inference[[2]]$inference$prior_prob, 2/3, tolerance = 1e-10) + mapping <- weightfunctions_mapping(list(wf_onesided)) - # Check posterior probs sum to 1 - total_post_prob <- sum(sapply(models_with_inference, function(m) m$inference$post_prob)) - expect_equal(total_post_prob, 1, tolerance = 1e-10) + expect_true(is.list(mapping)) + expect_equal(mapping[[1]], c(2, 1)) }) -# ============================================================================ # -# SECTION 3: as_mixed_posteriors and as_marginal_inference -# ============================================================================ # -test_that("as_mixed_posteriors works correctly with BayesTools_fit objects", { +test_that("weightfunctions_mapping handles two-sided priors", { - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() + # Create two-sided weightfunction prior + wf_twosided <- prior_weightfunction("two.sided", list(c(0.05), c(1, 1))) - # Load a fitted model - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + mapping <- weightfunctions_mapping(list(wf_twosided)) - # as_mixed_posteriors needs a BayesTools_fit object - mixed <- as_mixed_posteriors(fit_simple_normal, parameters = c("m", "s")) + expect_true(is.list(mapping)) + expect_equal(mapping[[1]], c(2, 1)) - expect_true(inherits(mixed, "mixed_posteriors")) }) -test_that("as_marginal_inference works correctly", { +test_that("weightfunctions_mapping handles one_sided argument", { - skip_on_cran() - skip_if_not_installed("rjags") - skip_if_no_fits() - - # as_marginal_inference requires a BayesTools_fit object - load one - fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + # Create two-sided weightfunction prior + wf_twosided <- prior_weightfunction("two.sided", list(c(0.05), c(1, 1))) - # Get parameter names from the fitted model - prior_list <- attr(fit_simple_normal, "prior_list") - params <- names(prior_list) + # Test with one_sided = TRUE + mapping_one <- weightfunctions_mapping(list(wf_twosided), one_sided = TRUE) - # Test basic as_marginal_inference call - # This requires the model to have spike_and_slab or mixture priors - # For now, just test that it errors correctly with non-matching parameters - expect_error( - as_marginal_inference(fit_simple_normal, marginal_parameters = "nonexistent"), - regexp = NULL # Any error is expected - ) + expect_true(is.list(mapping_one)) + expect_equal(mapping_one[[1]], c(2, 1, 2)) }) -# ============================================================================ # -# SECTION 4: Inclusion BF edge cases -# ============================================================================ # -test_that("inclusion_BF handles edge cases", { - - # All null models - should return 0 - prior_probs <- c(0.5, 0.5) - post_probs <- c(0.5, 0.5) - is_null <- c(TRUE, TRUE) - - BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) - expect_equal(BF, 0) +test_that("weightfunctions_mapping cuts_only option works", { - # All alternative models - should return Inf - is_null <- c(FALSE, FALSE) - BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) - expect_equal(BF, Inf) + # Create one-sided weightfunction prior + wf_onesided <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - # Single model - prior_probs <- 1 - post_probs <- 1 - is_null <- FALSE - BF <- inclusion_BF(prior_probs = prior_probs, post_probs = post_probs, is_null = is_null) - expect_equal(BF, Inf) + # Test cuts_only = TRUE + cuts <- weightfunctions_mapping(list(wf_onesided), cuts_only = TRUE) - # Test with marginal likelihoods only - prior_probs <- c(0.5, 0.5) - margliks <- c(-10, -10) # Equal margliks - is_null <- c(TRUE, FALSE) - BF <- inclusion_BF(prior_probs = prior_probs, margliks = margliks, is_null = is_null) - expect_equal(BF, 1) + expect_equal(cuts, c(0.00, 0.05, 1.00)) }) -# ============================================================================ # -# SECTION 5: weightfunctions_mapping edge cases -# ============================================================================ # -test_that("weightfunctions_mapping handles various configurations", { +test_that("weightfunctions_mapping handles mixed prior list", { - # Create one-sided weightfunction prior + # Multiple weightfunction priors with different configurations wf_onesided <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + wf_twosided <- prior_weightfunction("two.sided", list(c(0.05, 0.10), c(1, 1, 1))) - # Create two-sided weightfunction prior - wf_twosided <- prior_weightfunction("two.sided", list(c(0.05), c(1, 1))) - - # Test with one-sided prior list - mapping <- weightfunctions_mapping(list(wf_onesided)) - mapping_info <- paste0( - "One-sided mapping:\n", - " Length: ", length(mapping), "\n", - " Is list: ", is.list(mapping) - ) - - # Test with two-sided prior list - mapping_two <- weightfunctions_mapping(list(wf_twosided)) - - # Test with one_sided = TRUE - mapping_one <- weightfunctions_mapping(list(wf_twosided), one_sided = TRUE) + mapping <- weightfunctions_mapping(list(wf_onesided, wf_twosided)) - # Test cuts_only = TRUE - cuts <- weightfunctions_mapping(list(wf_onesided), cuts_only = TRUE) + expect_true(is.list(mapping)) wf_mapping_info <- paste0( - "One-sided mapping length: ", length(mapping), "\n", - "Two-sided mapping length: ", length(mapping_two), "\n", - "Two-sided with one_sided=TRUE length: ", length(mapping_one), "\n", - "Cuts: ", paste(cuts, collapse = ", ") + "Mixed mapping length: ", length(mapping), "\n", + "Inx 1: ", paste0(mapping[[1]], collapse = ","), "\n", + "Inx 2: ", paste0(mapping[[2]], collapse = ",") ) test_reference_text(wf_mapping_info, "weightfunctions_mapping_info.txt") }) - diff --git a/tests/testthat/test-model-averaging-plots-edge-cases.R b/tests/testthat/test-model-averaging-plots-edge-cases.R index 10719e9..a9c14f0 100644 --- a/tests/testthat/test-model-averaging-plots-edge-cases.R +++ b/tests/testthat/test-model-averaging-plots-edge-cases.R @@ -3,41 +3,37 @@ # ============================================================================ # # # PURPOSE: -# Edge case tests for plot_prior_list, plot_posterior, plot_models and -# related visualization functions. +# Edge case tests for plot functions including input validation and +# error handling for invalid prior configurations. # # DEPENDENCIES: -# - vdiffr: Visual regression testing -# - common-functions.R: REFERENCE_DIR, test_reference_table +# - None (pure R testing) # # SKIP CONDITIONS: -# - skip_if_not_installed("vdiffr"): For visual tests -# - Note: First section (input validation) can run on CRAN (pure R) +# - None (can run on CRAN) # # MODELS/FIXTURES: -# - None required (pure prior testing) +# - None required # -# TAGS: @evaluation, @edge-cases, @plots, @model-averaging +# TAGS: @edge-cases, @plots, @input-validation # ============================================================================ # -# Reference directory for text output comparisons (if needed) -REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging-plots-edge-cases") - -source(testthat::test_path("common-functions.R")) - # ============================================================================ # -# SECTION 1: plot_prior_list input validation and edge cases +# SECTION 1: plot_prior_list input validation # ============================================================================ # -test_that("plot_prior_list handles input validation correctly", { - set.seed(1) - # Test error for non-list input +test_that("plot_prior_list rejects non-list input", { + expect_error( plot_prior_list(prior("normal", list(0, 1))), "must be a list of priors" ) - # Test error for PET-PEESE without prior_list_mu +}) + + +test_that("plot_prior_list rejects PET-PEESE without prior_list_mu", { + pet_list <- list( p1 = prior_PET("normal", list(0, 1)) ) @@ -46,538 +42,19 @@ test_that("plot_prior_list handles input validation correctly", { "prior_list_mu" ) - # Test error for providing prior_list_mu when not needed - simple_list <- list( - p1 = prior("normal", list(0, 1)) - ) - expect_error( - plot_prior_list(simple_list, prior_list_mu = list(prior("spike", list(0)))), - "prior_list_mu" - ) - -}) - - -test_that("plot_prior_list handles orthonormal priors", { - set.seed(1) - # Create orthonormal factor prior - prior_orth <- prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") - attr(prior_orth, "levels") <- 3 - - prior_list <- list(p1 = prior_orth) - - # Base plot - vdiffr::expect_doppelganger("plot-prior-list-orthonormal-base", function() { - plot_prior_list(prior_list) - }) - - # ggplot - vdiffr::expect_doppelganger("plot-prior-list-orthonormal-ggplot", { - plot_prior_list(prior_list, plot_type = "ggplot") - }) - - vdiffr::expect_doppelganger("plot-prior-list-orthonormal2-ggplot", { - plot_prior_list(prior_list, plot_type = "ggplot", col = "red", lty = 2, linetype = 2) - }) - - # Create orthonormal factor prior - prior_orth0 <- prior_factor("spike", list(0), contrast = "orthonormal") - attr(prior_orth0, "levels") <- 3 - - prior_list0 <- list(p1 = prior_orth0) - - # Base plot - vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike", function() { - plot_prior_list(prior_list0) - }) - - prior_list2 <- list( - p1 = prior_orth, - p2 = prior_orth0 - ) - - # Base plot - vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike-and-slab", function() { - suppressMessages(plot_prior_list(prior_list2, transformation = "exp", transformation_settings = TRUE, xlim = c(0.01, 5))) - }) -}) - - -test_that("plot_prior_list handles meandif priors", { - set.seed(1) - # Create meandif factor prior - prior_md <- prior_factor("mnorm", list(mean = 0, sd = 0.5), contrast = "meandif") - attr(prior_md, "levels") <- 3 - - prior_list <- list(p1 = prior_md) - - # Base plot - vdiffr::expect_doppelganger("plot-prior-list-meandif-base", function() { - plot_prior_list(prior_list) - }) - - # ggplot - vdiffr::expect_doppelganger("plot-prior-list-meandif-ggplot", { - plot_prior_list(prior_list, plot_type = "ggplot") - }) - -}) - - -# ============================================================================ # -# SECTION 2: lines_prior_list edge cases -# ============================================================================ # -test_that("lines_prior_list handles various configurations", { - set.seed(1) - prior_list <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("normal", list(0, 2)) - ) - - # Test adding lines to existing plot - vdiffr::expect_doppelganger("lines-prior-list-add", function() { - plot(NULL, xlim = c(-5, 5), ylim = c(0, 0.5), xlab = "", ylab = "") - lines_prior_list(prior_list, col = "red", lwd = 2) - }) - - # Test with custom xlim - vdiffr::expect_doppelganger("lines-prior-list-xlim", function() { - plot(NULL, xlim = c(-3, 3), ylim = c(0, 0.5), xlab = "", ylab = "") - lines_prior_list(prior_list, xlim = c(-3, 3), col = "blue") - }) - -}) - - -# ============================================================================ # -# SECTION 3: geom_prior_list edge cases -# ============================================================================ # -test_that("geom_prior_list handles various configurations", { - set.seed(1) - prior_list <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("spike", list(0.5)) - ) - - # Test adding to ggplot - vdiffr::expect_doppelganger("geom-prior-list-add", { - ggplot2::ggplot() + - ggplot2::xlim(-4, 4) + - ggplot2::ylim(0, 1) + - geom_prior_list(prior_list, col = "red") - }) - -}) - - -# ============================================================================ # -# SECTION 4: plot_posterior edge cases -# ============================================================================ # -test_that("plot_posterior handles various sample types", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load fits - fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) - - fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - models <- list( - list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), - list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("m", "omega"), - is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), - seed = 1, - n_samples = 1000 - ) - - # Test simple posterior plot - vdiffr::expect_doppelganger("plot-posterior-simple", function() { - plot_posterior(mixed_posteriors, "m") - }) - - # Test with prior overlay - vdiffr::expect_doppelganger("plot-posterior-with-prior", function() { - plot_posterior(mixed_posteriors, "m", prior = TRUE) - }) - - # Test ggplot version - vdiffr::expect_doppelganger("plot-posterior-ggplot", { - plot_posterior(mixed_posteriors, "m", plot_type = "ggplot") - }) - - # Test with custom xlim - vdiffr::expect_doppelganger("plot-posterior-xlim", function() { - plot_posterior(mixed_posteriors, "m", xlim = c(-2, 2)) - }) - }) -test_that("plot_posterior handles weightfunction posteriors", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load fits - fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) - - fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - models <- list( - list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), - list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("m", "omega"), - is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), - seed = 1, - n_samples = 1000 - ) - - # Test weightfunction posterior plot - vdiffr::expect_doppelganger("plot-posterior-omega", function() { - plot_posterior(mixed_posteriors, "omega", n_points = 50, n_samples = 500) - }) - -}) - - -# ============================================================================ # -# SECTION 5: plot_models edge cases -# ============================================================================ # -test_that("plot_models handles various configurations", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - - # Skip if summary fits don't exist - if (!file.exists(file.path(temp_fits_dir, "fit_summary0.RDS"))) { - skip("Summary fits not found") - } - - # Load fits - fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) - - fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - models <- list( - list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), - list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) - ) - models <- models_inference(models) - - inference <- ensemble_inference( - model_list = models, - parameters = c("m"), - is_null_list = list("m" = c(FALSE, FALSE)) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("m"), - is_null_list = list("m" = c(FALSE, FALSE)), - seed = 1, - n_samples = 1000 - ) +test_that("plot_prior_list rejects prior_list_mu when not needed", { - # Test basic plot_models - vdiffr::expect_doppelganger("plot-models-basic", function() { - plot_models(models, mixed_posteriors, inference, "m") - }) - - # Test ggplot version - vdiffr::expect_doppelganger("plot-models-ggplot", { - plot_models(models, mixed_posteriors, inference, "m", plot_type = "ggplot") - }) - -}) - - -# ============================================================================ # -# SECTION 6: scale_y2 handling for mixed priors -# ============================================================================ # -test_that("scale_y2 is handled correctly for mixed distributions", { - set.seed(1) - # Create a list with both continuous and point priors - prior_list <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("spike", list(0)) - ) - - # Base plot should handle dual y-axis - vdiffr::expect_doppelganger("plot-prior-list-dual-axis", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4)) - plot_prior_list(prior_list) - }) - - # ggplot should handle it differently - vdiffr::expect_doppelganger("plot-prior-list-dual-axis-ggplot", { - plot_prior_list(prior_list, plot_type = "ggplot") - }) - -}) - - -# ============================================================================ # -# SECTION 7: Simple prior list plotting -# ============================================================================ # -test_that("plot_prior_list handles simple cases", { - set.seed(1) - # Test with a single normal prior - prior_list_normal <- list( + simple_list <- list( p1 = prior("normal", list(0, 1)) ) - - vdiffr::expect_doppelganger("plot-prior-list-single-normal", function() { - plot_prior_list(prior_list_normal) - }) - - # Test with multiple priors - prior_list_multi <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("normal", list(1, 0.5)), - p3 = prior("cauchy", list(0, 1)) - ) - - vdiffr::expect_doppelganger("plot-prior-list-multi", function() { - plot_prior_list(prior_list_multi) - }) - - # Test with gamma prior - prior_list_gamma <- list( - p1 = prior("gamma", list(2, 1)) - ) - - vdiffr::expect_doppelganger("plot-prior-list-gamma", function() { - plot_prior_list(prior_list_gamma) - }) - -}) - - -# ============================================================================ # -# SECTION 8: Weightfunction prior plotting -# ============================================================================ # -test_that("plot_prior_list handles weightfunction priors", { - set.seed(1) - # Create one-sided weightfunction prior - wf_prior <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) - - prior_list_wf <- list(p1 = wf_prior) - - vdiffr::expect_doppelganger("plot-prior-list-weightfunction", function() { - plot_prior_list(prior_list_wf) - }) - - # Test ggplot version - vdiffr::expect_doppelganger("plot-prior-list-weightfunction-ggplot", { - plot_prior_list(prior_list_wf, plot_type = "ggplot") - }) - -}) - - -# ============================================================================ # -# SECTION 9: .plot_prior_list.factor edge cases -# ============================================================================ # -test_that(".plot_prior_list.factor handles point priors within factor", { - set.seed(1) - - # Test factor prior - using treatment contrast with normal distribution - prior_spike <- prior("spike", list(0)) - prior_factor_treat <- prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment") - attr(prior_factor_treat, "levels") <- 3 - - # Simple list with both spike and factor priors - prior_list <- list(p1 = prior_spike, p2 = prior_factor_treat) - - # This should handle mixed plotting - vdiffr::expect_doppelganger("plot-factor-with-spike", function() { - plot_prior_list(prior_list) - }) - - # This should handle mixed plotting - vdiffr::expect_doppelganger("plot-factor-with-spike-trans", function() { - plot_prior_list(prior_list, transformation = "tanh") - }) - - # This should handle mixed plotting - vdiffr::expect_doppelganger("plot-factor-with-spike-trans-settings", function() { - plot_prior_list(prior_list, transformation = "tanh", transformation_settings = T, xlim = c(-0.5, 0.5)) - }) - -}) - -test_that(".plot_prior_list.factor handles transformation", { - set.seed(1) - - # Create treatment factor prior with normal distribution - prior_treat <- prior_factor("normal", list(mean = 0, sd = 0.5), contrast = "treatment") - attr(prior_treat, "levels") <- 3 - - prior_list <- list(p1 = prior_treat) - - # Test with transformation (exp) - use string format for simplicity - vdiffr::expect_doppelganger("plot-factor-transformation", function() { - plot_prior_list(prior_list, transformation = "exp") - }) - -}) - - -# ============================================================================ # -# SECTION 10: plot_models with order argument -# ============================================================================ # -test_that("plot_models handles order argument", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load fits - fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) - - fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) - - models <- list( - list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), - list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) - ) - models <- models_inference(models) - - inference <- ensemble_inference( - model_list = models, - parameters = c("m"), - is_null_list = list("m" = c(FALSE, FALSE)) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = c("m"), - is_null_list = list("m" = c(FALSE, FALSE)), - seed = 1, - n_samples = 1000 - ) - - # Test with order = decreasing by estimate - vdiffr::expect_doppelganger("plot-models-order-decreasing-estimate", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "estimate")) - }) - - # Test with order = increasing by BF - vdiffr::expect_doppelganger("plot-models-order-increasing-bf", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "BF")) - }) - - # Test with order = decreasing by probability - vdiffr::expect_doppelganger("plot-models-order-decreasing-prob", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "probability")) - }) - - # Test with order = decreasing by probability - vdiffr::expect_doppelganger("plot-models-order-trans", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp") - }) - - # Test with order = decreasing by probability - vdiffr::expect_doppelganger("plot-models-order-trans-prior", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp") - }) - - # Test with order = decreasing by probability - vdiffr::expect_doppelganger("plot-models-order-trans-ggplot", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp", plot_type = "ggplot") - }) - - # Test with order = decreasing by probability - vdiffr::expect_doppelganger("plot-models-order-trans-prior-ggplot", function() { - BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp", plot_type = "ggplot") - }) - -}) - - -test_that("plot_models handles orthonormal priors", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load orthonormal models with marginal likelihoods - fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) - - fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) - - models <- list( - list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1, - fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_0, transform_factors = TRUE))), - list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1, - fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_1, transform_factors = TRUE))) - ) - models <- models_inference(models) - - # Get factor parameter names from the model - prior_list <- attr(fit_orthonormal_1, "prior_list") - factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] - - inference <- ensemble_inference( - model_list = models, - parameters = factor_params, - is_null_list = setNames(list(c(TRUE, FALSE)), factor_params) - ) - - mixed_posteriors <- mix_posteriors( - model_list = models, - parameters = factor_params, - is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), - seed = 1, - n_samples = 1000 + expect_error( + plot_prior_list(simple_list, prior_list_mu = list(prior("spike", list(0)))), + "prior_list_mu" ) - # Test with orthonormal priors - the models should be transformed to differences from mean - vdiffr::expect_doppelganger("plot-models-orthonormal", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) - BayesTools::plot_models(models, mixed_posteriors, inference, factor_params) - }) - - vdiffr::expect_doppelganger("plot-models-orthonormal-2", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) - BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp") - }) - - vdiffr::expect_doppelganger("plot-models-orthonormal-3", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) - BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp", prior = TRUE) - }) - }) diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-model-averaging-plots.R new file mode 100644 index 0000000..bc827a5 --- /dev/null +++ b/tests/testthat/test-model-averaging-plots.R @@ -0,0 +1,538 @@ +# ============================================================================ # +# TEST FILE: Model Averaging Plots +# ============================================================================ # +# +# PURPOSE: +# Tests for plot_prior_list, plot_posterior, plot_models, and related +# visualization functions in model averaging. +# +# DEPENDENCIES: +# - vdiffr: Visual regression testing +# - rjags: For tests using pre-fitted models +# - common-functions.R: temp_fits_dir, skip_if_no_fits +# +# SKIP CONDITIONS: +# - skip_if_not_installed("vdiffr"): For visual tests +# - skip_if_no_fits(): For tests using pre-fitted models +# +# MODELS/FIXTURES: +# - fit_summary0, fit_summary1, fit_orthonormal_0, fit_orthonormal_1 +# +# TAGS: @evaluation, @visual, @plots, @model-averaging +# ============================================================================ # + +source(testthat::test_path("common-functions.R")) + +skip_if_not_installed("vdiffr") + + +# ============================================================================ # +# SECTION 1: plot_prior_list basic tests +# ============================================================================ # +test_that("plot_prior_list handles simple cases", { + set.seed(1) + + # Test with a single normal prior + prior_list_normal <- list( + p1 = prior("normal", list(0, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-single-normal", function() { + plot_prior_list(prior_list_normal) + }) + + # Test with multiple priors + prior_list_multi <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(1, 0.5)), + p3 = prior("cauchy", list(0, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-multi", function() { + plot_prior_list(prior_list_multi) + }) + + # Test with gamma prior + prior_list_gamma <- list( + p1 = prior("gamma", list(2, 1)) + ) + + vdiffr::expect_doppelganger("plot-prior-list-gamma", function() { + plot_prior_list(prior_list_gamma) + }) + +}) + + +test_that("plot_prior_list handles orthonormal priors", { + set.seed(1) + + # Create orthonormal factor prior + prior_orth <- prior_factor("mnorm", list(mean = 0, sd = 1), contrast = "orthonormal") + attr(prior_orth, "levels") <- 3 + + prior_list <- list(p1 = prior_orth) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-base", function() { + plot_prior_list(prior_list) + }) + + # ggplot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + + vdiffr::expect_doppelganger("plot-prior-list-orthonormal2-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot", col = "red", lty = 2, linetype = 2) + }) + + # Create orthonormal factor prior with spike + prior_orth0 <- prior_factor("spike", list(0), contrast = "orthonormal") + attr(prior_orth0, "levels") <- 3 + + prior_list0 <- list(p1 = prior_orth0) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike", function() { + plot_prior_list(prior_list0) + }) + + prior_list2 <- list( + p1 = prior_orth, + p2 = prior_orth0 + ) + + # Base plot with transformation + vdiffr::expect_doppelganger("plot-prior-list-orthonormal-spike-and-slab", function() { + suppressMessages(plot_prior_list(prior_list2, transformation = "exp", transformation_settings = TRUE, xlim = c(0.01, 5))) + }) + +}) + + +test_that("plot_prior_list handles meandif priors", { + set.seed(1) + + # Create meandif factor prior + prior_md <- prior_factor("mnorm", list(mean = 0, sd = 0.5), contrast = "meandif") + attr(prior_md, "levels") <- 3 + + prior_list <- list(p1 = prior_md) + + # Base plot + vdiffr::expect_doppelganger("plot-prior-list-meandif-base", function() { + plot_prior_list(prior_list) + }) + + # ggplot + vdiffr::expect_doppelganger("plot-prior-list-meandif-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + +}) + + +test_that("plot_prior_list handles weightfunction priors", { + set.seed(1) + + # Create one-sided weightfunction prior + wf_prior <- prior_weightfunction("one.sided", list(c(0.05), c(1, 1))) + + prior_list_wf <- list(p1 = wf_prior) + + vdiffr::expect_doppelganger("plot-prior-list-weightfunction", function() { + plot_prior_list(prior_list_wf) + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-prior-list-weightfunction-ggplot", { + plot_prior_list(prior_list_wf, plot_type = "ggplot") + }) + +}) + + +test_that("scale_y2 is handled correctly for mixed distributions", { + set.seed(1) + + # Create a list with both continuous and point priors + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("spike", list(0)) + ) + + # Base plot should handle dual y-axis + vdiffr::expect_doppelganger("plot-prior-list-dual-axis", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_prior_list(prior_list) + }) + + # ggplot should handle it differently + vdiffr::expect_doppelganger("plot-prior-list-dual-axis-ggplot", { + plot_prior_list(prior_list, plot_type = "ggplot") + }) + +}) + + +# ============================================================================ # +# SECTION 2: lines_prior_list tests +# ============================================================================ # +test_that("lines_prior_list handles various configurations", { + set.seed(1) + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(0, 2)) + ) + + # Test adding lines to existing plot + vdiffr::expect_doppelganger("lines-prior-list-add", function() { + plot(NULL, xlim = c(-5, 5), ylim = c(0, 0.5), xlab = "", ylab = "") + lines_prior_list(prior_list, col = "red", lwd = 2) + }) + + # Test with custom xlim + vdiffr::expect_doppelganger("lines-prior-list-xlim", function() { + plot(NULL, xlim = c(-3, 3), ylim = c(0, 0.5), xlab = "", ylab = "") + lines_prior_list(prior_list, xlim = c(-3, 3), col = "blue") + }) + +}) + + +# ============================================================================ # +# SECTION 3: geom_prior_list tests +# ============================================================================ # +test_that("geom_prior_list handles various configurations", { + set.seed(1) + prior_list <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("spike", list(0.5)) + ) + + # Test adding to ggplot + vdiffr::expect_doppelganger("geom-prior-list-add", { + ggplot2::ggplot() + + ggplot2::xlim(-4, 4) + + ggplot2::ylim(0, 1) + + geom_prior_list(prior_list, col = "red") + }) + +}) + + +# ============================================================================ # +# SECTION 4: plot_posterior tests +# ============================================================================ # +test_that("plot_posterior handles various sample types", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test simple posterior plot + vdiffr::expect_doppelganger("plot-posterior-simple", function() { + plot_posterior(mixed_posteriors, "m") + }) + + # Test with prior overlay + vdiffr::expect_doppelganger("plot-posterior-with-prior", function() { + plot_posterior(mixed_posteriors, "m", prior = TRUE) + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-posterior-ggplot", { + plot_posterior(mixed_posteriors, "m", plot_type = "ggplot") + }) + + # Test with custom xlim + vdiffr::expect_doppelganger("plot-posterior-xlim", function() { + plot_posterior(mixed_posteriors, "m", xlim = c(-2, 2)) + }) + +}) + + +test_that("plot_posterior handles weightfunction posteriors", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE), "omega" = c(TRUE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test weightfunction posterior plot + vdiffr::expect_doppelganger("plot-posterior-omega", function() { + plot_posterior(mixed_posteriors, "omega", n_points = 50, n_samples = 500) + }) + +}) + + +# ============================================================================ # +# SECTION 5: plot_models tests +# ============================================================================ # +test_that("plot_models handles various configurations", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) + ) + models <- models_inference(models) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test basic plot_models + vdiffr::expect_doppelganger("plot-models-basic", function() { + plot_models(models, mixed_posteriors, inference, "m") + }) + + # Test ggplot version + vdiffr::expect_doppelganger("plot-models-ggplot", { + plot_models(models, mixed_posteriors, inference, "m", plot_type = "ggplot") + }) + +}) + + +test_that("plot_models handles order argument", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load fits + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + models <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary1)) + ) + models <- models_inference(models) + + inference <- ensemble_inference( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + # Test with order = decreasing by estimate + vdiffr::expect_doppelganger("plot-models-order-decreasing-estimate", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "estimate")) + }) + + # Test with order = increasing by BF + vdiffr::expect_doppelganger("plot-models-order-increasing-bf", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "BF")) + }) + + # Test with order = decreasing by probability + vdiffr::expect_doppelganger("plot-models-order-decreasing-prob", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", order = list("decreasing", "probability")) + }) + + # Test with transformation + vdiffr::expect_doppelganger("plot-models-order-trans", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp") + }) + + # Test with transformation and prior + vdiffr::expect_doppelganger("plot-models-order-trans-prior", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp") + }) + + # Test with transformation ggplot + vdiffr::expect_doppelganger("plot-models-order-trans-ggplot", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", transformation = "exp", plot_type = "ggplot") + }) + + # Test with transformation and prior ggplot + vdiffr::expect_doppelganger("plot-models-order-trans-prior-ggplot", function() { + BayesTools::plot_models(models, mixed_posteriors, inference, "m", prior = TRUE, transformation = "exp", plot_type = "ggplot") + }) + +}) + + +test_that("plot_models handles orthonormal priors", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load orthonormal models with marginal likelihoods + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + models <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1, + fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_0, transform_factors = TRUE))), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1, + fit_summary = suppressMessages(runjags_estimates_table(fit_orthonormal_1, transform_factors = TRUE))) + ) + models <- models_inference(models) + + # Get factor parameter names from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + factor_params <- names(prior_list)[sapply(prior_list, is.prior.factor)] + + inference <- ensemble_inference( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params) + ) + + mixed_posteriors <- mix_posteriors( + model_list = models, + parameters = factor_params, + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params), + seed = 1, + n_samples = 1000 + ) + + # Test with orthonormal priors + vdiffr::expect_doppelganger("plot-models-orthonormal", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params) + }) + + vdiffr::expect_doppelganger("plot-models-orthonormal-2", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp") + }) + + vdiffr::expect_doppelganger("plot-models-orthonormal-3", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + BayesTools::plot_models(models, mixed_posteriors, inference, factor_params, transformation = "exp", prior = TRUE) + }) + +}) + + +# ============================================================================ # +# SECTION 6: .plot_prior_list.factor tests +# ============================================================================ # +test_that(".plot_prior_list.factor handles point priors within factor", { + set.seed(1) + + # Test factor prior with spike + prior_spike <- prior("spike", list(0)) + prior_factor_treat <- prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment") + attr(prior_factor_treat, "levels") <- 3 + + prior_list <- list(p1 = prior_spike, p2 = prior_factor_treat) + + vdiffr::expect_doppelganger("plot-factor-with-spike", function() { + plot_prior_list(prior_list) + }) + + vdiffr::expect_doppelganger("plot-factor-with-spike-trans", function() { + plot_prior_list(prior_list, transformation = "tanh") + }) + + vdiffr::expect_doppelganger("plot-factor-with-spike-trans-settings", function() { + plot_prior_list(prior_list, transformation = "tanh", transformation_settings = T, xlim = c(-0.5, 0.5)) + }) + +}) + + +test_that(".plot_prior_list.factor handles transformation", { + set.seed(1) + + # Create treatment factor prior with normal distribution + prior_treat <- prior_factor("normal", list(mean = 0, sd = 0.5), contrast = "treatment") + attr(prior_treat, "levels") <- 3 + + prior_list <- list(p1 = prior_treat) + + vdiffr::expect_doppelganger("plot-factor-transformation", function() { + plot_prior_list(prior_list, transformation = "exp") + }) + +}) diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R index 53cb7f9..8cc1436 100644 --- a/tests/testthat/test-model-averaging.R +++ b/tests/testthat/test-model-averaging.R @@ -3,23 +3,35 @@ # ============================================================================ # # # PURPOSE: -# Tests for compute_inference, ensemble_inference, and related Bayesian -# model averaging functions in R/model-averaging.R +# Tests for compute_inference, ensemble_inference, mix_posteriors, models_inference, +# inclusion_BF, weightfunctions_mapping, and related Bayesian model averaging +# functions in R/model-averaging.R # # DEPENDENCIES: # - bridgesampling: Required for marginal likelihood computation +# - rjags: For tests using pre-fitted models # - common-functions.R: Test helpers # # SKIP CONDITIONS: # - skip_if_not_installed("bridgesampling") +# - skip_if_not_installed("rjags") +# - skip_if_no_fits() # # MODELS/FIXTURES: -# - Uses pre-computed marginal likelihoods, not pre-fitted models +# - Uses pre-computed marginal likelihoods and pre-fitted models # # TAGS: @evaluation, @model-averaging # ============================================================================ # +# Reference directory for text output comparisons +REFERENCE_DIR <<- testthat::test_path("..", "results", "model-averaging") +source(testthat::test_path("common-functions.R")) + + +# ============================================================================ # +# SECTION 1: compute_inference tests +# ============================================================================ # test_that("compute_inference works correctly", { skip_if_not_installed("bridgesampling") @@ -191,3 +203,292 @@ test_that("weightfunctions_mapping input validation works", { ) }) + +# ============================================================================ # +# SECTION 5: mix_posteriors tests +# ============================================================================ # +test_that("mix_posteriors handles various prior types correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + # Create model list for simple priors + models_simple <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) + ) + + # Test mix_posteriors with simple priors + mixed <- mix_posteriors( + model_list = models_simple, + parameters = c("m", "s"), + is_null_list = list("m" = c(FALSE, TRUE), "s" = c(FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed, "mixed_posteriors")) + # Capture a summary of the mixed posteriors structure for reference + mixed_info <- paste0( + "Class: ", paste(class(mixed), collapse = ", "), "\n", + "Parameters: ", paste(names(mixed), collapse = ", "), "\n", + "Sample size m: ", length(mixed$m), "\n", + "Sample size s: ", length(mixed$s) + ) + test_reference_text(mixed_info, "mix_posteriors_simple_info.txt") + expect_equal(length(mixed$m), 1000) + expect_equal(length(mixed$s), 1000) + + # Test with conditional = TRUE + mixed_conditional <- mix_posteriors( + model_list = models_simple, + parameters = c("m"), + is_null_list = list("m" = c(FALSE, TRUE)), + conditional = TRUE, + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_conditional, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles weightfunction priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load summary models which have weightfunction priors + fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) + marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + + fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) + marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + + fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) + marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + + models_wf <- list( + list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), + list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1), + list(fit = fit_summary2, marglik = marglik_summary2, prior_weights = 1) + ) + + mixed_wf <- mix_posteriors( + model_list = models_wf, + parameters = c("m", "omega"), + is_null_list = list("m" = c(FALSE, FALSE, FALSE), "omega" = c(TRUE, FALSE, FALSE)), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_wf, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles factor priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load the orthonormal factor models (have both factor priors and marginal likelihoods) + fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + + fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + + # Create model list with two different models + models_factor <- list( + list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), + list(fit = fit_orthonormal_1, marglik = marglik_orthonormal_1, prior_weights = 1) + ) + + # Get the parameters from the model + prior_list <- attr(fit_orthonormal_1, "prior_list") + param_names <- names(prior_list) + + # Filter to factor parameters only + factor_params <- param_names[sapply(prior_list, is.prior.factor)] + + mixed_factor <- mix_posteriors( + model_list = models_factor, + parameters = factor_params[1], # Just test one + is_null_list = setNames(list(c(TRUE, FALSE)), factor_params[1]), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_factor, "mixed_posteriors")) +}) + + +test_that("mix_posteriors handles vector priors", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load vector prior models + fit_vector_mnormal <- readRDS(file.path(temp_fits_dir, "fit_vector_mnormal.RDS")) + + # Create a mock marglik for testing (we only need the structure) + mock_marglik <- structure( + list(logml = -100, niter = 1000, method = "warp3"), + class = "bridge" + ) + + models_vector <- list( + list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1), + list(fit = fit_vector_mnormal, marglik = mock_marglik, prior_weights = 1) + ) + + prior_list <- attr(fit_vector_mnormal, "prior_list") + vector_params <- names(prior_list)[sapply(prior_list, is.prior.vector)] + + mixed_vector <- mix_posteriors( + model_list = models_vector, + parameters = vector_params[1], + is_null_list = setNames(list(c(FALSE, FALSE)), vector_params[1]), + seed = 1, + n_samples = 1000 + ) + + expect_true(inherits(mixed_vector, "mixed_posteriors")) +}) + + +# ============================================================================ # +# SECTION 6: ensemble_inference tests +# ============================================================================ # +test_that("ensemble_inference handles different configurations", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1) + ) + + # Test with integer is_null specification + inference_int <- ensemble_inference( + model_list = models, + parameters = "m", + is_null_list = list("m" = 2) # Second model is null + ) + + expect_true(inherits(inference_int$m, "inference")) + inference_int_info <- paste0( + "BF: ", round(inference_int$m$BF, 4), "\n", + "is_null: ", paste(attr(inference_int$m, "is_null"), collapse = ", "), "\n", + "prior_probs: ", paste(round(inference_int$m$prior_probs, 4), collapse = ", "), "\n", + "post_probs: ", paste(round(inference_int$m$post_probs, 4), collapse = ", ") + ) + test_reference_text(inference_int_info, "ensemble_inference_int_spec.txt") + + # Test conditional inference + inference_cond <- ensemble_inference( + model_list = models, + parameters = "m", + is_null_list = list("m" = c(FALSE, TRUE)), + conditional = TRUE + ) + + expect_true(attr(inference_cond, "conditional")) + inference_cond_info <- paste0( + "Conditional: ", attr(inference_cond, "conditional"), "\n", + "BF: ", round(inference_cond$m$BF, 4) + ) + test_reference_text(inference_cond_info, "ensemble_inference_conditional.txt") + +}) + + +# ============================================================================ # +# SECTION 7: models_inference tests +# ============================================================================ # +test_that("models_inference computes correctly", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load fits with margliks + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + + fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + + models <- list( + list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), + list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 2) + ) + + models_with_inference <- models_inference(models) + + # Check that inference was added to each model + expect_true("inference" %in% names(models_with_inference[[1]])) + expect_true("inference" %in% names(models_with_inference[[2]])) + + # Create reference output for models_inference structure + models_inf_info <- paste0( + "Model 1 inference:\n", + " m_number: ", models_with_inference[[1]]$inference$m_number, "\n", + " prior_prob: ", round(models_with_inference[[1]]$inference$prior_prob, 6), "\n", + " post_prob: ", round(models_with_inference[[1]]$inference$post_prob, 6), "\n", + "Model 2 inference:\n", + " m_number: ", models_with_inference[[2]]$inference$m_number, "\n", + " prior_prob: ", round(models_with_inference[[2]]$inference$prior_prob, 6), "\n", + " post_prob: ", round(models_with_inference[[2]]$inference$post_prob, 6), "\n", + "Total post_prob: ", round(sum(sapply(models_with_inference, function(m) m$inference$post_prob)), 6) + ) + test_reference_text(models_inf_info, "models_inference_output.txt") + + # Check prior probs reflect weights (1:2 ratio) + expect_equal(models_with_inference[[1]]$inference$prior_prob, 1/3, tolerance = 1e-10) + expect_equal(models_with_inference[[2]]$inference$prior_prob, 2/3, tolerance = 1e-10) + + # Check posterior probs sum to 1 + total_post_prob <- sum(sapply(models_with_inference, function(m) m$inference$post_prob)) + expect_equal(total_post_prob, 1, tolerance = 1e-10) + +}) + + +# ============================================================================ # +# SECTION 8: as_mixed_posteriors and as_marginal_inference tests +# ============================================================================ # +test_that("as_mixed_posteriors works correctly with BayesTools_fit objects", { + + skip_on_cran() + skip_if_not_installed("rjags") + skip_if_no_fits() + + # Load a fitted model + fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) + + # as_mixed_posteriors needs a BayesTools_fit object + mixed <- as_mixed_posteriors(fit_simple_normal, parameters = c("m", "s")) + + expect_true(inherits(mixed, "mixed_posteriors")) +}) \ No newline at end of file diff --git a/tests/testthat/test-summary-tables-edge-cases.R b/tests/testthat/test-summary-tables.R similarity index 95% rename from tests/testthat/test-summary-tables-edge-cases.R rename to tests/testthat/test-summary-tables.R index 3a20087..9525865 100644 --- a/tests/testthat/test-summary-tables-edge-cases.R +++ b/tests/testthat/test-summary-tables.R @@ -1,10 +1,11 @@ # ============================================================================ # -# TEST FILE: Summary Tables Edge Cases +# TEST FILE: Summary Tables # ============================================================================ # # # PURPOSE: -# Edge case and comprehensive tests for summary table functions including -# ensemble_estimates_table, ensemble_inference_table, and print methods. +# Tests for summary table functions including ensemble_estimates_table, +# ensemble_inference_table, ensemble_summary_table, ensemble_diagnostics_table, +# model_summary_table, and print methods. # # DEPENDENCIES: # - rjags, bridgesampling: For tests using pre-fitted models @@ -15,16 +16,17 @@ # - skip_if_not_installed("rjags"), skip_if_not_installed("bridgesampling") # # MODELS/FIXTURES: -# - fit_summary*, fit_simple_normal, fit_simple_spike +# - fit_summary*, fit_simple_normal, fit_simple_spike, fit_orthonormal_* # -# TAGS: @evaluation, @edge-cases, @summary-tables +# TAGS: @evaluation, @summary-tables # ============================================================================ # -REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables-edge-cases") +REFERENCE_DIR <<- testthat::test_path("..", "results", "summary-tables") source(testthat::test_path("common-functions.R")) + # ============================================================================ # -# SECTION 1: ensemble_estimates_table edge cases +# SECTION 1: ensemble_estimates_table tests # ============================================================================ # test_that("ensemble_estimates_table handles matrix posteriors", { @@ -44,7 +46,6 @@ test_that("ensemble_estimates_table handles matrix posteriors", { list(fit = fit_summary1, marglik = marglik_summary1, prior_weights = 1) ) - mixed_posteriors <- mix_posteriors( model_list = models, parameters = c("m", "omega"), @@ -170,7 +171,7 @@ test_that("ensemble_estimates_table handles formula posteriors", { # ============================================================================ # -# SECTION 2: ensemble_inference_table edge cases +# SECTION 2: ensemble_inference_table tests # ============================================================================ # test_that("ensemble_inference_table handles multiple parameters", { @@ -215,7 +216,7 @@ test_that("ensemble_inference_table handles multiple parameters", { # ============================================================================ # -# SECTION 3: ensemble_summary_table and ensemble_diagnostics_table +# SECTION 3: ensemble_summary_table and ensemble_diagnostics_table tests # ============================================================================ # test_that("ensemble_summary_table handles different model configurations", { @@ -248,7 +249,7 @@ test_that("ensemble_summary_table handles different model configurations", { summary_table_bf <- ensemble_summary_table(models, c("m", "s"), logBF = TRUE, BF01 = TRUE) test_reference_table(summary_table_bf, "ensemble_summary_bf_options.txt") - # Test with remove_spike_0 (should remove 'm' which has spike at zero in fit_simple_spike) + # Test with remove_spike_0 summary_table_no_spike <- ensemble_summary_table(models, c("m", "s"), remove_spike_0 = FALSE) test_reference_table(summary_table_no_spike, "ensemble_summary_no_spike.txt") @@ -316,7 +317,7 @@ test_that("ensemble_diagnostics_table handles different configurations", { # ============================================================================ # -# SECTION 4: marginal_estimates_table edge cases +# SECTION 4: marginal_estimates_table tests # ============================================================================ # test_that("marginal_estimates_table handles various inputs", { @@ -324,7 +325,7 @@ test_that("marginal_estimates_table handles various inputs", { skip_on_cran() # Create sample data for marginal inference testing - set.seed(1) # Ensure reproducibility + set.seed(1) samples <- list( mu = rnorm(1000, 0, 1) ) @@ -373,7 +374,7 @@ test_that("marginal_estimates_table handles various inputs", { # ============================================================================ # -# SECTION 7: model_summary_table tests +# SECTION 5: model_summary_table tests # ============================================================================ # test_that("model_summary_table handles various configurations", { @@ -409,9 +410,8 @@ test_that("model_summary_table handles various configurations", { }) - # ============================================================================ # -# SECTION 9: update.BayesTools_table tests +# SECTION 6: update.BayesTools_table tests # ============================================================================ # test_that("update.BayesTools_table works correctly", { @@ -461,4 +461,3 @@ test_that("update.BayesTools_table works correctly", { test_reference_table(updated_bf01, "update_table_BF01.txt") }) - From dfa28c30336d1414a2ebaad8786949ef9ade434a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Fri, 26 Dec 2025 14:00:40 +0100 Subject: [PATCH 16/38] Add support for default priors in JAGS_formula() JAGS_formula() now supports '__default_factor' and '__default_continuous' entries in prior_list, allowing users to specify default priors for factor and continuous predictors not explicitly listed. Documentation and examples were updated, and comprehensive unit tests were added to verify correct behavior and error handling. --- .github/copilot-instructions.md | 11 ++- NEWS.md | 1 + R/JAGS-formula.R | 58 +++++++++++++-- man/JAGS_formula.Rd | 26 ++++++- tests/testthat/test-JAGS-formula.R | 116 +++++++++++++++++++++++++++++ 5 files changed, 204 insertions(+), 8 deletions(-) diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index eeddf05..d621647 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -36,7 +36,7 @@ BayesTools is an R package for Bayesian analyses, JAGS model automation, and Bay ### Build & Test - **Install**: `devtools::install()` (Timeout: 5m+) -- **Test**: `devtools::test()` (Timeout: 30m+) +- **Test**: `devtools::test()` (Timeout: 5m+) - **Targeted Test**: `devtools::test(filter = 'priors')` (Recommended for dev) - **Check**: `rcmdcheck::rcmdcheck(args = c('--no-manual', '--as-cran'), error_on = 'never')` - **Docs**: `devtools::document()` @@ -58,4 +58,11 @@ BayesTools is an R package for Bayesian analyses, JAGS model automation, and Bay ### Modifying JAGS Fitting 1. Edit `R/JAGS-fit.R` for general fitting logic or `R/JAGS-formula.R` for formula handling. 2. Verify with `devtools::test(filter = 'JAGS')`. -3. Ensure backward compatibility with `runjags` objects. +3. Ensure backward compatibility with `runjags` objects. + +## Feature Addition Steps +1. Create unit tests verifying the desired behavior. +2. Implement the feature. +3. Verify the tests pass. +4. Update documentation as needed. +5. Update NEWS.md with a summary of changes. \ No newline at end of file diff --git a/NEWS.md b/NEWS.md index 31fe3fd..242287d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # version 0.2.24 ### Features - major refactoring and speed-up of unit tests +- adds support for `__default_factor` and `__default_continuous` priors in `JAGS_formula()` - when specified in the `prior_list`, these are used as default priors for factor and continuous predictors that are not explicitly specified ### Fixes - fixes incorrect ordering the printed mixture priors diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 5a7b6db..697c1f2 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -12,13 +12,26 @@ #' @param prior_list named list of prior distribution of parameters specified within #' the \code{formula}. When using \code{-1} in the formula, an "intercept" prior #' can be explicitly specified; otherwise, \code{prior("spike", list(0))} is -#' automatically added. +#' automatically added. The list can also include two special entries: +#' \describe{ +#' \item{\code{"__default_continuous"}}{A prior to use for any continuous predictors +#' (including the intercept) that are not explicitly specified in the prior list.} +#' \item{\code{"__default_factor"}}{A prior to use for any factor predictors +#' (including interactions involving factors) that are not explicitly specified +#' in the prior list.} +#' } +#' These default priors allow for more concise specification when many predictors +#' share the same prior distribution. #' #' @details When a formula with \code{-1} (no intercept) is specified, the #' function automatically removes the \code{-1}, adds an intercept back to the #' formula, and includes a spike(0) prior for the intercept to ensure equivalent #' model behavior while maintaining consistent formula parsing. #' +#' When using default priors (\code{"__default_continuous"} or \code{"__default_factor"}), +#' explicitly specified priors for individual terms take precedence over the defaults. +#' The defaults are only applied to terms that are not already in the prior list. +#' #' @examples #' # simulate data #' set.seed(1) @@ -53,6 +66,17 @@ #' parameter = "mu", data = df, prior_list = prior_list_no_intercept) #' # Equivalent to specifying intercept = prior("spike", list(0)) #' +#' # using default priors for simpler specification +#' prior_list_defaults <- list( +#' "__default_continuous" = prior("normal", list(0, 1)), +#' "__default_factor" = prior_factor("normal", list(0, 0.5), contrast = "treatment") +#' ) +#' formula_defaults <- JAGS_formula( +#' formula = ~ x_cont + x_fac3, +#' parameter = "mu", data = df, prior_list = prior_list_defaults) +#' # intercept and x_cont get the default continuous prior +#' # x_fac3 gets the default factor prior +#' #' @return \code{JAGS_formula} returns a list containing the formula JAGS syntax, #' JAGS data object, and modified prior_list. #' @@ -126,6 +150,30 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ # remove the random effects specific priors from the prior list prior_list <- prior_list[.get_grouping_factor(names(prior_list)) == ""] } + + # handle default priors: __default_factor and __default_continuous + default_factor_prior <- prior_list[["__default_factor"]] + default_continuous_prior <- prior_list[["__default_continuous"]] + has_defaults <- !is.null(default_factor_prior) || !is.null(default_continuous_prior) + + # remove default priors from prior_list before validation + prior_list[["__default_factor"]] <- NULL + prior_list[["__default_continuous"]] <- NULL + + # fill in missing priors with defaults based on term type + if(has_defaults){ + for(term in model_terms){ + if(!term %in% names(prior_list)){ + term_type <- model_terms_type[[term]] + if(term_type == "factor" && !is.null(default_factor_prior)){ + prior_list[[term]] <- default_factor_prior + }else if(term_type == "continuous" && !is.null(default_continuous_prior)){ + prior_list[[term]] <- default_continuous_prior + } + } + } + } + # check that all predictors have a prior distribution check_list(prior_list, "prior_list", check_names = model_terms, allow_other = FALSE, all_objects = TRUE) @@ -171,11 +219,11 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ # check whether intercept is unique parameter if(sum(grepl("intercept", names(prior_list))) > 1) stop("only the intercept parameter can contain 'intercept' in its name.") - # check whether any reserved term is in usage - reserved_terms <- c("__xXx__", "__xREx__", "xRE_PRECx", "xRE_CORx", "xRE_Zx", "xRE_STDx", "xRE_COEFx", "xRE_MAPx", "xRE_COEFx", "xRE_DATAx") + # check whether any reserved term is in usage (note: __default_factor/__default_continuous are reserved but already removed from prior_list) + reserved_terms <- c("__xXx__", "__xREx__", "xRE_PRECx", "xRE_CORx", "xRE_Zx", "xRE_STDx", "xRE_COEFx", "xRE_MAPx", "xRE_COEFx", "xRE_DATAx", "__default_factor", "__default_continuous") for(reserved_term in reserved_terms){ - if(any(grepl(reserved_term, names(prior_list)))) - stop(paste0("'", reserved_term, "' string is internally used by the BayesTools package and can't be used for naming variables or prior distributions.")) + if(any(grepl(reserved_term, colnames(data)))) + stop(paste0("'", reserved_term, "' string is internally used by the BayesTools package and can't be used for naming variables.")) } diff --git a/man/JAGS_formula.Rd b/man/JAGS_formula.Rd index e0dfe2d..c020cb2 100644 --- a/man/JAGS_formula.Rd +++ b/man/JAGS_formula.Rd @@ -18,7 +18,16 @@ automatically converted to include an intercept with a spike(0) prior.} \item{prior_list}{named list of prior distribution of parameters specified within the \code{formula}. When using \code{-1} in the formula, an "intercept" prior can be explicitly specified; otherwise, \code{prior("spike", list(0))} is -automatically added.} +automatically added. The list can also include two special entries: +\describe{ +\item{\code{"__default_continuous"}}{A prior to use for any continuous predictors +(including the intercept) that are not explicitly specified in the prior list.} +\item{\code{"__default_factor"}}{A prior to use for any factor predictors +(including interactions involving factors) that are not explicitly specified +in the prior list.} +} +These default priors allow for more concise specification when many predictors +share the same prior distribution.} } \value{ \code{JAGS_formula} returns a list containing the formula JAGS syntax, @@ -34,6 +43,10 @@ When a formula with \code{-1} (no intercept) is specified, the function automatically removes the \code{-1}, adds an intercept back to the formula, and includes a spike(0) prior for the intercept to ensure equivalent model behavior while maintaining consistent formula parsing. + +When using default priors (\code{"__default_continuous"} or \code{"__default_factor"}), +explicitly specified priors for individual terms take precedence over the defaults. +The defaults are only applied to terms that are not already in the prior list. } \examples{ # simulate data @@ -69,6 +82,17 @@ formula_no_intercept <- JAGS_formula( parameter = "mu", data = df, prior_list = prior_list_no_intercept) # Equivalent to specifying intercept = prior("spike", list(0)) +# using default priors for simpler specification +prior_list_defaults <- list( + "__default_continuous" = prior("normal", list(0, 1)), + "__default_factor" = prior_factor("normal", list(0, 0.5), contrast = "treatment") +) +formula_defaults <- JAGS_formula( + formula = ~ x_cont + x_fac3, + parameter = "mu", data = df, prior_list = prior_list_defaults) +# intercept and x_cont get the default continuous prior +# x_fac3 gets the default factor prior + } \seealso{ \code{\link[=JAGS_fit]{JAGS_fit()}} diff --git a/tests/testthat/test-JAGS-formula.R b/tests/testthat/test-JAGS-formula.R index e20adf4..806211b 100644 --- a/tests/testthat/test-JAGS-formula.R +++ b/tests/testthat/test-JAGS-formula.R @@ -349,3 +349,119 @@ test_that("-1 (no intercept) formula handling works correctly", { expect_equal(.add_intercept_to_formula(~ 0), ~ 1, ignore_formula_env = TRUE) }) + +test_that("Default priors (__default_factor and __default_continuous) work correctly", { + + # setup test data + set.seed(1) + df_test <- data.frame( + x_cont1 = rnorm(60), + x_cont2 = rnorm(60), + x_fac3 = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), + x_fac2 = factor(rep(c("X", "Y"), 30), levels = c("X", "Y")) + ) + + # Test 1: Only __default_continuous - applies to intercept and continuous predictors + prior_list_cont_default <- list( + "__default_continuous" = prior("normal", list(0, 1)) + ) + result1 <- JAGS_formula(~ x_cont1 + x_cont2, parameter = "mu", + data = df_test, prior_list = prior_list_cont_default) + + # Check that intercept and both continuous predictors got the default prior + expect_true("mu_intercept" %in% names(result1$prior_list)) + expect_true("mu_x_cont1" %in% names(result1$prior_list)) + expect_true("mu_x_cont2" %in% names(result1$prior_list)) + expect_equal(result1$prior_list$mu_intercept$distribution, "normal") + expect_equal(result1$prior_list$mu_x_cont1$distribution, "normal") + expect_equal(result1$prior_list$mu_x_cont2$distribution, "normal") + + # Test 2: Only __default_factor - continuous predictors must still be specified + prior_list_fac_default <- list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("cauchy", list(0, 1)), + "__default_factor" = prior_factor("normal", list(0, 0.5), contrast = "treatment") + ) + result2 <- JAGS_formula(~ x_cont1 + x_fac3 + x_fac2, parameter = "mu", + data = df_test, prior_list = prior_list_fac_default) + + # Check that factors got the default prior + expect_true("mu_x_fac3" %in% names(result2$prior_list)) + expect_true("mu_x_fac2" %in% names(result2$prior_list)) + expect_equal(result2$prior_list$mu_x_fac3$distribution, "normal") + expect_equal(result2$prior_list$mu_x_fac2$distribution, "normal") + # Check that explicit priors are preserved + expect_equal(result2$prior_list$mu_intercept$distribution, "normal") + expect_equal(result2$prior_list$mu_intercept$parameters$mean, 0) + expect_equal(result2$prior_list$mu_intercept$parameters$sd, 5) + expect_equal(result2$prior_list$mu_x_cont1$distribution, "t") # cauchy is internally stored as t + + # Test 3: Both defaults - all terms get assigned correctly + prior_list_both_defaults <- list( + "__default_continuous" = prior("normal", list(0, 2)), + "__default_factor" = prior_factor("normal", list(0, 1), contrast = "treatment") + ) + result3 <- JAGS_formula(~ x_cont1 + x_fac3, parameter = "mu", + data = df_test, prior_list = prior_list_both_defaults) + + expect_equal(result3$prior_list$mu_intercept$distribution, "normal") + expect_equal(result3$prior_list$mu_intercept$parameters$sd, 2) # from continuous default + expect_equal(result3$prior_list$mu_x_cont1$parameters$sd, 2) # from continuous default + expect_equal(result3$prior_list$mu_x_fac3$parameters$sd, 1) # from factor default + + # Test 4: Explicit priors override defaults + prior_list_override <- list( + "intercept" = prior("cauchy", list(0, 10)), # explicit override + "__default_continuous" = prior("normal", list(0, 1)), + "__default_factor" = prior_factor("normal", list(0, 0.5), contrast = "treatment"), + "x_fac3" = prior_factor("mnormal", list(0, 2), contrast = "orthonormal") # explicit override + ) + result4 <- JAGS_formula(~ x_cont1 + x_fac3 + x_fac2, parameter = "mu", + data = df_test, prior_list = prior_list_override) + + # Explicit priors should be used + expect_equal(result4$prior_list$mu_intercept$distribution, "t") # cauchy is internally stored as t + expect_equal(result4$prior_list$mu_x_fac3$distribution, "mnormal") + expect_equal(result4$prior_list$mu_x_fac3$parameters$sd, 2) + # Default priors for non-specified terms + expect_equal(result4$prior_list$mu_x_cont1$distribution, "normal") + expect_equal(result4$prior_list$mu_x_fac2$distribution, "normal") + expect_equal(result4$prior_list$mu_x_fac2$parameters$sd, 0.5) + + # Test 5: Interactions use factor default when they involve factors + prior_list_interaction <- list( + "__default_continuous" = prior("normal", list(0, 1)), + "__default_factor" = prior_factor("mnormal", list(0, 0.5), contrast = "orthonormal") + ) + result5 <- JAGS_formula(~ x_cont1 * x_fac3, parameter = "mu", + data = df_test, prior_list = prior_list_interaction) + + # x_cont1:x_fac3 interaction involves a factor, so should get factor default + expect_true("mu_x_cont1__xXx__x_fac3" %in% names(result5$prior_list)) + expect_equal(result5$prior_list[["mu_x_cont1__xXx__x_fac3"]]$distribution, "mnormal") + + # Test 6: Error when term is missing and no appropriate default + prior_list_missing <- list( + "__default_continuous" = prior("normal", list(0, 1)) + # no __default_factor, and x_fac3 not specified + ) + expect_error( + JAGS_formula(~ x_cont1 + x_fac3, parameter = "mu", + data = df_test, prior_list = prior_list_missing), + "missing" + ) + + # Test 7: Reserved names cannot be used as variable names in data + df_bad <- data.frame( + `__default_factor` = rnorm(10), + x = rnorm(10), + check.names = FALSE + ) + expect_error( + JAGS_formula(~ x, parameter = "mu", data = df_bad, + prior_list = list("intercept" = prior("normal", list(0, 1)), + "x" = prior("normal", list(0, 1)))), + "__default_factor" + ) + +}) From a07390b09172e8c6f78b43e33ddd4c405898f2ef Mon Sep 17 00:00:00 2001 From: Copilot <198982749+Copilot@users.noreply.github.com> Date: Mon, 29 Dec 2025 16:41:20 +0100 Subject: [PATCH 17/38] Add automatic standardization of continuous predictors in JAGS_formula (#57) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Initial plan * Implement automatic standardization of continuous predictors - Add formula_scale parameter to JAGS_formula function - Implement standardization logic for continuous predictors - Store mean and SD for back-transformation - Propagate formula_scale through JAGS_fit - Add transform_scale_samples function for posterior transformation - Add comprehensive tests for standardization Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Update NEWS.md with standardization feature documentation Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Improve unit tests for standardization feature - Add scaled version of interaction model to test-00-model-fits.R - Replace simple JAGS fitting test with comparison tests using pre-fitted models - Add visual comparison tests using vdiffr for manual assessment - Tests compare unscaled vs scaled models and verify transform_scale_samples() - All tests pass successfully Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Refactor tests to compare manual vs automatic scaling - Replace scaled vs unscaled comparison with manual vs automatic scaling - Create data with large scale differences (mean=1000, sd=500 vs mean=0.5, sd=0.1) - Fit two models with same seed: manual scaling and automatic scaling - Tests verify both approaches produce equivalent results - Visual comparisons show manual and automatic scaling produce identical posteriors - Remove old snapshot files, create new ones for manual vs auto comparison Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * improve tests * Add scaling support to JAGS_evaluate_formula - Update JAGS_evaluate_formula to apply scaling when predictors were scaled during fitting - Check for formula_scale attribute in fit object - Automatically scale new data using stored mean/sd for each predictor - Add comprehensive tests comparing manual vs automatic scaling in predictions - Tests verify predictions match when using scaled data vs automatic scaling - All tests pass (119 total) Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * Add formula_scale_list support to JAGS_bridgesampling - Update JAGS_bridgesampling to accept formula_scale_list parameter - Pass formula_scale to JAGS_formula calls during marginal likelihood computation - Ensures marginal likelihoods match between manual and automatic scaling - Add test verifying marginal likelihoods are equivalent - Update documentation - All tests pass (120 total) Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> * improve tests * fix input * catch changes * push to PC * Preserve attributes when unscaling posterior samples Ensures that class and attributes of posterior samples are preserved after applying the unscaling transformation in update.BayesTools_table. Updates tests to check correct unscaling of coefficients in the presence of interaction terms, including proper handling of main effects and interactions. --------- Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com> Co-authored-by: FBartos <38475991+FBartos@users.noreply.github.com> Co-authored-by: František Bartoš --- NAMESPACE | 1 + NEWS.md | 3 + R/JAGS-fit.R | 26 +- R/JAGS-formula.R | 301 +++++- R/JAGS-marglik.R | 12 +- R/summary-tables.R | 123 ++- R/tools.R | 2 +- man/JAGS_bridgesampling.Rd | 1 + man/JAGS_fit.Rd | 6 + man/JAGS_formula.Rd | 12 +- man/transform_scale_samples.Rd | 34 + tests/testthat/test-00-model-fits.R | 86 ++ tests/testthat/test-JAGS-formula-scale.R | 1191 ++++++++++++++++++++++ 13 files changed, 1777 insertions(+), 21 deletions(-) create mode 100644 man/transform_scale_samples.Rd create mode 100644 tests/testthat/test-JAGS-formula-scale.R diff --git a/NAMESPACE b/NAMESPACE index 49028db..6ed65d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -163,6 +163,7 @@ export(stan_estimates_table) export(transform_factor_samples) export(transform_meandif_samples) export(transform_orthonormal_samples) +export(transform_scale_samples) export(var) export(weightfunctions_mapping) importFrom(Rdpack,reprompt) diff --git a/NEWS.md b/NEWS.md index 242287d..fbceea9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,10 +2,13 @@ ### Features - major refactoring and speed-up of unit tests - adds support for `__default_factor` and `__default_continuous` priors in `JAGS_formula()` - when specified in the `prior_list`, these are used as default priors for factor and continuous predictors that are not explicitly specified +- adds automatic standardization of continuous predictors via `formula_scale` parameter in `JAGS_formula()` and `JAGS_fit()` - improves MCMC sampling efficiency and numerical stability +- adds `transform_scale_samples()` function to transform posterior samples back to original scale after standardization ### Fixes - fixes incorrect ordering the printed mixture priors - fixes formula with no intercepts coded as `0` (instead of only `-1`) +- fixes bug in `.is.wholenumber` with NAs and `na.rm = TRUE` # version 0.2.23 ### Fixes diff --git a/R/JAGS-fit.R b/R/JAGS-fit.R index 8b1734b..66a534f 100644 --- a/R/JAGS-fit.R +++ b/R/JAGS-fit.R @@ -17,6 +17,10 @@ #' (names of the lists correspond to the parameter name created by each of the formula and #' the names of the prior distribution correspond to the parameter names) of parameters specified #' within the \code{formula} +#' @param formula_scale_list named list of named lists for standardizing continuous predictors +#' (names of the lists correspond to the parameter name created by each of the formula). +#' Each entry should be a named list where continuous predictors with \code{TRUE} values will +#' be standardized. Defaults to \code{NULL} (no standardization). #' @param chains number of chains to be run, defaults to \code{4} #' @param adapt number of samples used for adapting the MCMC chains, defaults to \code{500} #' @param burnin number of burnin iterations of the MCMC chains, defaults to \code{1000} @@ -90,7 +94,7 @@ NULL #' @rdname JAGS_fit -JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, +JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, formula_scale_list = NULL, chains = 4, adapt = 500, burnin = 1000, sample = 4000, thin = 1, autofit = FALSE, autofit_control = list(max_Rhat = 1.05, min_ESS = 500, max_error = 0.01, max_SD_error = 0.05, max_time = list(time = 60, unit = "mins"), sample_extend = 1000, restarts = 10, max_extend = 10), parallel = FALSE, cores = chains, silent = TRUE, seed = NULL, @@ -108,6 +112,7 @@ JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list check_list(formula_list, "formula_list", allow_NULL = TRUE) check_list(formula_data_list, "formula_data_list", check_names = names(formula_list), allow_other = FALSE, all_objects = TRUE, allow_NULL = is.null(formula_list)) check_list(formula_prior_list, "formula_prior_list", check_names = names(formula_list), allow_other = FALSE, all_objects = TRUE, allow_NULL = is.null(formula_list)) + check_list(formula_scale_list, "formula_scale_list", allow_NULL = TRUE) ### add formulas if(!is.null(formula_list)){ @@ -116,22 +121,30 @@ JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list formula_output <- list() for(parameter in names(formula_list)){ formula_output[[parameter]] <- JAGS_formula( - formula = formula_list[[parameter]], - parameter = parameter, - data = formula_data_list[[parameter]], - prior_list = formula_prior_list[[parameter]]) + formula = formula_list[[parameter]], + parameter = parameter, + data = formula_data_list[[parameter]], + prior_list = formula_prior_list[[parameter]], + formula_scale = if(!is.null(formula_scale_list)) formula_scale_list[[parameter]] else NULL) } # merge with the rest of the input prior_list <- c(do.call(c, unname(lapply(formula_output, function(output) output[["prior_list"]]))), prior_list) data <- c(do.call(c, unname(lapply(formula_output, function(output) output[["data"]]))), data) formula_syntax <- paste0(lapply(formula_output, function(output) output[["formula_syntax"]]), collapse = "") + + # collect formula_scale information + formula_scale_info <- lapply(formula_output, function(output) output[["formula_scale"]]) + formula_scale_info <- formula_scale_info[!sapply(formula_scale_info, is.null)] + if(length(formula_scale_info) == 0) formula_scale_info <- NULL # add the formula syntax to the model syntax opening_bracket <- regexpr("{", model_syntax, fixed = TRUE)[1] syntax_start <- substr(model_syntax, 1, opening_bracket) syntax_end <- substr(model_syntax, opening_bracket + 1, nchar(model_syntax)) model_syntax <- paste0(syntax_start, "\n", formula_syntax, "\n", syntax_end) + }else{ + formula_scale_info <- NULL } @@ -274,6 +287,9 @@ JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list attr(fit, "prior_list") <- prior_list attr(fit, "model_syntax") <- model_syntax attr(fit, "required_packages") <- required_packages + if(!is.null(formula_scale_info)){ + attr(fit, "formula_scale") <- do.call(c, unname(formula_scale_info)) + } class(fit) <- c(class(fit), "BayesTools_fit") diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 697c1f2..30e4505 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -13,6 +13,10 @@ #' the \code{formula}. When using \code{-1} in the formula, an "intercept" prior #' can be explicitly specified; otherwise, \code{prior("spike", list(0))} is #' automatically added. The list can also include two special entries: +#' @param formula_scale named list specifying whether to standardize continuous predictors. +#' If \code{NULL} (default), no standardization is applied. If a named list is provided, +#' continuous predictors with \code{TRUE} values will be standardized (mean-centered and +#' scaled by standard deviation). The intercept is never standardized. #' \describe{ #' \item{\code{"__default_continuous"}}{A prior to use for any continuous predictors #' (including the intercept) that are not explicitly specified in the prior list.} @@ -78,11 +82,12 @@ #' # x_fac3 gets the default factor prior #' #' @return \code{JAGS_formula} returns a list containing the formula JAGS syntax, -#' JAGS data object, and modified prior_list. +#' JAGS data object, modified prior_list, and (if standardization was applied) a +#' \code{formula_scale} list with standardization information for back-transformation. #' #' @seealso [JAGS_fit()] #' @export -JAGS_formula <- function(formula, parameter, data, prior_list){ +JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = NULL){ if(!is.language(formula)) stop("'formula' must be a formula") @@ -92,6 +97,10 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ check_list(prior_list, "prior_list") if(any(!sapply(prior_list, is.prior))) stop("'prior_list' must be a list of priors.") + # formula_scale can be TRUE/FALSE (apply to all) or a named list + if(!is.null(formula_scale) && !is.logical(formula_scale) && !is.list(formula_scale)){ + stop("'formula_scale' must be NULL, TRUE, FALSE, or a named list") + } # remove the specified response @@ -210,6 +219,32 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ stop(paste0("Unsupported prior distribution defined for '", continuous, "' continuous variable. See '?prior' for details.")) } } + + # standardize continuous predictors if requested + scale_info <- list() + if(!is.null(formula_scale)){ + for(continuous in names(predictors_type[predictors_type == "continuous"])){ + # determine if this predictor should be scaled + should_scale <- FALSE + if(is.logical(formula_scale) && length(formula_scale) == 1){ + # formula_scale = TRUE/FALSE applies to all continuous predictors + should_scale <- isTRUE(formula_scale) + }else if(is.list(formula_scale) && !is.null(formula_scale[[continuous]])){ + # named list: check specific predictor + should_scale <- isTRUE(formula_scale[[continuous]]) + } + + if(should_scale){ + # store original mean and sd + scale_info[[continuous]] <- list( + mean = mean(data[, continuous], na.rm = TRUE), + sd = stats::sd(data[, continuous], na.rm = TRUE) + ) + # standardize the predictor + data[, continuous] <- (data[, continuous] - scale_info[[continuous]]$mean) / scale_info[[continuous]]$sd + } + } + } } # get the default design matrix @@ -356,12 +391,23 @@ JAGS_formula <- function(formula, parameter, data, prior_list){ attr(prior_list[[i]], "parameter") <- parameter } - return(list( + output <- list( formula_syntax = formula_syntax, data = JAGS_data, prior_list = prior_list, formula = formula - )) + ) + + # add scale information if standardization was applied + if(exists("scale_info") && length(scale_info) > 0){ + # add parameter prefix to scale_info names for consistency + names(scale_info) <- paste0(parameter, "_", names(scale_info)) + # store the parameter prefix as an attribute for later retrieval + attr(scale_info, "parameter") <- parameter + output$formula_scale <- scale_info + } + + return(output) } .JAGS_random_effect_formula <- function(formula, parameter, data, prior_list){ @@ -900,6 +946,20 @@ JAGS_evaluate_formula <- function(fit, formula, parameter, data, prior_list){ stop(paste0("Unsupported prior distribution defined for '", continuous, "' continuous variable. See '?prior' for details.")) } } + + # apply scaling if predictors were scaled during model fitting + formula_scale <- attr(fit, "formula_scale") + if(!is.null(formula_scale)){ + for(continuous in names(predictors_type[predictors_type == "continuous"])){ + # check if this predictor was scaled (with parameter prefix) + scaled_name <- paste0(parameter, "_", continuous) + if(scaled_name %in% names(formula_scale)){ + # apply the same scaling transformation + scale_info <- formula_scale[[scaled_name]] + data[, continuous] <- (data[, continuous] - scale_info$mean) / scale_info$sd + } + } + } } # get the design matrix @@ -1120,6 +1180,239 @@ transform_treatment_samples <- function(samples){ } +# Helper: Parse a term name into its component variable names +# e.g., "mu_x1__xXx__x2" with prefix "mu" -> c("x1", "x2") +# e.g., "mu_intercept" -> character(0) (intercept has no components) +# e.g., "mu_x1" -> c("x1") +.parse_term_components <- function(term_name, prefix) { + # Remove prefix + term_part <- sub(paste0("^", prefix, "_"), "", term_name) + + # Check if it's the intercept + if (term_part == "intercept") { + return(character(0)) + } + + # Split by interaction separator + components <- strsplit(term_part, "__xXx__")[[1]] + return(components) +} + + +# Helper: Check if set A is a subset of set B (including equality) +.is_subset <- function(A, B) { + + length(A) == 0 || all(A %in% B) +} + + +# Helper: Build the transformation matrix for unscaling coefficients +# +# For each target term T and source term S, computes the coefficient M[T,S] such that: +# coef_orig[T] = sum over S of M[T,S] * coef_z[S] +# +# The formula is based on expanding products of (x_i - mu_i)/sigma_i terms. +# For S to contribute to T: +# 1. T_unscaled == S_unscaled (unscaled components must match exactly) +# 2. T_scaled ⊆ S_scaled (T's scaled components are a subset of S's) +# +# The contribution is: (-1)^|extra| * prod(mu_extra) / prod(sigma_S_scaled) +# where extra = S_scaled \ T_scaled +# +# @param term_names Character vector of all term names in the posterior +# @param formula_scale Named list with scaling info (mean, sd) for scaled predictors +# @param prefix The parameter prefix (e.g., "mu") +# @return A square transformation matrix +.build_unscale_matrix <- function(term_names, formula_scale, prefix) { + + n_terms <- length(term_names) + M <- diag(n_terms) # Start with identity matrix + rownames(M) <- colnames(M) <- term_names + + # Extract the variable names that are scaled (without prefix) + scaled_vars <- sub(paste0("^", prefix, "_"), "", names(formula_scale)) + + # Parse all terms into their components + term_components <- lapply(term_names, .parse_term_components, prefix = prefix) + names(term_components) <- term_names + + # For each term, identify scaled vs unscaled components + term_scaled <- lapply(term_components, function(comps) comps[comps %in% scaled_vars]) + term_unscaled <- lapply(term_components, function(comps) comps[!comps %in% scaled_vars]) + + # Warn about high-order interactions + max_order <- max(sapply(term_components, length)) + if (max_order >= 5) { + warning("Model contains ", max_order, "-way or higher interactions. ", + "Unscaling transformation may be computationally intensive.", + immediate. = TRUE) + } + + # Build the transformation matrix + for (t_idx in seq_along(term_names)) { + T_name <- term_names[t_idx] + T_scaled <- term_scaled[[T_name]] + T_unscaled <- term_unscaled[[T_name]] + + for (s_idx in seq_along(term_names)) { + S_name <- term_names[s_idx] + S_scaled <- term_scaled[[S_name]] + S_unscaled <- term_unscaled[[S_name]] + + # Check contribution conditions + # 1. Unscaled parts must match exactly + if (!setequal(T_unscaled, S_unscaled)) next + + # 2. T_scaled must be a subset of S_scaled + if (!.is_subset(T_scaled, S_scaled)) next + + # 3. S must have at least one scaled component (otherwise no transformation needed) + if (length(S_scaled) == 0) { + # No scaling for this source term - keep identity (already set) + next + } + + # Compute the coefficient + extra_scaled <- setdiff(S_scaled, T_scaled) + + # Sign: (-1)^|extra| + sign <- (-1)^length(extra_scaled) + + # Product of means for extra scaled components + if (length(extra_scaled) > 0) { + extra_params <- paste0(prefix, "_", extra_scaled) + mean_product <- prod(sapply(extra_params, function(p) formula_scale[[p]]$mean)) + } else { + mean_product <- 1 + } + + # Product of SDs for all scaled components in S + S_scaled_params <- paste0(prefix, "_", S_scaled) + sd_product <- prod(sapply(S_scaled_params, function(p) formula_scale[[p]]$sd)) + + # Contribution coefficient + M[t_idx, s_idx] <- sign * mean_product / sd_product + } + } + + return(M) +} + + +# Helper: Apply unscaling transformation to a matrix of posterior samples +# +# @param posterior Matrix with samples in rows, parameters in columns +# @param formula_scale Named list with scaling info +# @param prefix Parameter prefix (default: auto-detect from formula_scale names) +# @return Transformed posterior matrix +.apply_unscale_transform <- function(posterior, formula_scale, prefix = NULL) { + + if (is.null(formula_scale) || length(formula_scale) == 0) { + return(posterior) + } + + # Auto-detect prefix if not provided + if (is.null(prefix)) { + # First try the parameter attribute + prefix <- attr(formula_scale, "parameter") + # Fallback: parse from names + if (is.null(prefix) && length(names(formula_scale)) > 0) { + first_name <- names(formula_scale)[1] + # Extract prefix from "mu_x1" -> "mu" + prefix <- sub("_.*$", "", first_name) + } + } + + if (is.null(prefix)) { + warning("Could not detect parameter prefix from formula_scale. Returning unchanged.") + return(posterior) + } + + # Identify which columns are affected by the transformation + # (have the same prefix and either are scaled or contain scaled components) + affected_cols <- grep(paste0("^", prefix, "_"), colnames(posterior), value = TRUE) + + if (length(affected_cols) == 0) { + return(posterior) + } + + # Build transformation matrix for affected columns + M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) + + # Apply transformation: posterior_new[, affected] = posterior[, affected] %*% t(M) + # Since M[T, S] gives the coefficient of S in the expression for T, + # we want: new_T = sum_S M[T,S] * old_S + # In matrix form: new = old %*% t(M) would give new[i, T] = sum_S old[i, S] * M[T, S] + # But that's transposed... Let me reconsider. + # + # We have: coef_orig = M %*% coef_z (for a single sample as column vector) + # For posterior matrix with samples in rows: posterior_orig = posterior_z %*% t(M) + + posterior[, affected_cols] <- posterior[, affected_cols, drop = FALSE] %*% t(M) + + return(posterior) +} + + +#' @title Transform standardized posterior samples back to original scale +#' +#' @description Transforms posterior samples from standardized continuous +#' predictors back to the original scale. This function is used when predictors +#' were standardized during model fitting via the \code{formula_scale} parameter. +#' +#' @param fit a fitted model object with \code{formula_scale} attribute, or +#' a matrix of posterior samples +#' @param formula_scale named list containing standardization information +#' (mean and sd) for each standardized predictor. If \code{fit} is provided +#' and has a \code{formula_scale} attribute, this will be used automatically. +#' +#' @details The function transforms regression coefficients and intercepts +#' to account for predictor standardization using a combinatorial approach that +#' correctly handles interactions of any order. +#' +#' For a k-way interaction between standardized predictors, the expansion of +#' \eqn{\prod_{i} (x_i - \mu_i)/\sigma_i} contributes to all lower-order terms. +#' The contribution to a target term T from a source term S (where T is a subset +#' of S's scaled components) is: +#' \deqn{(-1)^{|extra|} \cdot \prod_{i \in extra} \mu_i / \prod_{i \in S_{scaled}} \sigma_i} +#' where \eqn{extra = S_{scaled} \setminus T_{scaled}}. +#' +#' @return \code{transform_scale_samples} returns posterior samples transformed +#' back to the original predictor scale. +#' +#' @seealso [JAGS_formula()] [JAGS_fit()] +#' +#' @export +transform_scale_samples <- function(fit, formula_scale = NULL){ + + # extract formula_scale from fit if available + if(is.null(formula_scale) && !is.null(attr(fit, "formula_scale"))){ + formula_scale <- attr(fit, "formula_scale") + } + + if(is.null(formula_scale) || length(formula_scale) == 0){ + # no scaling information, return as is + return(fit) + } + + check_list(formula_scale, "formula_scale") + + # extract posterior samples + if(inherits(fit, "runjags") || inherits(fit, "BayesTools_fit")){ + posterior <- as.matrix(.fit_to_posterior(fit)) + }else if(is.matrix(fit)){ + posterior <- fit + }else{ + stop("'fit' must be a fitted model object or a matrix of posterior samples.") + } + + # Apply the combinatorial unscaling transformation + posterior <- .apply_unscale_transform(posterior, formula_scale) + + return(posterior) +} + + #' @title BayesTools Contrast Matrices #' #' @description BayesTools provides several contrast matrix functions for Bayesian factor analysis. diff --git a/R/JAGS-marglik.R b/R/JAGS-marglik.R index d6447e8..97a5bfc 100644 --- a/R/JAGS-marglik.R +++ b/R/JAGS-marglik.R @@ -70,7 +70,7 @@ #' @return \code{JAGS_bridgesampling} returns an object of class 'bridge'. #' #' @export -JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NULL, formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, +JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NULL, formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, formula_scale_list = NULL, add_parameters = NULL, add_bounds = NULL, maxiter = 10000, silent = TRUE, ...){ @@ -80,6 +80,7 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU check_list(formula_list, "formula_list", allow_NULL = TRUE) check_list(formula_data_list, "formula_data_list", check_names = names(formula_list), allow_other = FALSE, all_objects = TRUE, allow_NULL = is.null(formula_list)) check_list(formula_prior_list, "formula_prior_list", check_names = names(formula_list), allow_other = FALSE, all_objects = TRUE, allow_NULL = is.null(formula_list)) + check_list(formula_scale_list, "formula_scale_list", allow_NULL = TRUE) # extract the posterior distribution @@ -92,10 +93,11 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU formula_output <- list() for(parameter in names(formula_list)){ formula_output[[parameter]] <- JAGS_formula( - formula = formula_list[[parameter]], - parameter = parameter, - data = formula_data_list[[parameter]], - prior_list = formula_prior_list[[parameter]]) + formula = formula_list[[parameter]], + parameter = parameter, + data = formula_data_list[[parameter]], + prior_list = formula_prior_list[[parameter]], + formula_scale = if(!is.null(formula_scale_list)) formula_scale_list[[parameter]] else NULL) } # merge with the rest of the input diff --git a/R/summary-tables.R b/R/summary-tables.R index 71d95fe..85f9247 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -34,6 +34,14 @@ #' @param transform_orthonormal (to be depreciated) whether factors #' with orthonormal prior distributions should be transformed to #' differences from the grand mean +#' @param transform_scaled whether coefficients from standardized +#' continuous predictors should be transformed back to the original +#' scale. Defaults to \code{FALSE}. +#' @param formula_scale named list containing standardization information +#' (mean and sd) for each standardized predictor. Required when +#' \code{transform_scaled = TRUE} for ensemble/marginal tables. For +#' \code{runjags_estimates_table}, this is automatically extracted from +#' the fit object's \code{formula_scale} attribute. #' @param title title to be added to the table #' @param footnotes footnotes to be added to the table #' @param warnings warnings to be added to the table @@ -65,7 +73,7 @@ NULL #' @rdname BayesTools_ensemble_tables -ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.95), title = NULL, footnotes = NULL, warnings = NULL, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE){ +ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.95), title = NULL, footnotes = NULL, warnings = NULL, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, transform_scaled = FALSE, formula_scale = NULL){ # check input check_char(parameters, "parameters", check_length = 0) @@ -77,6 +85,8 @@ ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.95) check_bool(transform_factors, "transform_factors") check_bool(transform_orthonormal, "transform_orthonormal") check_bool(formula_prefix, "formula_prefix") + check_bool(transform_scaled, "transform_scaled") + check_list(formula_scale, "formula_scale", allow_NULL = TRUE) # depreciate transform_factors <- .depreciate.transform_orthonormal(transform_orthonormal, transform_factors) @@ -87,6 +97,11 @@ ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.95) samples <- transform_factor_samples(samples) } + # transform scaled coefficients back to original scale + if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){ + samples <- .transform_scale_samples_list(samples, formula_scale) + } + # extract values estimates_table <- NULL @@ -412,7 +427,7 @@ ensemble_diagnostics_empty_table <- function(title = NULL, footnotes = NULL, war } #' @rdname BayesTools_ensemble_tables -marginal_estimates_table <- function(samples, inference, parameters, probs = c(0.025, 0.95), logBF = FALSE, BF01 = FALSE, title = NULL, footnotes = NULL, warnings = NULL, formula_prefix = TRUE){ +marginal_estimates_table <- function(samples, inference, parameters, probs = c(0.025, 0.95), logBF = FALSE, BF01 = FALSE, title = NULL, footnotes = NULL, warnings = NULL, formula_prefix = TRUE, transform_scaled = FALSE, formula_scale = NULL){ # check input check_char(parameters, "parameters", check_length = 0) @@ -425,6 +440,13 @@ marginal_estimates_table <- function(samples, inference, parameters, probs = c(0 check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE) check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE) check_bool(formula_prefix, "formula_prefix") + check_bool(transform_scaled, "transform_scaled") + check_list(formula_scale, "formula_scale", allow_NULL = TRUE) + + # transform scaled coefficients back to original scale + if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){ + samples <- .transform_scale_samples_list(samples, formula_scale) + } # extract values @@ -713,7 +735,7 @@ model_summary_table <- function(model, model_description = NULL, title = NULL, f #' @rdname BayesTools_model_tables runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, footnotes = NULL, warnings = NULL, conditional = FALSE, remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, - return_samples = FALSE){ + return_samples = FALSE, transform_scaled = FALSE){ .check_runjags() # most of the code is shared with .diagnostics_plot_data function (keep them in sync on update) @@ -738,6 +760,7 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, check_bool(transform_factors, "transform_factors") check_bool(transform_orthonormal, "transform_orthonormal") check_bool(formula_prefix, "formula_prefix") + check_bool(transform_scaled, "transform_scaled") check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0) # depreciate @@ -972,6 +995,14 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, # rename factor levels model_samples <- .rename_factor_levels(model_samples, prior_list) + # transform scaled coefficients back to original scale + if(transform_scaled){ + formula_scale <- attr(fit, "formula_scale") + if(!is.null(formula_scale) && length(formula_scale) > 0){ + model_samples <- transform_scale_samples(model_samples, formula_scale) + } + } + # store parameter names before removing formula attachments parameter_names <- colnames(model_samples) @@ -1680,3 +1711,89 @@ update.BayesTools_table <- function(object, title = NULL, footnotes = NULL, warn return() } } + +# Helper function to transform scaled samples in list format (for ensemble/marginal tables) +# Uses the combinatorial unscaling algorithm via the helper in JAGS-formula.R +.transform_scale_samples_list <- function(samples, formula_scale){ + + if(is.null(formula_scale) || length(formula_scale) == 0){ + return(samples) + } + + # Get all parameter names that have samples + sample_names <- names(samples) + + # Identify which samples are numeric or matrix (can be transformed) + transformable <- sapply(samples, function(x) is.numeric(x) || is.matrix(x)) + transformable_names <- sample_names[transformable] + + if(length(transformable_names) == 0){ + return(samples) + } + + # Determine the structure of each sample element + # (matrix with multiple columns for factors, or simple numeric/matrix for continuous) + # We need to handle each structure appropriately + + # For simplicity, we'll process each parameter individually using its structure + # But the combinatorial algorithm needs all parameters together + + # Approach: Build a single matrix with all parameters, apply transformation, extract back + # This requires handling the case where some parameters are matrices (factor levels) + + # First, identify simple (non-factor) parameters that can use the matrix approach + simple_params <- character(0) + factor_params <- character(0) + + for(name in transformable_names){ + if(is.matrix(samples[[name]]) && ncol(samples[[name]]) > 1){ + # Multi-column matrix - likely factor levels, skip for now + factor_params <- c(factor_params, name) + }else{ + simple_params <- c(simple_params, name) + } + } + + if(length(simple_params) > 0){ + # Build a matrix from simple parameters + # Each parameter becomes a column, samples are rows + n_samples <- if(is.matrix(samples[[simple_params[1]]])){ + nrow(samples[[simple_params[1]]]) + }else{ + length(samples[[simple_params[1]]]) + } + + posterior_matrix <- matrix(NA, nrow = n_samples, ncol = length(simple_params)) + colnames(posterior_matrix) <- simple_params + + for(i in seq_along(simple_params)){ + name <- simple_params[i] + if(is.matrix(samples[[name]])){ + posterior_matrix[, i] <- samples[[name]][, 1] + }else{ + posterior_matrix[, i] <- samples[[name]] + } + } + + # Apply the combinatorial unscaling transformation + posterior_matrix <- .apply_unscale_transform(posterior_matrix, formula_scale) + + # Extract back to list, preserving class and attributes + for(i in seq_along(simple_params)){ + name <- simple_params[i] + if(is.matrix(samples[[name]])){ + samples[[name]][, 1] <- posterior_matrix[, i] + }else{ + # Preserve class and attributes + old_attrs <- attributes(samples[[name]]) + samples[[name]] <- posterior_matrix[, i] + # Restore attributes (except names which may have changed) + for(attr_name in setdiff(names(old_attrs), "names")){ + attr(samples[[name]], attr_name) <- old_attrs[[attr_name]] + } + } + } + } + + return(samples) +} \ No newline at end of file diff --git a/R/tools.R b/R/tools.R index ecb1cbc..c754652 100644 --- a/R/tools.R +++ b/R/tools.R @@ -189,7 +189,7 @@ check_list <- function(x, name, check_length = 0, check_names = NULL, all_obje # helper functions .is.wholenumber <- function(x, na.rm = FALSE, tol = .Machine$double.eps^0.5){ if(na.rm){ - return(abs(x - round(stats::na.omit(x))) < tol) + return(stats::na.omit(abs(x - round(x))) < tol) }else{ return(abs(x - round(x)) < tol) } diff --git a/man/JAGS_bridgesampling.Rd b/man/JAGS_bridgesampling.Rd index a758061..d736aea 100644 --- a/man/JAGS_bridgesampling.Rd +++ b/man/JAGS_bridgesampling.Rd @@ -12,6 +12,7 @@ JAGS_bridgesampling( formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, + formula_scale_list = NULL, add_parameters = NULL, add_bounds = NULL, maxiter = 10000, diff --git a/man/JAGS_fit.Rd b/man/JAGS_fit.Rd index 4fcb018..39b8736 100644 --- a/man/JAGS_fit.Rd +++ b/man/JAGS_fit.Rd @@ -12,6 +12,7 @@ JAGS_fit( formula_list = NULL, formula_data_list = NULL, formula_prior_list = NULL, + formula_scale_list = NULL, chains = 4, adapt = 500, burnin = 1000, @@ -61,6 +62,11 @@ JAGS_extend( the names of the prior distribution correspond to the parameter names) of parameters specified within the \code{formula}} +\item{formula_scale_list}{named list of named lists for standardizing continuous predictors +(names of the lists correspond to the parameter name created by each of the formula). +Each entry should be a named list where continuous predictors with \code{TRUE} values will +be standardized. Defaults to \code{NULL} (no standardization).} + \item{chains}{number of chains to be run, defaults to \code{4}} \item{adapt}{number of samples used for adapting the MCMC chains, defaults to \code{500}} diff --git a/man/JAGS_formula.Rd b/man/JAGS_formula.Rd index c020cb2..6adbe25 100644 --- a/man/JAGS_formula.Rd +++ b/man/JAGS_formula.Rd @@ -4,7 +4,7 @@ \alias{JAGS_formula} \title{Create JAGS formula syntax and data object} \usage{ -JAGS_formula(formula, parameter, data, prior_list) +JAGS_formula(formula, parameter, data, prior_list, formula_scale = NULL) } \arguments{ \item{formula}{formula specifying the right hand side of the assignment (the @@ -18,7 +18,12 @@ automatically converted to include an intercept with a spike(0) prior.} \item{prior_list}{named list of prior distribution of parameters specified within the \code{formula}. When using \code{-1} in the formula, an "intercept" prior can be explicitly specified; otherwise, \code{prior("spike", list(0))} is -automatically added. The list can also include two special entries: +automatically added. The list can also include two special entries:} + +\item{formula_scale}{named list specifying whether to standardize continuous predictors. +If \code{NULL} (default), no standardization is applied. If a named list is provided, +continuous predictors with \code{TRUE} values will be standardized (mean-centered and +scaled by standard deviation). The intercept is never standardized. \describe{ \item{\code{"__default_continuous"}}{A prior to use for any continuous predictors (including the intercept) that are not explicitly specified in the prior list.} @@ -31,7 +36,8 @@ share the same prior distribution.} } \value{ \code{JAGS_formula} returns a list containing the formula JAGS syntax, -JAGS data object, and modified prior_list. +JAGS data object, modified prior_list, and (if standardization was applied) a +\code{formula_scale} list with standardization information for back-transformation. } \description{ Creates a JAGS formula syntax, prepares data input, and diff --git a/man/transform_scale_samples.Rd b/man/transform_scale_samples.Rd new file mode 100644 index 0000000..ba60d3c --- /dev/null +++ b/man/transform_scale_samples.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/JAGS-formula.R +\name{transform_scale_samples} +\alias{transform_scale_samples} +\title{Transform standardized posterior samples back to original scale} +\usage{ +transform_scale_samples(fit, formula_scale = NULL) +} +\arguments{ +\item{fit}{a fitted model object with \code{formula_scale} attribute, or +a list of posterior samples} + +\item{formula_scale}{named list containing standardization information +(mean and sd) for each standardized predictor. If \code{fit} is provided +and has a \code{formula_scale} attribute, this will be used automatically.} +} +\value{ +\code{transform_scale_samples} returns posterior samples transformed +back to the original predictor scale. +} +\description{ +Transforms posterior samples from standardized continuous +predictors back to the original scale. This function is used when predictors +were standardized during model fitting via the \code{formula_scale} parameter. +} +\details{ +The function transforms regression coefficients and intercepts +to account for predictor standardization. For a standardized coefficient +\eqn{\beta_z}, the original scale coefficient is \eqn{\beta = \beta_z / sd}. +The intercept is adjusted as: \eqn{\alpha = \alpha_z - \sum(\beta_z * mean / sd)}. +} +\seealso{ +\code{\link[=JAGS_formula]{JAGS_formula()}} \code{\link[=JAGS_fit]{JAGS_fit()}} +} diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 7238f48..d76ca9d 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -843,6 +843,92 @@ test_that("Formula-based interaction models fit correctly", { model_registry[["fit_formula_interaction_cont"]] <<- result$registry_entry fit_formula_interaction_cont <- result$fit + # Test standardization: manual vs automatic scaling + # Create data with large scale differences (far from being scaled) + set.seed(2) + data_unscaled <- data.frame( + x_cont1 = rnorm(100, mean = 1000, sd = 1000), # Large scale + x_cont2 = rnorm(100, mean = 0.5, sd = 0.01) # Small scale + ) + data_scale <- list( + y = rnorm(100, 500 * data_unscaled$x_cont1 - 20 * data_unscaled$x_cont1 * data_unscaled$x_cont2, 1), + N = 100 + ) + + # Manual scaling: scale the data manually before fitting + data_manual_scaled <- data_unscaled + x_cont1_mean <- mean(data_unscaled$x_cont1) + x_cont1_sd <- sd(data_unscaled$x_cont1) + x_cont2_mean <- mean(data_unscaled$x_cont2) + x_cont2_sd <- sd(data_unscaled$x_cont2) + data_manual_scaled$x_cont1 <- (data_unscaled$x_cont1 - x_cont1_mean) / x_cont1_sd + data_manual_scaled$x_cont2 <- (data_unscaled$x_cont2 - x_cont2_mean) / x_cont2_sd + + formula_list_scale <- list(mu = ~ x_cont1 * x_cont2) + formula_prior_list_scale <- list( + mu = list( + "intercept" = prior("normal", list(0, 5)), + "x_cont1" = prior("normal", list(0, 1)), + "x_cont2" = prior("normal", list(0, 1)), + "x_cont1:x_cont2" = prior("normal", list(0, 1)) + ) + ) + + # Fit 1: Manual scaling + formula_data_list_manual <- list(mu = data_manual_scaled) + fit_formula_manual_scaled <- JAGS_fit( + model_syntax = model_syntax, data = data_scale, prior_list = prior_list, + formula_list = formula_list_scale, formula_data_list = formula_data_list_manual, + formula_prior_list = formula_prior_list_scale, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + # Store scaling info as attribute for comparison + attr(fit_formula_manual_scaled, "manual_scale") <- list( + mu_x_cont1 = list(mean = x_cont1_mean, sd = x_cont1_sd), + mu_x_cont2 = list(mean = x_cont2_mean, sd = x_cont2_sd) + ) + + # Compute marginal likelihood for manual scaling + log_posterior_scale <- function(parameters, data){ + sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) + } + marglik_formula_manual_scaled <- JAGS_bridgesampling( + fit_formula_manual_scaled, log_posterior = log_posterior_scale, data = data_scale, + prior_list = prior_list, + formula_list = formula_list_scale, formula_data_list = formula_data_list_manual, + formula_prior_list = formula_prior_list_scale) + + result <- save_fit(fit_formula_manual_scaled, "fit_formula_manual_scaled", + marglik = marglik_formula_manual_scaled, + formulas = TRUE, interactions = TRUE, simple_priors = TRUE, + note = "Manual scaling of continuous predictors") + model_registry[["fit_formula_manual_scaled"]] <<- result$registry_entry + fit_formula_manual_scaled <- result$fit + + # Fit 2: Automatic scaling + formula_data_list_auto <- list(mu = data_unscaled) + formula_scale_list_auto <- list(mu = list(x_cont1 = TRUE, x_cont2 = TRUE)) + fit_formula_auto_scaled <- JAGS_fit( + model_syntax = model_syntax, data = data_scale, prior_list = prior_list, + formula_list = formula_list_scale, formula_data_list = formula_data_list_auto, + formula_prior_list = formula_prior_list_scale, + formula_scale_list = formula_scale_list_auto, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) + + # Compute marginal likelihood for automatic scaling + marglik_formula_auto_scaled <- JAGS_bridgesampling( + fit_formula_auto_scaled, log_posterior = log_posterior_scale, data = data_scale, + prior_list = prior_list, + formula_list = formula_list_scale, formula_data_list = formula_data_list_auto, + formula_prior_list = formula_prior_list_scale, + formula_scale_list = formula_scale_list_auto) + + result <- save_fit(fit_formula_auto_scaled, "fit_formula_auto_scaled", + marglik = marglik_formula_auto_scaled, + formulas = TRUE, interactions = TRUE, simple_priors = TRUE, + note = "Automatic scaling of continuous predictors") + model_registry[["fit_formula_auto_scaled"]] <<- result$registry_entry + fit_formula_auto_scaled <- result$fit + # Continuous-factor interaction formula_list_mix_int <- list(mu = ~ x_cont1 * x_fac3o) formula_data_list_mix_int <- list(mu = data_formula) diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R new file mode 100644 index 0000000..9ce30d8 --- /dev/null +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -0,0 +1,1191 @@ +# ============================================================================ # +# TEST FILE: JAGS Formula Standardization +# ============================================================================ # +# +# PURPOSE: +# Tests for automatic standardization of continuous predictors in JAGS_formula +# +# DEPENDENCIES: +# - common-functions.R: Test helpers +# +# SKIP CONDITIONS: +# - None (pure R tests, no JAGS fitting required) +# +# TAGS: @formula, @standardization, @fast +# ============================================================================ # + +# Load common test helpers +source(testthat::test_path("common-functions.R")) + +test_that("JAGS_formula accepts and validates formula_scale parameter", { + + # Setup test data + set.seed(1) + df <- data.frame( + y = rnorm(60), + x_cont = rnorm(60, mean = 3, sd = 5), + x_fac = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")) + ) + + # Test 1: formula_scale = NULL (no standardization) + prior_list <- list( + "intercept" = prior("normal", list(0, 1)), + "x_cont" = prior("normal", list(0, 1)), + "x_fac" = prior_factor("normal", list(0, 1), contrast = "treatment") + ) + + result <- JAGS_formula( + formula = ~ x_cont + x_fac, + parameter = "mu", + data = df, + prior_list = prior_list, + formula_scale = NULL + ) + + expect_false("formula_scale" %in% names(result)) + expect_equal(unname(result$data$mu_data_x_cont), as.numeric(df$x_cont)) + + # Test 2: formula_scale with standardization + result_scaled <- JAGS_formula( + formula = ~ x_cont + x_fac, + parameter = "mu", + data = df, + prior_list = prior_list, + formula_scale = list(x_cont = TRUE) + ) + + expect_true("formula_scale" %in% names(result_scaled)) + expect_true("mu_x_cont" %in% names(result_scaled$formula_scale)) + expect_equal(names(result_scaled$formula_scale$mu_x_cont), c("mean", "sd")) + expect_equal(unname(result_scaled$data$mu_data_x_cont), as.numeric(scale(df$x_cont))) + + # Test 3: Check that scale info is correct + original_mean <- mean(df$x_cont) + original_sd <- sd(df$x_cont) + + expect_equal(result_scaled$formula_scale$mu_x_cont$mean, original_mean) + expect_equal(result_scaled$formula_scale$mu_x_cont$sd, original_sd) + + # Test 4: formula_scale with FALSE should not standardize + result_not_scaled <- JAGS_formula( + formula = ~ x_cont + x_fac, + parameter = "mu", + data = df, + prior_list = prior_list, + formula_scale = list(x_cont = FALSE) + ) + + expect_false("formula_scale" %in% names(result_not_scaled)) + expect_equal(unname(result_not_scaled$data$mu_data_x_cont), as.numeric(df$x_cont)) + +}) + +test_that("JAGS_formula standardization preserves data correctly", { + + set.seed(2) + df <- data.frame( + x1 = rnorm(50, mean = 10, sd = 3), + x2 = rnorm(50, mean = -5, sd = 2) + ) + + prior_list <- list( + "intercept" = prior("normal", list(0, 1)), + "x1" = prior("normal", list(0, 1)), + "x2" = prior("normal", list(0, 1)) + ) + + ### Standardize both predictors + result <- JAGS_formula( + formula = ~ x1 + x2, + parameter = "beta", + data = df, + prior_list = prior_list, + formula_scale = list(x1 = TRUE, x2 = TRUE) + ) + + # Check that both predictors are standardized + expect_length(result$formula_scale, 2) + expect_true("beta_x1" %in% names(result$formula_scale)) + expect_true("beta_x2" %in% names(result$formula_scale)) + + # Verify scale parameters + expect_equal(result$formula_scale$beta_x1$mean, 10, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x1$sd, 3, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x2$mean, -5, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x2$sd, 2, tolerance = 0.5) + + ### Standardize both predictors (lazily) + result <- JAGS_formula( + formula = ~ x1 + x2, + parameter = "beta", + data = df, + prior_list = prior_list, + formula_scale = TRUE + ) + + # Check that both predictors are standardized + expect_length(result$formula_scale, 2) + expect_true("beta_x1" %in% names(result$formula_scale)) + expect_true("beta_x2" %in% names(result$formula_scale)) + + # Verify scale parameters + expect_equal(result$formula_scale$beta_x1$mean, 10, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x1$sd, 3, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x2$mean, -5, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x2$sd, 2, tolerance = 0.5) + + ### Standardize one predictors + result <- JAGS_formula( + formula = ~ x1 + x2, + parameter = "beta", + data = df, + prior_list = prior_list, + formula_scale = list(x1 = FALSE, x2 = TRUE) + ) + + # Check that both predictors are standardized + expect_length(result$formula_scale, 1) + expect_true(!"beta_x1" %in% names(result$formula_scale)) + expect_true("beta_x2" %in% names(result$formula_scale)) + + # Verify scale parameters + expect_equal(result$formula_scale$beta_x2$mean, -5, tolerance = 0.5) + expect_equal(result$formula_scale$beta_x2$sd, 2, tolerance = 0.5) + expect_equal(unname(result$data$beta_data_x1), as.numeric(df$x1)) + expect_equal(unname(result$data$beta_data_x2), as.numeric(scale(df$x2))) +}) + +test_that("transform_scale_samples transforms coefficients correctly", { + + # Create mock posterior samples + set.seed(3) + n_samples <- 100 + + # Simulated standardized coefficients + posterior <- matrix( + c( + rnorm(n_samples, mean = 0.5, sd = 0.1), # mu_intercept + rnorm(n_samples, mean = 0.3, sd = 0.05), # mu_x_cont (standardized) + rnorm(n_samples, mean = 0.2, sd = 0.05) # mu_x_fac (not standardized) + ), + nrow = n_samples, + ncol = 3 + ) + colnames(posterior) <- c("mu_intercept", "mu_x_cont", "mu_x_fac") + + # Scale information (x_cont was standardized with mean=5, sd=2) + formula_scale <- list( + mu_x_cont = list(mean = 5, sd = 2) + ) + + # Transform back to original scale + posterior_original <- transform_scale_samples(posterior, formula_scale) + + # Check that x_cont coefficient is rescaled (divided by sd) + expect_equal(posterior_original[, "mu_x_cont"], posterior[, "mu_x_cont"] / 2) + + # Check that x_fac is unchanged (not in formula_scale) + expect_equal(posterior_original[, "mu_x_fac"], posterior[, "mu_x_fac"]) + + # Check that intercept is adjusted + # intercept_original = intercept_std - beta_original * mean + # where beta_original = beta_std / sd (already done above) + expected_intercept <- posterior[, "mu_intercept"] - (posterior[, "mu_x_cont"] / 2 * 5) + expect_equal(posterior_original[, "mu_intercept"], expected_intercept) +}) + +test_that("transform_scale_samples handles interaction terms correctly", { + + # Create mock posterior samples with interaction + set.seed(4) + n_samples <- 100 + + # Simulated standardized coefficients + posterior <- matrix( + c( + rnorm(n_samples, mean = 1.0, sd = 0.1), # mu_intercept + rnorm(n_samples, mean = 0.3, sd = 0.05), # mu_x1 (standardized) + rnorm(n_samples, mean = 0.2, sd = 0.05), # mu_x2 (standardized) + rnorm(n_samples, mean = 0.1, sd = 0.02) # mu_x1__xXx__x2 (interaction) + ), + nrow = n_samples, + ncol = 4 + ) + colnames(posterior) <- c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2") + + # Scale information + formula_scale <- list( + mu_x1 = list(mean = 5, sd = 2), + mu_x2 = list(mean = 10, sd = 4) + ) + + # Transform back to original scale + posterior_original <- transform_scale_samples(posterior, formula_scale) + + # The interaction coefficient should be divided by (sd_x1 * sd_x2) = 2 * 4 = 8 + expect_equal( + posterior_original[, "mu_x1__xXx__x2"], + posterior[, "mu_x1__xXx__x2"] / (2 * 4), + tolerance = 1e-10 + ) + + # The main effect x1 should be: beta_x1_orig = beta_x1_z/sd_x1 - beta_int_orig * mean_x2 + beta_int_orig <- posterior[, "mu_x1__xXx__x2"] / 8 + beta_x1_z_div_sd <- posterior[, "mu_x1"] / 2 + expected_beta_x1 <- beta_x1_z_div_sd - beta_int_orig * 10 + expect_equal(posterior_original[, "mu_x1"], expected_beta_x1, tolerance = 1e-10) + + # The main effect x2 should be: beta_x2_orig = beta_x2_z/sd_x2 - beta_int_orig * mean_x1 + beta_x2_z_div_sd <- posterior[, "mu_x2"] / 4 + expected_beta_x2 <- beta_x2_z_div_sd - beta_int_orig * 5 + expect_equal(posterior_original[, "mu_x2"], expected_beta_x2, tolerance = 1e-10) + + # The intercept should be: + # alpha_orig = alpha_z - (beta_x1_z/sd_x1)*mean_x1 - (beta_x2_z/sd_x2)*mean_x2 + beta_int_orig*mean_x1*mean_x2 + # Note: uses beta_z/sd (intermediate values), not beta_orig (interaction-adjusted values) + expected_intercept <- posterior[, "mu_intercept"] - + beta_x1_z_div_sd * 5 - beta_x2_z_div_sd * 10 + beta_int_orig * 5 * 10 + expect_equal(posterior_original[, "mu_intercept"], expected_intercept, tolerance = 1e-10) +}) + +test_that("Manual and automatic scaling produce equivalent results", { + + skip_if_no_fits() + + # Load pre-fitted models + fit_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled.RDS")) + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + + # Check that automatic scaling has formula_scale attribute + expect_true(!is.null(attr(fit_auto, "formula_scale"))) + expect_true("mu_x_cont1" %in% names(attr(fit_auto, "formula_scale"))) + expect_true("mu_x_cont2" %in% names(attr(fit_auto, "formula_scale"))) + + # Check that manual scaling has the scale info stored + expect_true(!is.null(attr(fit_manual, "manual_scale"))) + + # Compare scaling parameters + # The automatic and manual scaling should have stored the same mean/sd + manual_scale <- attr(fit_manual, "manual_scale") + auto_scale <- attr(fit_auto, "formula_scale") + + expect_equal(manual_scale$mu_x_cont1$mean, auto_scale$mu_x_cont1$mean, tolerance = 1e-10) + expect_equal(manual_scale$mu_x_cont1$sd, auto_scale$mu_x_cont1$sd, tolerance = 1e-10) + expect_equal(manual_scale$mu_x_cont2$mean, auto_scale$mu_x_cont2$mean, tolerance = 1e-10) + expect_equal(manual_scale$mu_x_cont2$sd, auto_scale$mu_x_cont2$sd, tolerance = 1e-10) + + # Extract posterior samples + posterior_manual <- as.matrix(fit_manual$mcmc[[1]]) + posterior_auto <- as.matrix(fit_auto$mcmc[[1]]) + + # The raw posterior samples should be very similar (both are on scaled space) + # since both models were fit with the same seed and same scaled data + + # Compare means of main effects + mean_manual_x1 <- mean(posterior_manual[, "mu_x_cont1"]) + mean_auto_x1 <- mean(posterior_auto[, "mu_x_cont1"]) + + mean_manual_x2 <- mean(posterior_manual[, "mu_x_cont2"]) + mean_auto_x2 <- mean(posterior_auto[, "mu_x_cont2"]) + + mean_manual_interaction <- mean(posterior_manual[, "mu_x_cont1__xXx__x_cont2"]) + mean_auto_interaction <- mean(posterior_auto[, "mu_x_cont1__xXx__x_cont2"]) + + # These should be very close since both use scaled data + expect_equal(mean_manual_x1, mean_auto_x1) + expect_equal(mean_manual_x2, mean_auto_x2) + expect_equal(mean_manual_interaction, mean_auto_interaction) + + # Compare standard deviations + sd_manual_x1 <- sd(posterior_manual[, "mu_x_cont1"]) + sd_auto_x1 <- sd(posterior_auto[, "mu_x_cont1"]) + + sd_manual_x2 <- sd(posterior_manual[, "mu_x_cont2"]) + sd_auto_x2 <- sd(posterior_auto[, "mu_x_cont2"]) + + sd_manual_interaction <- sd(posterior_manual[, "mu_x_cont1__xXx__x_cont2"]) + sd_auto_interaction <- sd(posterior_auto[, "mu_x_cont1__xXx__x_cont2"]) + + expect_equal(sd_manual_x1, sd_auto_x1) + expect_equal(sd_manual_x2, sd_auto_x2) + expect_equal(sd_manual_interaction, sd_auto_interaction) + + # Compare intercepts (these should also be similar) + mean_manual_int <- mean(posterior_manual[, "mu_intercept"]) + mean_auto_int <- mean(posterior_auto[, "mu_intercept"]) + + expect_equal(mean_manual_int, mean_auto_int, tolerance = 0.05) +}) + +test_that("Downstream functions work with scaled models", { + + skip_if_no_fits() + + # Load pre-fitted models + fit_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled.RDS")) + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + + expect_equal(JAGS_estimates_table(fit_manual), JAGS_estimates_table(fit_auto)) +}) + +test_that("Marginal likelihoods match for manual and automatic scaling", { + + skip_if_no_fits() + + # Load pre-fitted marginal likelihoods + marglik_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled_marglik.RDS")) + marglik_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled_marglik.RDS")) + + # The log marginal likelihoods should be very similar + # (both models use same scaled data internally) + expect_equal(marglik_manual$logml, marglik_auto$logml, tolerance = 0.1) +}) + +test_that("JAGS_evaluate_formula applies scaling correctly", { + + skip_if_no_fits() + + # Load pre-fitted models with scaling + fit_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled.RDS")) + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + + # Create new data with same scale as original (unscaled) + set.seed(3) + new_data <- data.frame( + x_cont1 = rnorm(10, mean = 1000, sd = 1000), + x_cont2 = rnorm(10, mean = 0.5, sd = 0.1) + ) + + # Get prior lists from fit attributes + prior_list_auto <- attr(fit_auto, "prior_list") + prior_list_manual <- attr(fit_manual, "prior_list") + + # For manual scaling, we need to manually scale the new data + manual_scale <- attr(fit_manual, "manual_scale") + new_data_manual <- new_data + new_data_manual$x_cont1 <- (new_data$x_cont1 - manual_scale$mu_x_cont1$mean) / manual_scale$mu_x_cont1$sd + new_data_manual$x_cont2 <- (new_data$x_cont2 - manual_scale$mu_x_cont2$mean) / manual_scale$mu_x_cont2$sd + + # For automatic scaling, JAGS_evaluate_formula should apply scaling automatically + # (using the formula_scale attribute from fit_auto) + + # Evaluate formula on new data + pred_manual <- JAGS_evaluate_formula( + fit = fit_manual, + formula = ~ x_cont1 * x_cont2, + parameter = "mu", + data = new_data_manual, + prior_list = prior_list_manual + ) + + pred_auto <- JAGS_evaluate_formula( + fit = fit_auto, + formula = ~ x_cont1 * x_cont2, + parameter = "mu", + data = new_data, # Note: passing unscaled data + prior_list = prior_list_auto + ) + + # The predictions should be very similar + # (both models use same scaled data internally, and seed) + expect_equal(pred_manual, pred_auto) + + # Also check that without scaling, predictions would be different + # (this verifies that scaling is actually being applied) + pred_auto_no_scale <- JAGS_evaluate_formula( + fit = fit_manual, # Use manual fit which doesn't have formula_scale attribute + formula = ~ x_cont1 * x_cont2, + parameter = "mu", + data = new_data, # Unscaled data + prior_list = prior_list_manual + ) + + # These should be very different from the correctly scaled predictions + expect_true(any(rowMeans(pred_manual) - rowMeans(pred_auto_no_scale) > 1)) +}) + +test_that("runjags_estimates_table with transform_scaled unscales coefficients", { + # TODO: something is wrong here with the intercept handling + skip_if_no_fits() + + # Load pre-fitted model with automatic scaling + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + + # Get formula_scale attribute + formula_scale <- attr(fit_auto, "formula_scale") + expect_true(!is.null(formula_scale)) + + # Get estimates without unscaling + estimates_scaled <- JAGS_estimates_table(fit_auto, transform_scaled = FALSE) + + # Get estimates with unscaling + estimates_unscaled <- JAGS_estimates_table(fit_auto, transform_scaled = TRUE) + + # The scaled coefficient for x_cont1 should be divided by sd + # to get the unscaled coefficient + sd_x_cont1 <- formula_scale$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu_x_cont2$mean + + # Check that the interaction term is correctly unscaled (divided by product of SDs) + scaled_coef_int <- estimates_scaled["(mu) x_cont1:x_cont2", "Mean"] + unscaled_coef_int <- estimates_unscaled["(mu) x_cont1:x_cont2", "Mean"] + expect_equal(unscaled_coef_int, scaled_coef_int / (sd_x_cont1 * sd_x_cont2), tolerance = 1e-10) + + # The main effects are adjusted for interaction contributions + # beta_x1_orig = beta_x1_z/sd_x1 - beta_int_orig * mean_x2 + scaled_coef_x1 <- estimates_scaled["(mu) x_cont1", "Mean"] + expected_x1 <- scaled_coef_x1 / sd_x_cont1 - unscaled_coef_int * mean_x_cont2 + expect_equal(estimates_unscaled["(mu) x_cont1", "Mean"], expected_x1, tolerance = 1e-10) + + # beta_x2_orig = beta_x2_z/sd_x2 - beta_int_orig * mean_x1 + scaled_coef_x2 <- estimates_scaled["(mu) x_cont2", "Mean"] + expected_x2 <- scaled_coef_x2 / sd_x_cont2 - unscaled_coef_int * mean_x_cont1 + expect_equal(estimates_unscaled["(mu) x_cont2", "Mean"], expected_x2, tolerance = 1e-10) + + # The intercept should be adjusted + # alpha_orig = alpha_z - beta_x1_orig*mean_x1 - beta_x2_orig*mean_x2 - beta_int_orig*mean_x1*mean_x2 + scaled_intercept <- estimates_scaled["(mu) intercept", "Mean"] + expected_intercept <- scaled_intercept - expected_x1 * mean_x_cont1 - expected_x2 * mean_x_cont2 - + unscaled_coef_int * mean_x_cont1 * mean_x_cont2 + expect_equal(estimates_unscaled["(mu) intercept", "Mean"], expected_intercept, tolerance = 1e-10) +}) + +test_that("runjags_estimates_table transform_scaled with return_samples works", { + + skip_if_no_fits() + + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + formula_scale <- attr(fit_auto, "formula_scale") + + # Get samples without unscaling + samples_scaled <- JAGS_estimates_table(fit_auto, transform_scaled = FALSE, return_samples = TRUE) + + # Get samples with unscaling + samples_unscaled <- JAGS_estimates_table(fit_auto, transform_scaled = TRUE, return_samples = TRUE) + + # For models with interactions, the transformation is more complex + sd_x_cont1 <- formula_scale$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu_x_cont2$mean + + # First, compute the unscaled interaction coefficient + unscaled_int <- samples_scaled[, "(mu) x_cont1:x_cont2"] / (sd_x_cont1 * sd_x_cont2) + + # Check that x_cont1 samples are correctly unscaled (with interaction adjustment) + # beta_x1_orig = beta_x1_z/sd_x1 - beta_int_orig * mean_x2 + expected_x1 <- samples_scaled[, "(mu) x_cont1"] / sd_x_cont1 - unscaled_int * mean_x_cont2 + expect_equal( + samples_unscaled[, "(mu) x_cont1"], + expected_x1, + tolerance = 1e-10 + ) +}) + +test_that("ensemble_estimates_table with transform_scaled unscales coefficients", { + + skip_if_no_fits() + skip_if_not_installed("bridgesampling") + + # Load pre-fitted models + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + marglik_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled_marglik.RDS")) + + formula_scale <- attr(fit_auto, "formula_scale") + + # Create a simple model list for mix_posteriors + model_list <- list( + list( + fit = fit_auto, + marglik = marglik_auto, + prior_weights = 1 + ) + ) + + # Get mixed posteriors - include interaction term for proper unscaling + mixed_posteriors <- mix_posteriors( + model_list = model_list, + parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2", "mu_x_cont1__xXx__x_cont2"), + is_null_list = list( + mu_intercept = 1, + mu_x_cont1 = 1, + mu_x_cont2 = 1, + "mu_x_cont1__xXx__x_cont2" = 1 + ), + seed = 1 + ) + + # Get estimates without unscaling + estimates_scaled <- ensemble_estimates_table( + samples = mixed_posteriors, + parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2", "mu_x_cont1__xXx__x_cont2"), + transform_scaled = FALSE + ) + + # Get estimates with unscaling + estimates_unscaled <- ensemble_estimates_table( + samples = mixed_posteriors, + parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2", "mu_x_cont1__xXx__x_cont2"), + transform_scaled = TRUE, + formula_scale = formula_scale + ) + + # For models with interactions, the transformation is more complex + sd_x_cont1 <- formula_scale$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu_x_cont2$mean + + # Check that the interaction term is correctly unscaled (divided by product of SDs) + scaled_coef_int <- estimates_scaled["(mu) x_cont1:x_cont2", "Mean"] + unscaled_coef_int <- estimates_unscaled["(mu) x_cont1:x_cont2", "Mean"] + expect_equal(unscaled_coef_int, scaled_coef_int / (sd_x_cont1 * sd_x_cont2), tolerance = 1e-10) + + # The main effects are adjusted for interaction contributions + # beta_x1_orig = beta_x1_z/sd_x1 - beta_int_orig * mean_x2 + scaled_coef_x1 <- estimates_scaled["mu_x_cont1", "Mean"] + expected_x1 <- scaled_coef_x1 / sd_x_cont1 - unscaled_coef_int * mean_x_cont2 + expect_equal(estimates_unscaled["mu_x_cont1", "Mean"], expected_x1, tolerance = 1e-10) + + # beta_x2_orig = beta_x2_z/sd_x2 - beta_int_orig * mean_x1 + scaled_coef_x2 <- estimates_scaled["mu_x_cont2", "Mean"] + expected_x2 <- scaled_coef_x2 / sd_x_cont2 - unscaled_coef_int * mean_x_cont1 + expect_equal(estimates_unscaled["mu_x_cont2", "Mean"], expected_x2, tolerance = 1e-10) +}) + +test_that("transform_scaled = FALSE is the default behavior", { + + skip_if_no_fits() + + fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + + # Default behavior should be no unscaling + estimates_default <- JAGS_estimates_table(fit_auto) + estimates_false <- JAGS_estimates_table(fit_auto, transform_scaled = FALSE) + + expect_equal(estimates_default, estimates_false) +}) + +test_that("transform_scaled has no effect when formula_scale is NULL", { + + skip_if_no_fits() + + # Load model without automatic scaling (manual scaling doesn't have formula_scale attr) + fit_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled.RDS")) + + # transform_scaled = TRUE should have no effect when formula_scale is NULL + estimates_false <- JAGS_estimates_table(fit_manual, transform_scaled = FALSE) + estimates_true <- JAGS_estimates_table(fit_manual, transform_scaled = TRUE) + + expect_equal(estimates_false, estimates_true) +}) + + +# ============================================================================ # +# LM-BASED VALIDATION TESTS +# ============================================================================ # +# +# These tests validate the unscaling transformation by comparing against lm(): +# 1. Fit lm() with scaled predictors -> extract coefficients +# 2. Transform coefficients using transform_scale_samples() +# 3. Compare against lm() with unscaled predictors +# +# This approach validates both the implementation AND the derivation. +# ============================================================================ # + +# Helper: Create formula_scale from data frame and variable names +# Mimics what JAGS_formula does when formula_scale = TRUE +.make_formula_scale <- function(df, var_names, prefix = "mu") { + result <- list() + for (var in var_names) { + param_name <- paste0(prefix, "_", var) + result[[param_name]] <- list( + mean = mean(df[[var]]), + sd = sd(df[[var]]) + ) + } + attr(result, "parameter") <- prefix + result +} + +# Helper: Convert lm coefficients to posterior matrix format (repeated rows) +# Uses the same naming convention as JAGS (__xXx__ for interactions) +.lm_coefs_to_posterior <- function(coefs, prefix = "mu", n_rep = 10) { + # Convert names: "(Intercept)" -> "mu_intercept", "x1:x2" -> "mu_x1__xXx__x2" + new_names <- names(coefs) + new_names <- gsub("\\(Intercept\\)", "intercept", new_names) + new_names <- gsub(":", "__xXx__", new_names) + new_names <- paste0(prefix, "_", new_names) + + # Remove scale() wrapper from names if present + new_names <- gsub("scale\\(([^)]+)\\)", "\\1", new_names) + + posterior <- matrix(rep(coefs, each = n_rep), nrow = n_rep, ncol = length(coefs)) + colnames(posterior) <- new_names + posterior +} + +# Helper to reorder lm coefficients to match posterior column order +.reorder_lm_coefs <- function(coef_unscaled, posterior_transformed) { + # Build mapping from posterior names to lm names + posterior_names <- colnames(posterior_transformed) + lm_names <- sapply(posterior_names, function(nm) { + # Remove mu_ prefix + stripped <- sub("^mu_", "", nm) + if (stripped == "intercept") return("(Intercept)") + # Replace __xXx__ with : + gsub("__xXx__", ":", stripped) + }) + coef_unscaled[lm_names] +} + + +test_that("lm validation: simple standardization (one predictor)", { + + set.seed(42) + df <- data.frame( + x1 = rnorm(500, mean = 10, sd = 3), + y = rnorm(500) + ) + df$y <- 5 + 2 * scale(df$x1) + rnorm(500, 0, 0.5) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform scaled coefficients + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x1") + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: multiple predictors (no interaction)", { + + set.seed(43) + df <- data.frame( + x1 = rnorm(500, mean = 3, sd = 5), + x2 = rnorm(500, mean = -10, sd = 2) + ) + df$y <- 2 - 0.5 * scale(df$x1) + 1.5 * scale(df$x2) + rnorm(500, 0, 0.3) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) + scale(x2), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 + x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: two-way interaction (both scaled)", { + + set.seed(44) + df <- data.frame( + x1 = rnorm(500, mean = 5, sd = 2), + x2 = rnorm(500, mean = -3, sd = 4) + ) + df$y <- 3 + 0.8 * scale(df$x1) - 0.5 * scale(df$x2) + + 0.3 * scale(df$x1) * scale(df$x2) + rnorm(500, 0, 0.5) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare all coefficients + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: two-way interaction (partial scaling)", { + + set.seed(45) + df <- data.frame( + x1 = rnorm(500, mean = 8, sd = 3), + x2 = rnorm(500, mean = -2, sd = 5) + ) + # Only x1 is scaled + df$y <- 1 + 0.6 * scale(df$x1) - 0.4 * df$x2 + + 0.25 * scale(df$x1) * df$x2 + rnorm(500, 0, 0.4) + + # Fit with partial scaling (only x1 scaled) + fit_scaled <- lm(y ~ scale(x1) * x2, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - only x1 is in formula_scale + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x1") # Only x1 scaled + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: three-way interaction (all scaled)", { + + set.seed(46) + df <- data.frame( + x1 = rnorm(500, mean = 3, sd = 2), + x2 = rnorm(500, mean = -5, sd = 3), + x3 = rnorm(500, mean = 10, sd = 4) + ) + df$y <- 2 + + 0.5 * scale(df$x1) - 0.3 * scale(df$x2) + 0.4 * scale(df$x3) + + 0.2 * scale(df$x1) * scale(df$x2) + + 0.15 * scale(df$x1) * scale(df$x3) + + 0.1 * scale(df$x2) * scale(df$x3) + + 0.08 * scale(df$x1) * scale(df$x2) * scale(df$x3) + + rnorm(500, 0, 0.3) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * scale(x3), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * x3, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare all coefficients + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: three-way interaction (partial scaling)", { + + set.seed(47) + df <- data.frame( + x1 = rnorm(500, mean = 4, sd = 2), + x2 = rnorm(500, mean = -3, sd = 3), + x3 = rnorm(500, mean = 7, sd = 1) # This one not scaled + ) + # x1 and x2 scaled, x3 not scaled + df$y <- 1 + + 0.4 * scale(df$x1) - 0.2 * scale(df$x2) + 0.3 * df$x3 + + 0.15 * scale(df$x1) * scale(df$x2) + + 0.12 * scale(df$x1) * df$x3 + + 0.08 * scale(df$x2) * df$x3 + + 0.05 * scale(df$x1) * scale(df$x2) * df$x3 + + rnorm(500, 0, 0.2) + + # Fit with partial scaling + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * x3, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * x3, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - only x1 and x2 are scaled + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare all coefficients + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: four-way interaction", { + + set.seed(48) + df <- data.frame( + x1 = rnorm(1000, mean = 2, sd = 1), + x2 = rnorm(1000, mean = -4, sd = 2), + x3 = rnorm(1000, mean = 6, sd = 3), + x4 = rnorm(1000, mean = -1, sd = 0.5) + ) + # Complex model with 4-way interaction + df$y <- 3 + + 0.3 * scale(df$x1) - 0.2 * scale(df$x2) + + 0.4 * scale(df$x3) - 0.1 * scale(df$x4) + + 0.05 * scale(df$x1) * scale(df$x2) * scale(df$x3) * scale(df$x4) + + rnorm(1000, 0, 0.5) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * scale(x3) * scale(x4), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * x3 * x4, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3", "x4")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare all coefficients + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: five-way interaction (warning test)", { + + set.seed(49) + df <- data.frame( + x1 = rnorm(2000, mean = 1, sd = 0.5), + x2 = rnorm(2000, mean = -2, sd = 1), + x3 = rnorm(2000, mean = 3, sd = 1.5), + x4 = rnorm(2000, mean = -1, sd = 0.3), + x5 = rnorm(2000, mean = 4, sd = 2) + ) + df$y <- 2 + + 0.2 * scale(df$x1) - 0.1 * scale(df$x2) + + 0.3 * scale(df$x3) - 0.15 * scale(df$x4) + 0.1 * scale(df$x5) + + 0.02 * scale(df$x1) * scale(df$x2) * scale(df$x3) * scale(df$x4) * scale(df$x5) + + rnorm(2000, 0, 0.5) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * scale(x3) * scale(x4) * scale(x5), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * x3 * x4 * x5, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - expect warning about 5+ way interaction + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3", "x4", "x5")) + + expect_warning( + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale), + "5-way or higher interactions" + ) + + # Should still produce correct results despite warning + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: complex model from user example", { + + # This is the exact example pattern from the user's request + set.seed(1) + df_orig <- data.frame( + x1 = rnorm(1000, mean = 3, sd = 5), + x2 = rnorm(1000, mean = -10, sd = 80), + x3 = rnorm(1000, mean = -20, sd = 0.07), + x4 = rnorm(1000, mean = 50, sd = 30), + x5 = rnorm(1000, mean = 20, sd = 0.2) + ) + + # DGP with specific structure + df_orig$y <- with( + df_orig, + 5 - 0.1 * scale(x1) + 0.2 * scale(x2) + 0.3 * scale(x1) * scale(x2) - + 0.25 * scale(x3) * scale(x4) * scale(x5) + 0.40 * scale(x3) * scale(x4) + + rnorm(1000, 0, 1) + ) + + # Fit the model with scaled predictors (matching DGP) + fit_scaled <- lm(y ~ scale(x1) * scale(x2) + scale(x3) * scale(x4) * scale(x5), data = df_orig) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 + x3 * x4 * x5, data = df_orig) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df_orig, c("x1", "x2", "x3", "x4", "x5")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare all coefficients + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: factor + scaled continuous interaction", { + + set.seed(50) + df <- data.frame( + x1 = rnorm(500, mean = 5, sd = 3), + f1 = factor(sample(letters[1:2], 500, TRUE)) + ) + df$y <- 2 + 0.5 * scale(df$x1) + + ifelse(df$f1 == "b", 0.3, 0) + + ifelse(df$f1 == "b", 0.2, 0) * scale(df$x1) + + rnorm(500, 0, 0.4) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1) * f1, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1 * f1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - only x1 is scaled (f1 is factor, not scaled) + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x1") + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: factor + unscaled continuous interaction", { + + set.seed(51) + df <- data.frame( + x1 = rnorm(500, mean = 8, sd = 2), # Will NOT be scaled + x2 = rnorm(500, mean = -3, sd = 4), # Will be scaled + f1 = factor(sample(letters[1:2], 500, TRUE)) + ) + df$y <- 1 + 0.3 * df$x1 + 0.4 * scale(df$x2) + + ifelse(df$f1 == "b", 0.5, 0) + + ifelse(df$f1 == "b", 0.1, 0) * df$x1 + + ifelse(df$f1 == "b", 0.15, 0) * scale(df$x2) + + rnorm(500, 0, 0.3) + + # Fit with partial scaling (only x2 scaled) + fit_scaled <- lm(y ~ x1 * f1 + scale(x2) * f1, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * f1 + x2 * f1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - only x2 is scaled + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x2") + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: multi-level factor with scaled continuous", { + + set.seed(52) + df <- data.frame( + x1 = rnorm(600, mean = 3, sd = 5), + f1 = factor(sample(letters[1:3], 600, TRUE)) + ) + df$y <- 2 + 0.6 * scale(df$x1) + + ifelse(df$f1 == "b", 0.4, ifelse(df$f1 == "c", -0.3, 0)) + + ifelse(df$f1 == "b", 0.2, ifelse(df$f1 == "c", 0.1, 0)) * scale(df$x1) + + rnorm(600, 0, 0.5) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1) * f1, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1 * f1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x1") + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: two factors with scaled continuous interaction", { + + set.seed(53) + df <- data.frame( + x1 = rnorm(800, mean = 10, sd = 4), + f1 = factor(sample(letters[1:2], 800, TRUE)), + f2 = factor(sample(letters[1:3], 800, TRUE)) + ) + # Complex model with factor-factor and factor-continuous interactions + df$y <- 3 + 0.5 * scale(df$x1) + rnorm(800, 0, 0.6) + + # Fit with scaled predictor - full three-way interaction + fit_scaled <- lm(y ~ scale(x1) * f1 * f2, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1 * f1 * f2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, "x1") + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: complex model with factors and mixed scaling", { + + # Comprehensive test with the user's data structure + set.seed(1) + df <- data.frame( + x1 = rnorm(1000, mean = 3, sd = 5), + x2 = rnorm(1000, mean = -10, sd = 80), + x3 = rnorm(1000, mean = -20, sd = 0.07), + x4 = rnorm(1000, mean = 50, sd = 30), + x5 = rnorm(1000, mean = 20, sd = 0.2), + f1 = factor(sample(letters[1:2], 1000, TRUE)), + f2 = factor(sample(letters[1:3], 1000, TRUE)) + ) + + # Model with scaled continuous, unscaled continuous, and factors + # x1, x2, x3 are scaled; x4, x5 are NOT scaled + df$y <- 5 + + 0.3 * scale(df$x1) - 0.2 * scale(df$x2) + 0.1 * scale(df$x3) + + 0.15 * df$x4 - 0.1 * df$x5 + + ifelse(df$f1 == "b", 0.4, 0) + + 0.2 * scale(df$x1) * ifelse(df$f1 == "b", 1, 0) + + 0.1 * df$x4 * ifelse(df$f1 == "b", 1, 0) + + rnorm(1000, 0, 1) + + # Fit with partial scaling + fit_scaled <- lm(y ~ scale(x1) * f1 + scale(x2) + scale(x3) + x4 * f1 + x5, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * f1 + x2 + x3 + x4 * f1 + x5, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform - only x1, x2, x3 are scaled + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + + +test_that("lm validation: factor interactions with multiple scaled continuous", { + + set.seed(54) + df <- data.frame( + x1 = rnorm(800, mean = 5, sd = 3), + x2 = rnorm(800, mean = -2, sd = 6), + f1 = factor(sample(letters[1:2], 800, TRUE)) + ) + # Continuous-continuous and continuous-factor interactions + df$y <- 2 + + 0.4 * scale(df$x1) - 0.3 * scale(df$x2) + + 0.25 * scale(df$x1) * scale(df$x2) + + ifelse(df$f1 == "b", 0.5, 0) + + 0.15 * scale(df$x1) * ifelse(df$f1 == "b", 1, 0) + + 0.1 * scale(df$x2) * ifelse(df$f1 == "b", 1, 0) + + rnorm(800, 0, 0.5) + + # Fit with scaled predictors - three-way interaction x1 * x2 * f1 + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * f1, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * f1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Transform + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Compare + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) +}) + From 75a2bd4ca1f76656d8e4ce7e6e2f8c485e637462 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 29 Dec 2025 20:35:30 +0100 Subject: [PATCH 18/38] Add log(intercept) attribute support to formula interface Introduces support for a 'log(intercept)' formula attribute in JAGS_formula(), JAGS_evaluate_formula(), and marginal likelihood computation. This enables model syntax of the form log(intercept) + sum(beta_i * x_i), useful for parameters constrained to be positive. Documentation and tests are updated to reflect and verify the new functionality. --- NEWS.md | 1 + R/JAGS-formula.R | 32 +++++++- R/JAGS-marglik.R | 27 +++++-- man/BayesTools_ensemble_tables.Rd | 18 ++++- man/BayesTools_model_tables.Rd | 10 ++- man/JAGS_evaluate_formula.Rd | 4 +- man/JAGS_formula.Rd | 5 +- man/JAGS_marglik_parameters.Rd | 4 + man/transform_scale_samples.Rd | 14 +++- tests/testthat/test-JAGS-formula.R | 103 +++++++++++++++++++++++++- tests/testthat/test-JAGS-marglik.R | 113 +++++++++++++++++++++++++---- 11 files changed, 294 insertions(+), 37 deletions(-) diff --git a/NEWS.md b/NEWS.md index fbceea9..4232891 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ - adds support for `__default_factor` and `__default_continuous` priors in `JAGS_formula()` - when specified in the `prior_list`, these are used as default priors for factor and continuous predictors that are not explicitly specified - adds automatic standardization of continuous predictors via `formula_scale` parameter in `JAGS_formula()` and `JAGS_fit()` - improves MCMC sampling efficiency and numerical stability - adds `transform_scale_samples()` function to transform posterior samples back to original scale after standardization +- adds `log(intercept)` formula attribute for specifying models of the form `log(intercept) + sum(beta_i * x_i)` - useful for parameters that must be positive (e.g., standard deviation) while keeping the intercept on the original scale. Set via `attr(formula, "log(intercept)") <- TRUE`. Supported in `JAGS_formula()`, `JAGS_evaluate_formula()`, and marginal likelihood computation ### Fixes - fixes incorrect ordering the printed mixture priors diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 30e4505..3496fc4 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -7,6 +7,9 @@ #' @param formula formula specifying the right hand side of the assignment (the #' left hand side is ignored). If the formula contains \code{-1}, it will be #' automatically converted to include an intercept with a spike(0) prior. +#' The formula can also have a \code{"log(intercept)"} attribute set to \code{TRUE} +#' to generate syntax of the form \code{log(intercept) + sum(beta_i * x_i)}, which +#' is useful for parameters that must be positive (e.g., standard deviation). #' @param parameter name of the parameter to be created with the formula #' @param data data.frame containing predictors included in the formula #' @param prior_list named list of prior distribution of parameters specified within @@ -105,6 +108,9 @@ JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = N # remove the specified response formula <- .remove_response(formula) + # store log(intercept) attribute (for models relying on mu = log(intercept) + sum(beta_i * x_i) trick + # exp(mu) = intercept * exp(sum(beta_i * x_i)) (e.g., Poisson regression / regression with log link etc...) + log_intercept <- isTRUE(attr(formula, "log(intercept)")) # store expressions (included later as the literal character input) expressions <- .extract_expressions(formula) # store random effects (included later via a formula interface) @@ -279,7 +285,12 @@ JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = N terms_indexes <- attr(model_matrix, "assign") + 1 terms_indexes[1] <- 0 - formula_syntax <- c(formula_syntax, paste0(parameter, "_intercept")) + # use log(intercept) if the formula has the log(intercept) attribute + if(log_intercept){ + formula_syntax <- c(formula_syntax, paste0("log(", parameter, "_intercept)")) + }else{ + formula_syntax <- c(formula_syntax, paste0(parameter, "_intercept")) + } }else{ terms_indexes <- attr(model_matrix, "assign") } @@ -391,6 +402,11 @@ JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = N attr(prior_list[[i]], "parameter") <- parameter } + # preserve log(intercept) attribute on output formula + if(log_intercept){ + attr(formula, "log(intercept)") <- TRUE + } + output <- list( formula_syntax = formula_syntax, data = JAGS_data, @@ -833,7 +849,9 @@ JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = N #' @param fit model fitted with either \link[runjags]{runjags} posterior #' samples obtained with \link[rjags]{rjags-package} #' @param formula formula specifying the right hand side of the assignment (the -#' left hand side is ignored) +#' left hand side is ignored). If the formula has a \code{"log(intercept)"} +#' attribute set to \code{TRUE}, the intercept values will be log-transformed +#' before computing the linear predictor. #' @param parameter name of the parameter created with the formula #' @param data data.frame containing predictors included in the formula #' @param prior_list named list of prior distribution of parameters specified within @@ -967,6 +985,9 @@ JAGS_evaluate_formula <- function(fit, formula, parameter, data, prior_list){ model_matrix <- stats::model.matrix(model_frame, formula = formula, data = data) ### evaluate the design matrix on the samples -> output[data, posterior] + # check for log(intercept) attribute + log_intercept <- isTRUE(attr(formula, "log(intercept)")) + if(has_intercept){ terms_indexes <- attr(model_matrix, "assign") + 1 @@ -975,7 +996,12 @@ JAGS_evaluate_formula <- function(fit, formula, parameter, data, prior_list){ # check for scaling factors temp_multiply_by <- .get_parameter_scaling_factor_matrix(term = "intercept", prior_list = prior_list_formula, posterior = posterior, nrow = nrow(data), ncol = nrow(posterior)) - output <- temp_multiply_by * matrix(posterior[,JAGS_parameter_names("intercept", formula_parameter = parameter)], nrow = nrow(data), ncol = nrow(posterior), byrow = TRUE) + # get intercept values and apply log() transformation if log(intercept) attribute is set + intercept_values <- posterior[,JAGS_parameter_names("intercept", formula_parameter = parameter)] + if(log_intercept){ + intercept_values <- log(intercept_values) + } + output <- temp_multiply_by * matrix(intercept_values, nrow = nrow(data), ncol = nrow(posterior), byrow = TRUE) }else{ diff --git a/R/JAGS-marglik.R b/R/JAGS-marglik.R index 97a5bfc..fac731c 100644 --- a/R/JAGS-marglik.R +++ b/R/JAGS-marglik.R @@ -121,7 +121,7 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU ### define the marglik function - full_log_posterior <- function(samples.row, data, prior_list, formula_data_list, formula_prior_list, add_parameters, ...){ + full_log_posterior <- function(samples.row, data, prior_list, formula_list, formula_data_list, formula_prior_list, add_parameters, ...){ # prepare object for holding the parameters, later accessible to the user specified 'log_posterior' parameters <- list() @@ -129,7 +129,7 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU parameters <- c(parameters, JAGS_marglik_parameters(samples.row, prior_list)) } if(!is.null(formula_prior_list)){ - parameters <- c(parameters, JAGS_marglik_parameters_formula(samples.row, formula_data_list, formula_prior_list, parameters)) + parameters <- c(parameters, JAGS_marglik_parameters_formula(samples.row, formula_list, formula_data_list, formula_prior_list, parameters)) } if(!is.null(add_parameters)){ parameters <- c(parameters, samples.row[add_parameters]) @@ -155,6 +155,7 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU data = data, log_posterior = full_log_posterior, prior_list = prior_list, + formula_list = formula_list, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list, lb = attr(bridgesampling_posterior, "lb"), @@ -941,7 +942,7 @@ JAGS_marglik_parameters <- function(samples, prior_list){ # } #' @rdname JAGS_marglik_parameters -JAGS_marglik_parameters_formula <- function(samples, formula_data_list, formula_prior_list, prior_list_parameters){ +JAGS_marglik_parameters_formula <- function(samples, formula_list, formula_data_list, formula_prior_list, prior_list_parameters){ # return empty list in case that no prior was specified if(length(formula_prior_list) == 0){ @@ -951,13 +952,15 @@ JAGS_marglik_parameters_formula <- function(samples, formula_data_list, for parameters <- list() for(parameter in names(formula_prior_list)){ - parameters[[parameter]] <- .JAGS_marglik_parameters_formula_get(samples, parameter, formula_data_list[[parameter]], formula_prior_list[[parameter]], prior_list_parameters) + # check for log(intercept) attribute on the formula + log_intercept <- if(!is.null(formula_list[[parameter]])) isTRUE(attr(formula_list[[parameter]], "log(intercept)")) else FALSE + parameters[[parameter]] <- .JAGS_marglik_parameters_formula_get(samples, parameter, formula_data_list[[parameter]], formula_prior_list[[parameter]], prior_list_parameters, log_intercept) } return(parameters) } -.JAGS_marglik_parameters_formula_get <- function(samples, parameter, formula_data_list, formula_prior_list, prior_list_parameters){ +.JAGS_marglik_parameters_formula_get <- function(samples, parameter, formula_data_list, formula_prior_list, prior_list_parameters, log_intercept = FALSE){ formula_terms <- names(formula_prior_list) names(formula_data_list) <- gsub("_data", "", names(formula_data_list)) @@ -978,11 +981,21 @@ JAGS_marglik_parameters_formula <- function(samples, formula_data_list, for if(is.prior.point(formula_prior_list[[paste0(parameter, "_intercept")]])){ - output <- multiply_by * rep(formula_prior_list[[paste0(parameter, "_intercept")]][["parameters"]][["location"]], formula_data_list[[paste0("N_", parameter)]]) + intercept_value <- formula_prior_list[[paste0(parameter, "_intercept")]][["parameters"]][["location"]] + # apply log transformation if log(intercept) attribute is set + if(log_intercept){ + intercept_value <- log(intercept_value) + } + output <- multiply_by * rep(intercept_value, formula_data_list[[paste0("N_", parameter)]]) }else{ - output <- multiply_by * rep(samples[[paste0(parameter, "_intercept")]], formula_data_list[[paste0("N_", parameter)]]) + intercept_value <- samples[[paste0(parameter, "_intercept")]] + # apply log transformation if log(intercept) attribute is set + if(log_intercept){ + intercept_value <- log(intercept_value) + } + output <- multiply_by * rep(intercept_value, formula_data_list[[paste0("N_", parameter)]]) } diff --git a/man/BayesTools_ensemble_tables.Rd b/man/BayesTools_ensemble_tables.Rd index 0eafbea..1f8ec83 100644 --- a/man/BayesTools_ensemble_tables.Rd +++ b/man/BayesTools_ensemble_tables.Rd @@ -22,7 +22,9 @@ ensemble_estimates_table( warnings = NULL, transform_factors = FALSE, transform_orthonormal = FALSE, - formula_prefix = TRUE + formula_prefix = TRUE, + transform_scaled = FALSE, + formula_scale = NULL ) ensemble_inference_table( @@ -84,7 +86,9 @@ marginal_estimates_table( title = NULL, footnotes = NULL, warnings = NULL, - formula_prefix = TRUE + formula_prefix = TRUE, + transform_scaled = FALSE, + formula_scale = NULL ) } \arguments{ @@ -114,6 +118,16 @@ differences from the grand mean} \item{formula_prefix}{whether the parameter prefix from formula should be printed. Defaults to \code{TRUE}.} +\item{transform_scaled}{whether coefficients from standardized +continuous predictors should be transformed back to the original +scale. Defaults to \code{FALSE}.} + +\item{formula_scale}{named list containing standardization information +(mean and sd) for each standardized predictor. Required when +\code{transform_scaled = TRUE} for ensemble/marginal tables. For +\code{runjags_estimates_table}, this is automatically extracted from +the fit object's \code{formula_scale} attribute.} + \item{inference}{model inference created by \link{ensemble_inference}} \item{logBF}{whether the Bayes factor should be on log scale} diff --git a/man/BayesTools_model_tables.Rd b/man/BayesTools_model_tables.Rd index 4836c9d..20a9062 100644 --- a/man/BayesTools_model_tables.Rd +++ b/man/BayesTools_model_tables.Rd @@ -41,7 +41,8 @@ runjags_estimates_table( formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, - return_samples = FALSE + return_samples = FALSE, + transform_scaled = FALSE ) runjags_inference_table( @@ -65,7 +66,8 @@ JAGS_estimates_table( formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, - return_samples = FALSE + return_samples = FALSE, + transform_scaled = FALSE ) JAGS_inference_table( @@ -161,6 +163,10 @@ should be excluded from the summary table. Defaults to \code{FALSE}.} \item{return_samples}{whether to return the transoformed and formated samples instead of the table. Defaults to \code{FALSE}.} + +\item{transform_scaled}{whether coefficients from standardized +continuous predictors should be transformed back to the original +scale. Defaults to \code{FALSE}.} } \value{ \code{model_summary_table} returns a table with diff --git a/man/JAGS_evaluate_formula.Rd b/man/JAGS_evaluate_formula.Rd index a6f8b7e..e066d4d 100644 --- a/man/JAGS_evaluate_formula.Rd +++ b/man/JAGS_evaluate_formula.Rd @@ -11,7 +11,9 @@ JAGS_evaluate_formula(fit, formula, parameter, data, prior_list) samples obtained with \link[rjags]{rjags-package}} \item{formula}{formula specifying the right hand side of the assignment (the -left hand side is ignored)} +left hand side is ignored). If the formula has a \code{"log(intercept)"} +attribute set to \code{TRUE}, the intercept values will be log-transformed +before computing the linear predictor.} \item{parameter}{name of the parameter created with the formula} diff --git a/man/JAGS_formula.Rd b/man/JAGS_formula.Rd index 6adbe25..8c263ea 100644 --- a/man/JAGS_formula.Rd +++ b/man/JAGS_formula.Rd @@ -9,7 +9,10 @@ JAGS_formula(formula, parameter, data, prior_list, formula_scale = NULL) \arguments{ \item{formula}{formula specifying the right hand side of the assignment (the left hand side is ignored). If the formula contains \code{-1}, it will be -automatically converted to include an intercept with a spike(0) prior.} +automatically converted to include an intercept with a spike(0) prior. +The formula can also have a \code{"log(intercept)"} attribute set to \code{TRUE} +to generate syntax of the form \code{log(intercept) + sum(beta_i * x_i)}, which +is useful for parameters that must be positive (e.g., standard deviation).} \item{parameter}{name of the parameter to be created with the formula} diff --git a/man/JAGS_marglik_parameters.Rd b/man/JAGS_marglik_parameters.Rd index fa7f224..5bb37e1 100644 --- a/man/JAGS_marglik_parameters.Rd +++ b/man/JAGS_marglik_parameters.Rd @@ -9,6 +9,7 @@ JAGS_marglik_parameters(samples, prior_list) JAGS_marglik_parameters_formula( samples, + formula_list, formula_data_list, formula_prior_list, prior_list_parameters @@ -22,6 +23,9 @@ function} (names correspond to the parameter names) of parameters not specified within the \code{formula_list}} +\item{formula_list}{named list of formulas to be added to the model +(names correspond to the parameter name created by each of the formula)} + \item{formula_data_list}{named list of data frames containing data for each formula (names of the lists correspond to the parameter name created by each of the formula)} diff --git a/man/transform_scale_samples.Rd b/man/transform_scale_samples.Rd index ba60d3c..1478928 100644 --- a/man/transform_scale_samples.Rd +++ b/man/transform_scale_samples.Rd @@ -8,7 +8,7 @@ transform_scale_samples(fit, formula_scale = NULL) } \arguments{ \item{fit}{a fitted model object with \code{formula_scale} attribute, or -a list of posterior samples} +a matrix of posterior samples} \item{formula_scale}{named list containing standardization information (mean and sd) for each standardized predictor. If \code{fit} is provided @@ -25,9 +25,15 @@ were standardized during model fitting via the \code{formula_scale} parameter. } \details{ The function transforms regression coefficients and intercepts -to account for predictor standardization. For a standardized coefficient -\eqn{\beta_z}, the original scale coefficient is \eqn{\beta = \beta_z / sd}. -The intercept is adjusted as: \eqn{\alpha = \alpha_z - \sum(\beta_z * mean / sd)}. +to account for predictor standardization using a combinatorial approach that +correctly handles interactions of any order. + +For a k-way interaction between standardized predictors, the expansion of +\eqn{\prod_{i} (x_i - \mu_i)/\sigma_i} contributes to all lower-order terms. +The contribution to a target term T from a source term S (where T is a subset +of S's scaled components) is: +\deqn{(-1)^{|extra|} \cdot \prod_{i \in extra} \mu_i / \prod_{i \in S_{scaled}} \sigma_i} +where \eqn{extra = S_{scaled} \setminus T_{scaled}}. } \seealso{ \code{\link[=JAGS_formula]{JAGS_formula()}} \code{\link[=JAGS_fit]{JAGS_fit()}} diff --git a/tests/testthat/test-JAGS-formula.R b/tests/testthat/test-JAGS-formula.R index 806211b..25119b5 100644 --- a/tests/testthat/test-JAGS-formula.R +++ b/tests/testthat/test-JAGS-formula.R @@ -172,7 +172,6 @@ test_that("JAGS evaluate formula works", { "Levels specified in the 'x_fac2t' factor variable do not match the levels used for model specification.") }) - test_that("JAGS evaluate formula works with spike priors", { # Test JAGS_evaluate_formula with spike prior distributions using pre-fitted model @@ -211,7 +210,6 @@ test_that("JAGS evaluate formula works with spike priors", { expect_equal(new_samples_mean[3], 3, tolerance = 0.01, ignore_attr = TRUE) }) - test_that("JAGS evaluate formula works with spike-and-slab and mixture priors", { # Test JAGS_evaluate_formula with spike-and-slab and mixture priors using pre-fitted model @@ -350,6 +348,107 @@ test_that("-1 (no intercept) formula handling works correctly", { }) +test_that("log(intercept) attribute works for specifying log(int) + sum(beta_i * x_i) models", { + + # this is helpful for specifying models for e.g., standard deviation where the output must be positive, + # but we want the intercept to be specified on the original scale - we can take exp() of the whole formula output + + # setup test data + set.seed(1) + df_test <- data.frame( + x_fac3md = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), + x_fac3i = factor(rep(c("A", "B", "C"), 20), levels = c("A", "B", "C")), + x_cont = rnorm(60) + ) + + # Test 1: Basic -1 formula functionality + prior_list_basic <- list( + "intercept" = prior("normal", list(0, 1)), + "x_fac3md" = prior_factor("mnormal", contrast = "meandif", list(0, 1)) + ) + + # no log intercept + result_basic <- JAGS_formula(~ 1 + x_fac3md, parameter = "mu", + data = df_test[, "x_fac3md", drop = FALSE], + prior_list = prior_list_basic) + + # log intercept + formula <- ~ 1 + x_fac3md + attr(formula, "log(intercept)") <- TRUE + result_log <- JAGS_formula(formula, parameter = "mu", + data = df_test[, "x_fac3md", drop = FALSE], + prior_list = prior_list_basic) + + # generates normal intercept + expect_equal( + result_basic[["formula_syntax"]], + "for(i in 1:N_mu){\n mu[i] = mu_intercept + inprod(mu_x_fac3md, mu_data_x_fac3md[i,])\n}\n" + ) + + # generates log intercept + expect_equal( + result_log[["formula_syntax"]], + "for(i in 1:N_mu){\n mu[i] = log(mu_intercept) + inprod(mu_x_fac3md, mu_data_x_fac3md[i,])\n}\n" + ) + + # everything else should match + result_basic[["formula_syntax"]] <- NULL + result_log[["formula_syntax"]] <- NULL + result_basic[["formula"]] <- NULL + result_log[["formula"]] <- NULL + expect_equal(result_basic, result_log) +}) + +test_that("JAGS_evaluate_formula works with log(intercept) attribute", { + + # Test that JAGS_evaluate_formula correctly applies log() transformation to intercept + # when the formula has the log(intercept) attribute set + + skip_if_not_installed("coda") + + # Setup: simple data for testing + set.seed(1) + df_test <- data.frame( + x_cont = rnorm(10) + ) + + # Create prior list with gamma prior for intercept (must be positive for log) + prior_list <- list( + "intercept" = prior("gamma", list(2, 1)), + "x_cont" = prior("normal", list(0, 1)) + ) + + # Process formula to get prior_list with parameter names + formula_result <- JAGS_formula(~ x_cont, parameter = "mu", data = df_test, prior_list = prior_list) + prior_list_processed <- formula_result$prior_list + + + # Create mock samples: intercept = 2, x_cont = 0.5 + samples <- matrix(c(2, 0.5), nrow = 1) + colnames(samples) <- c("mu_intercept", "mu_x_cont") + samples <- coda::as.mcmc.list(coda::as.mcmc(samples)) + + # New data for prediction + new_data <- data.frame(x_cont = c(0, 1, -1)) + + # Test without log(intercept): result = intercept + x_cont * data + # For x_cont = 0: result = 2 + 0.5 * 0 = 2 + # For x_cont = 1: result = 2 + 0.5 * 1 = 2.5 + # For x_cont = -1: result = 2 + 0.5 * (-1) = 1.5 + formula_no_log <- ~ x_cont + result_no_log <- JAGS_evaluate_formula(samples, formula_no_log, "mu", new_data, prior_list_processed) + expect_equal(as.vector(result_no_log[,1]), c(2, 2.5, 1.5), tolerance = 1e-10) + + # Test with log(intercept): result = log(intercept) + x_cont * data + # For x_cont = 0: result = log(2) + 0.5 * 0 = log(2) + # For x_cont = 1: result = log(2) + 0.5 * 1 = log(2) + 0.5 + # For x_cont = -1: result = log(2) + 0.5 * (-1) = log(2) - 0.5 + formula_log <- ~ x_cont + attr(formula_log, "log(intercept)") <- TRUE + result_log <- JAGS_evaluate_formula(samples, formula_log, "mu", new_data, prior_list_processed) + expect_equal(as.vector(result_log[,1]), c(log(2), log(2) + 0.5, log(2) - 0.5), tolerance = 1e-10) +}) + test_that("Default priors (__default_factor and __default_continuous) work correctly", { # setup test data diff --git a/tests/testthat/test-JAGS-marglik.R b/tests/testthat/test-JAGS-marglik.R index c5a17da..692285a 100644 --- a/tests/testthat/test-JAGS-marglik.R +++ b/tests/testthat/test-JAGS-marglik.R @@ -21,6 +21,9 @@ # TAGS: @evaluation, @JAGS, @marginal-likelihood # ============================================================================ # +# Load common test helpers +source(testthat::test_path("common-functions.R")) + # This file tests the JAGS marginal likelihood computation functions # It uses simple models where the log marginal likelihood is known to be 0 # (for prior samples, the marginal likelihood for any proper prior is 1, log(1) = 0) @@ -234,6 +237,101 @@ test_that("bridge sampling object function works",{ }) +test_that("JAGS marglik with formula works", { + + # Test marginal likelihood computation with formula interface + # Uses intercept-only formula with various priors + # When sampling from prior and computing marglik, the result should be ~0 (log(1)) + + skip_if_not_installed("rjags") + + # Simple data for the formula + set.seed(1) + df_test <- data.frame(x = rnorm(10)) + log_posterior <- STANDARD_LOG_POSTERIOR + + # Create formula prior list with intercept only + prior_list <- list( + "intercept" = prior("gamma", list(2, 2)), + "x" = prior("normal", list(0, 1)) + ) + + # Process formula to get JAGS syntax + formula_result <- JAGS_formula(~ 1 + x, parameter = "mu", data = df_test, prior_list = prior_list) + + # Build JAGS model with formula priors + model_syntax <- JAGS_add_priors("model{}", formula_result$prior_list) + monitor <- JAGS_to_monitor(formula_result$prior_list) + inits <- JAGS_get_inits(formula_result$prior_list, chains = 2, seed = 1) + + # Sample from prior using JAGS + set.seed(1) + model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) + samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") + + # Compute marginal likelihood using formula interface + marglik <- JAGS_bridgesampling( + fit = samples, + log_posterior = log_posterior, + data = list(), + prior_list = NULL, + formula_list = list(mu = ~ 1 + x), + formula_data_list = list(mu = df_test), + formula_prior_list = list(mu = prior_list) + ) + + expect_equal(marglik$logml, 0, tolerance = 1e-3) +}) + +test_that("JAGS marglik with exp(intercept) formula works", { + + # Test marginal likelihood computation with formula interface + # Uses intercept-only formula with various priors + # When sampling from prior and computing marglik, the result should be ~0 (log(1)) + + skip_if_not_installed("rjags") + + # Simple data for the formula + set.seed(1) + df_test <- data.frame(x = rnorm(10)) + log_posterior <- STANDARD_LOG_POSTERIOR + + # Create formula prior list with intercept only + prior_list <- list( + "intercept" = prior("gamma", list(2, 2)), + "x" = prior("normal", list(0, 1)) + ) + + # Process formula to get JAGS syntax + formula <- ~ 1 + x + attr(formula, "log(intercept)") <- TRUE + formula_result <- JAGS_formula(formula, parameter = "mu", data = df_test, prior_list = prior_list) + expect_equal(formula_result$formula_syntax, "for(i in 1:N_mu){\n mu[i] = log(mu_intercept) + mu_x * mu_data_x[i]\n}\n") + + # Build JAGS model with formula priors + model_syntax <- JAGS_add_priors("model{}", formula_result$prior_list) + monitor <- JAGS_to_monitor(formula_result$prior_list) + inits <- JAGS_get_inits(formula_result$prior_list, chains = 2, seed = 1) + + # Sample from prior using JAGS + set.seed(1) + model <- rjags::jags.model(file = textConnection(model_syntax), inits = inits, n.chains = 2, quiet = TRUE) + samples <- rjags::coda.samples(model = model, variable.names = monitor, n.iter = 5000, quiet = TRUE, progress.bar = "none") + + # Compute marginal likelihood using formula interface + marglik <- JAGS_bridgesampling( + fit = samples, + log_posterior = log_posterior, + data = list(), + prior_list = NULL, + formula_list = list(mu = formula), + formula_data_list = list(mu = df_test), + formula_prior_list = list(mu = prior_list) + ) + + expect_equal(marglik$logml, 0, tolerance = 1e-3) +}) + # Targeted tests for uncovered code paths in JAGS-marglik.R @@ -276,7 +374,6 @@ test_that("JAGS_bridgesampling_posterior input validation works", { }) - test_that("JAGS_marglik_priors input validation and edge cases work", { # Empty prior_list returns empty list @@ -290,7 +387,6 @@ test_that("JAGS_marglik_priors input validation and edge cases work", { }) - test_that("JAGS_marglik_parameters input validation and edge cases work", { # Test: empty prior_list returns empty list @@ -317,16 +413,6 @@ test_that("JAGS_marglik_parameters input validation and edge cases work", { }) - -test_that("JAGS_marglik_parameters_formula works", { - - # Test: empty formula_prior_list returns empty list - result <- JAGS_marglik_parameters_formula(list(), list(), list(), list()) - expect_equal(result, list()) - -}) - - test_that(".fit_to_posterior handles different input types", { skip_if_not_installed("rjags") @@ -356,7 +442,6 @@ test_that(".fit_to_posterior handles different input types", { }) - test_that(".fit_to_posterior handles jags.samples output", { skip_if_not_installed("rjags") @@ -376,7 +461,6 @@ test_that(".fit_to_posterior handles jags.samples output", { }) - test_that(".fit_to_posterior handles vector parameters in jags.samples", { skip_if_not_installed("rjags") @@ -396,7 +480,6 @@ test_that(".fit_to_posterior handles vector parameters in jags.samples", { }) - test_that("JAGS_bridgesampling handles runjags output", { skip_if_not_installed("runjags") From db49e6777d1c5d43207b144a0e0aa04129a61acc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 29 Dec 2025 21:38:53 +0100 Subject: [PATCH 19/38] fix scaling with multiple formulas --- R/JAGS-fit.R | 4 +- R/JAGS-formula.R | 61 +++--- tests/testthat/test-00-model-fits.R | 111 +++++++++++ tests/testthat/test-JAGS-formula-scale.R | 244 ++++++++++++++++++++--- 4 files changed, 367 insertions(+), 53 deletions(-) diff --git a/R/JAGS-fit.R b/R/JAGS-fit.R index 66a534f..7bb8c4f 100644 --- a/R/JAGS-fit.R +++ b/R/JAGS-fit.R @@ -288,7 +288,9 @@ JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list attr(fit, "model_syntax") <- model_syntax attr(fit, "required_packages") <- required_packages if(!is.null(formula_scale_info)){ - attr(fit, "formula_scale") <- do.call(c, unname(formula_scale_info)) + # Keep formula_scale as a nested list keyed by parameter name + # Each element contains the scaling info for that parameter's predictors + attr(fit, "formula_scale") <- formula_scale_info } class(fit) <- c(class(fit), "BayesTools_fit") diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 3496fc4..8ad949b 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -968,13 +968,17 @@ JAGS_evaluate_formula <- function(fit, formula, parameter, data, prior_list){ # apply scaling if predictors were scaled during model fitting formula_scale <- attr(fit, "formula_scale") if(!is.null(formula_scale)){ - for(continuous in names(predictors_type[predictors_type == "continuous"])){ - # check if this predictor was scaled (with parameter prefix) - scaled_name <- paste0(parameter, "_", continuous) - if(scaled_name %in% names(formula_scale)){ - # apply the same scaling transformation - scale_info <- formula_scale[[scaled_name]] - data[, continuous] <- (data[, continuous] - scale_info$mean) / scale_info$sd + # Handle nested structure: formula_scale[[parameter]] contains the scaling info + param_scale <- formula_scale[[parameter]] + if(!is.null(param_scale)){ + for(continuous in names(predictors_type[predictors_type == "continuous"])){ + # check if this predictor was scaled (with parameter prefix) + scaled_name <- paste0(parameter, "_", continuous) + if(scaled_name %in% names(param_scale)){ + # apply the same scaling transformation + scale_info <- param_scale[[scaled_name]] + data[, continuous] <- (data[, continuous] - scale_info$mean) / scale_info$sd + } } } } @@ -1328,29 +1332,35 @@ transform_treatment_samples <- function(samples){ # Helper: Apply unscaling transformation to a matrix of posterior samples # # @param posterior Matrix with samples in rows, parameters in columns -# @param formula_scale Named list with scaling info -# @param prefix Parameter prefix (default: auto-detect from formula_scale names) +# Apply the unscaling transformation to posterior samples +# +# @param posterior Matrix of posterior samples with parameter names as column names +# @param formula_scale Nested list with scaling info keyed by parameter name: +# list(mu = list(mu_x1 = list(mean, sd)), log_sigma = list(log_sigma_x = list(mean, sd))) # @return Transformed posterior matrix -.apply_unscale_transform <- function(posterior, formula_scale, prefix = NULL) { +.apply_unscale_transform <- function(posterior, formula_scale) { if (is.null(formula_scale) || length(formula_scale) == 0) { return(posterior) } - # Auto-detect prefix if not provided - if (is.null(prefix)) { - # First try the parameter attribute - prefix <- attr(formula_scale, "parameter") - # Fallback: parse from names - if (is.null(prefix) && length(names(formula_scale)) > 0) { - first_name <- names(formula_scale)[1] - # Extract prefix from "mu_x1" -> "mu" - prefix <- sub("_.*$", "", first_name) - } + # Handle nested structure: iterate over each parameter + for (param_name in names(formula_scale)) { + param_scale <- formula_scale[[param_name]] + posterior <- .apply_unscale_transform_single(posterior, param_scale, prefix = param_name) } + + return(posterior) +} + +# Helper: Apply unscaling for a single parameter's predictors +# @param posterior Matrix of posterior samples +# @param formula_scale Flat list of scaling info: list(mu_x1 = list(mean, sd), mu_x2 = list(mean, sd)) +# @param prefix Parameter prefix (e.g., "mu") +# @return Transformed posterior matrix +.apply_unscale_transform_single <- function(posterior, formula_scale, prefix) { - if (is.null(prefix)) { - warning("Could not detect parameter prefix from formula_scale. Returning unchanged.") + if (is.null(formula_scale) || length(formula_scale) == 0) { return(posterior) } @@ -1388,9 +1398,10 @@ transform_treatment_samples <- function(samples){ #' #' @param fit a fitted model object with \code{formula_scale} attribute, or #' a matrix of posterior samples -#' @param formula_scale named list containing standardization information -#' (mean and sd) for each standardized predictor. If \code{fit} is provided -#' and has a \code{formula_scale} attribute, this will be used automatically. +#' @param formula_scale nested list containing standardization information keyed by +#' parameter name. Each parameter entry contains scaling info (mean and sd) for +#' each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}. +#' If \code{fit} is provided and has a \code{formula_scale} attribute, this will be used automatically. #' #' @details The function transforms regression coefficients and intercepts #' to account for predictor standardization using a combinatorial approach that diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index d76ca9d..000af9a 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -2102,6 +2102,117 @@ test_that("Complex models for plotting fit correctly", { }) +# ============================================================================ # +# SECTION 4: DUAL PARAMETER REGRESSION WITH LOG(INTERCEPT) AND FORMULA_SCALE +# ============================================================================ # +test_that("Dual parameter regression with log(intercept) and formula_scale fits correctly", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + set.seed(1) + + # Generate data with heteroscedastic variance + n <- 100 + data_formula_dual <- data.frame( + x_mu = rnorm(n, mean = 5, sd = 2), + x_sigma = rnorm(n, mean = 3, sd = 1.5) + ) + + # True parameters: mu = 1 + 0.3 * x_mu, log(sigma) = log(0.5) + 0.2 * x_sigma + true_mu <- 1 + 0.3 * scale(data_formula_dual$x_mu)[,1] + true_sigma <- exp(log(0.5) + 0.2 * scale(data_formula_dual$x_sigma)[,1]) + y <- rnorm(n, mean = true_mu, sd = true_sigma) + + data_dual <- list(y = y, N = n) + + # Formula for mu (standard intercept) + formula_mu <- ~ x_mu + + # Formula for log_sigma with log(intercept) attribute + formula_log_sigma <- ~ x_sigma + attr(formula_log_sigma, "log(intercept)") <- TRUE + + formula_list_dual <- list( + mu = formula_mu, + log_sigma = formula_log_sigma + ) + + formula_data_list_dual <- list( + mu = data_formula_dual, + log_sigma = data_formula_dual + ) + + # Scale both continuous predictors + formula_scale_list_dual <- list( + mu = list(x_mu = TRUE), + log_sigma = list(x_sigma = TRUE) + ) + + formula_prior_list_dual <- list( + mu = list( + "intercept" = prior("normal", list(0, 2)), + "x_mu" = prior("normal", list(0, 1)) + ), + log_sigma = list( + "intercept" = prior("lognormal", list(0, 0.5)), # Must be positive for log() + "x_sigma" = prior("normal", list(0, 0.5)) + ) + ) + + # Model syntax uses exp() on log_sigma to get positive sigma + model_syntax_dual <- paste0( + "model{\n", + "for(i in 1:N){\n", + " y[i] ~ dnorm(mu[i], 1/pow(exp(log_sigma[i]), 2))\n", + "}\n", + "}" + ) + + # Log posterior for marginal likelihood + log_posterior_dual <- function(parameters, data){ + sigma <- exp(parameters[["log_sigma"]]) + sum(stats::dnorm(data$y, parameters[["mu"]], sigma, log = TRUE)) + } + + fit_dual_param_regression <- JAGS_fit( + model_syntax = model_syntax_dual, + data = data_dual, + prior_list = NULL, + formula_list = formula_list_dual, + formula_data_list = formula_data_list_dual, + formula_prior_list = formula_prior_list_dual, + formula_scale_list = formula_scale_list_dual, + chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 1) + + marglik_dual_param_regression <- JAGS_bridgesampling( + fit = fit_dual_param_regression, + log_posterior = log_posterior_dual, + data = data_dual, + prior_list = NULL, + formula_list = formula_list_dual, + formula_data_list = formula_data_list_dual, + formula_prior_list = formula_prior_list_dual, + formula_scale_list = formula_scale_list_dual) + + result <- save_fit(fit_dual_param_regression, "fit_dual_param_regression", + marglik = marglik_dual_param_regression, + formulas = TRUE, simple_priors = TRUE, + note = "Dual parameter regression: mu and log_sigma with log(intercept) and formula_scale") + model_registry[["fit_dual_param_regression"]] <<- result$registry_entry + fit_dual_param_regression <- result$fit + + # Verify the model has the expected structure + expect_true("mu_intercept" %in% colnames(fit_dual_param_regression$mcmc[[1]])) + expect_true("mu_x_mu" %in% colnames(fit_dual_param_regression$mcmc[[1]])) + expect_true("log_sigma_intercept" %in% colnames(fit_dual_param_regression$mcmc[[1]])) + expect_true("log_sigma_x_sigma" %in% colnames(fit_dual_param_regression$mcmc[[1]])) + + expect_true(file.exists(file.path(temp_fits_dir, "fit_dual_param_regression.RDS"))) + expect_true(file.exists(file.path(temp_fits_dir, "fit_dual_param_regression_marglik.RDS"))) +}) + + # ============================================================================ # # SAVE MODEL REGISTRY # ============================================================================ # diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index 9ce30d8..fd1ce78 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -174,8 +174,11 @@ test_that("transform_scale_samples transforms coefficients correctly", { colnames(posterior) <- c("mu_intercept", "mu_x_cont", "mu_x_fac") # Scale information (x_cont was standardized with mean=5, sd=2) + # Use nested structure keyed by parameter name formula_scale <- list( - mu_x_cont = list(mean = 5, sd = 2) + mu = list( + mu_x_cont = list(mean = 5, sd = 2) + ) ) # Transform back to original scale @@ -213,10 +216,12 @@ test_that("transform_scale_samples handles interaction terms correctly", { ) colnames(posterior) <- c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2") - # Scale information + # Scale information - use nested structure keyed by parameter name formula_scale <- list( - mu_x1 = list(mean = 5, sd = 2), - mu_x2 = list(mean = 10, sd = 4) + mu = list( + mu_x1 = list(mean = 5, sd = 2), + mu_x2 = list(mean = 10, sd = 4) + ) ) # Transform back to original scale @@ -256,10 +261,11 @@ test_that("Manual and automatic scaling produce equivalent results", { fit_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled.RDS")) fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) - # Check that automatic scaling has formula_scale attribute + # Check that automatic scaling has formula_scale attribute with nested structure expect_true(!is.null(attr(fit_auto, "formula_scale"))) - expect_true("mu_x_cont1" %in% names(attr(fit_auto, "formula_scale"))) - expect_true("mu_x_cont2" %in% names(attr(fit_auto, "formula_scale"))) + expect_true("mu" %in% names(attr(fit_auto, "formula_scale"))) + expect_true("mu_x_cont1" %in% names(attr(fit_auto, "formula_scale")$mu)) + expect_true("mu_x_cont2" %in% names(attr(fit_auto, "formula_scale")$mu)) # Check that manual scaling has the scale info stored expect_true(!is.null(attr(fit_manual, "manual_scale"))) @@ -267,7 +273,7 @@ test_that("Manual and automatic scaling produce equivalent results", { # Compare scaling parameters # The automatic and manual scaling should have stored the same mean/sd manual_scale <- attr(fit_manual, "manual_scale") - auto_scale <- attr(fit_auto, "formula_scale") + auto_scale <- attr(fit_auto, "formula_scale")$mu expect_equal(manual_scale$mu_x_cont1$mean, auto_scale$mu_x_cont1$mean, tolerance = 1e-10) expect_equal(manual_scale$mu_x_cont1$sd, auto_scale$mu_x_cont1$sd, tolerance = 1e-10) @@ -422,11 +428,11 @@ test_that("runjags_estimates_table with transform_scaled unscales coefficients", estimates_unscaled <- JAGS_estimates_table(fit_auto, transform_scaled = TRUE) # The scaled coefficient for x_cont1 should be divided by sd - # to get the unscaled coefficient - sd_x_cont1 <- formula_scale$mu_x_cont1$sd - sd_x_cont2 <- formula_scale$mu_x_cont2$sd - mean_x_cont1 <- formula_scale$mu_x_cont1$mean - mean_x_cont2 <- formula_scale$mu_x_cont2$mean + # to get the unscaled coefficient (nested structure: formula_scale$mu$...) + sd_x_cont1 <- formula_scale$mu$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu$mu_x_cont2$mean # Check that the interaction term is correctly unscaled (divided by product of SDs) scaled_coef_int <- estimates_scaled["(mu) x_cont1:x_cont2", "Mean"] @@ -465,11 +471,11 @@ test_that("runjags_estimates_table transform_scaled with return_samples works", # Get samples with unscaling samples_unscaled <- JAGS_estimates_table(fit_auto, transform_scaled = TRUE, return_samples = TRUE) - # For models with interactions, the transformation is more complex - sd_x_cont1 <- formula_scale$mu_x_cont1$sd - sd_x_cont2 <- formula_scale$mu_x_cont2$sd - mean_x_cont1 <- formula_scale$mu_x_cont1$mean - mean_x_cont2 <- formula_scale$mu_x_cont2$mean + # For models with interactions, the transformation is more complex (nested structure) + sd_x_cont1 <- formula_scale$mu$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu$mu_x_cont2$mean # First, compute the unscaled interaction coefficient unscaled_int <- samples_scaled[, "(mu) x_cont1:x_cont2"] / (sd_x_cont1 * sd_x_cont2) @@ -532,11 +538,11 @@ test_that("ensemble_estimates_table with transform_scaled unscales coefficients" formula_scale = formula_scale ) - # For models with interactions, the transformation is more complex - sd_x_cont1 <- formula_scale$mu_x_cont1$sd - sd_x_cont2 <- formula_scale$mu_x_cont2$sd - mean_x_cont1 <- formula_scale$mu_x_cont1$mean - mean_x_cont2 <- formula_scale$mu_x_cont2$mean + # For models with interactions, the transformation is more complex (nested structure) + sd_x_cont1 <- formula_scale$mu$mu_x_cont1$sd + sd_x_cont2 <- formula_scale$mu$mu_x_cont2$sd + mean_x_cont1 <- formula_scale$mu$mu_x_cont1$mean + mean_x_cont2 <- formula_scale$mu$mu_x_cont2$mean # Check that the interaction term is correctly unscaled (divided by product of SDs) scaled_coef_int <- estimates_scaled["(mu) x_cont1:x_cont2", "Mean"] @@ -583,6 +589,188 @@ test_that("transform_scaled has no effect when formula_scale is NULL", { }) +# ============================================================================ # +# DUAL PARAMETER REGRESSION WITH LOG(INTERCEPT) TESTS +# ============================================================================ # + +test_that("Dual parameter model with log(intercept) has correct formula_scale structure", { + + skip_if_no_fits() + + # Load pre-fitted dual parameter regression model + fit_dual <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + + # Check that formula_scale attribute exists + formula_scale <- attr(fit_dual, "formula_scale") + expect_true(!is.null(formula_scale)) + + + # Check that both parameters have scaling info + expect_true("mu" %in% names(formula_scale)) + expect_true("log_sigma" %in% names(formula_scale)) + + # Check nested structure + expect_true("mu_x_mu" %in% names(formula_scale$mu)) + expect_true("log_sigma_x_sigma" %in% names(formula_scale$log_sigma)) + + # Verify scale info structure for mu parameter + expect_equal(names(formula_scale$mu$mu_x_mu), c("mean", "sd")) + expect_true(is.numeric(formula_scale$mu$mu_x_mu$mean)) + expect_true(is.numeric(formula_scale$mu$mu_x_mu$sd)) + + # Verify scale info structure for log_sigma parameter + expect_equal(names(formula_scale$log_sigma$log_sigma_x_sigma), c("mean", "sd")) + expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$mean)) + expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$sd)) + + # Verify the model has expected parameters + param_names <- colnames(fit_dual$mcmc[[1]]) + expect_true("mu_intercept" %in% param_names) + expect_true("mu_x_mu" %in% param_names) + expect_true("log_sigma_intercept" %in% param_names) + expect_true("log_sigma_x_sigma" %in% param_names) +}) + +test_that("transform_scale_samples works with dual parameter model", { + + skip_if_no_fits() + + # Load pre-fitted dual parameter regression model + fit_dual <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + formula_scale <- attr(fit_dual, "formula_scale") + + # Extract posterior samples + posterior <- as.matrix(fit_dual$mcmc[[1]]) + + # Transform to original scale + posterior_transformed <- transform_scale_samples(posterior, formula_scale) + + # Get scale parameters (nested structure) + mu_scale <- formula_scale$mu$mu_x_mu + log_sigma_scale <- formula_scale$log_sigma$log_sigma_x_sigma + + # Check mu_x_mu coefficient is correctly unscaled (divided by sd) + expected_mu_x_mu <- posterior[, "mu_x_mu"] / mu_scale$sd + expect_equal(posterior_transformed[, "mu_x_mu"], expected_mu_x_mu, tolerance = 1e-10) + + # Check log_sigma_x_sigma coefficient is correctly unscaled (divided by sd) + expected_log_sigma_x_sigma <- posterior[, "log_sigma_x_sigma"] / log_sigma_scale$sd + expect_equal(posterior_transformed[, "log_sigma_x_sigma"], expected_log_sigma_x_sigma, tolerance = 1e-10) + + # Check mu intercept is adjusted: intercept_orig = intercept_z - beta_orig * mean + expected_mu_intercept <- posterior[, "mu_intercept"] - expected_mu_x_mu * mu_scale$mean + expect_equal(posterior_transformed[, "mu_intercept"], expected_mu_intercept, tolerance = 1e-10) + + # Check log_sigma intercept is adjusted: intercept_orig = intercept_z - beta_orig * mean + expected_log_sigma_intercept <- posterior[, "log_sigma_intercept"] - expected_log_sigma_x_sigma * log_sigma_scale$mean + expect_equal(posterior_transformed[, "log_sigma_intercept"], expected_log_sigma_intercept, tolerance = 1e-10) +}) + +test_that("JAGS_estimates_table with transform_scaled works for dual parameter model", { + + skip_if_no_fits() + + # Load pre-fitted dual parameter regression model + fit_dual <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + formula_scale <- attr(fit_dual, "formula_scale") + + # Get estimates without unscaling + estimates_scaled <- JAGS_estimates_table(fit_dual, transform_scaled = FALSE) + + # Get estimates with unscaling + estimates_unscaled <- JAGS_estimates_table(fit_dual, transform_scaled = TRUE) + + # Get scale parameters (nested structure) + mu_sd <- formula_scale$mu$mu_x_mu$sd + mu_mean <- formula_scale$mu$mu_x_mu$mean + log_sigma_sd <- formula_scale$log_sigma$log_sigma_x_sigma$sd + log_sigma_mean <- formula_scale$log_sigma$log_sigma_x_sigma$mean + + # Check mu_x_mu coefficient is correctly unscaled + scaled_mu_coef <- estimates_scaled["(mu) x_mu", "Mean"] + unscaled_mu_coef <- estimates_unscaled["(mu) x_mu", "Mean"] + expect_equal(unscaled_mu_coef, scaled_mu_coef / mu_sd, tolerance = 1e-10) + + # Check log_sigma_x_sigma coefficient is correctly unscaled + scaled_log_sigma_coef <- estimates_scaled["(log_sigma) x_sigma", "Mean"] + unscaled_log_sigma_coef <- estimates_unscaled["(log_sigma) x_sigma", "Mean"] + expect_equal(unscaled_log_sigma_coef, scaled_log_sigma_coef / log_sigma_sd, tolerance = 1e-10) + + # Check mu intercept is correctly adjusted + scaled_mu_int <- estimates_scaled["(mu) intercept", "Mean"] + expected_mu_int <- scaled_mu_int - unscaled_mu_coef * mu_mean + expect_equal(estimates_unscaled["(mu) intercept", "Mean"], expected_mu_int, tolerance = 1e-10) + + # Check log_sigma intercept is correctly adjusted + scaled_log_sigma_int <- estimates_scaled["(log_sigma) intercept", "Mean"] + expected_log_sigma_int <- scaled_log_sigma_int - unscaled_log_sigma_coef * log_sigma_mean + expect_equal(estimates_unscaled["(log_sigma) intercept", "Mean"], expected_log_sigma_int, tolerance = 1e-10) +}) + +test_that("JAGS_evaluate_formula applies scaling correctly for dual parameter model", { + + skip_if_no_fits() + + # Load pre-fitted dual parameter regression model + fit_dual <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + formula_scale <- attr(fit_dual, "formula_scale") + prior_list <- attr(fit_dual, "prior_list") + + # Create new data (on original unscaled scale) + set.seed(123) + new_data_mu <- data.frame(x_mu = rnorm(5, mean = 5, sd = 2)) + new_data_sigma <- data.frame(x_sigma = rnorm(5, mean = 3, sd = 1.5)) + + # Evaluate mu formula (standard intercept) + pred_mu <- JAGS_evaluate_formula( + fit = fit_dual, + formula = ~ x_mu, + parameter = "mu", + data = new_data_mu, + prior_list = prior_list + ) + + # Evaluate log_sigma formula (log intercept) + formula_log_sigma <- ~ x_sigma + attr(formula_log_sigma, "log(intercept)") <- TRUE + + pred_log_sigma <- JAGS_evaluate_formula( + fit = fit_dual, + formula = formula_log_sigma, + parameter = "log_sigma", + data = new_data_sigma, + prior_list = prior_list + ) + + # Basic sanity checks + expect_equal(nrow(pred_mu), 5) + expect_equal(nrow(pred_log_sigma), 5) + + # The predictions should be matrices with n_samples columns + expect_true(ncol(pred_mu) > 1) + expect_true(ncol(pred_log_sigma) > 1) + + # Verify manually: predictions should match manual calculation + posterior <- as.matrix(coda::as.mcmc.list(fit_dual)) + mu_scale <- formula_scale$mu$mu_x_mu + log_sigma_scale <- formula_scale$log_sigma$log_sigma_x_sigma + + # Scale the new data as the function should do internally + x_mu_scaled <- (new_data_mu$x_mu - mu_scale$mean) / mu_scale$sd + x_sigma_scaled <- (new_data_sigma$x_sigma - log_sigma_scale$mean) / log_sigma_scale$sd + + # For first observation in new_data_mu + # mu[i] = intercept + x_mu * x_mu_scaled[i] + expected_mu_1 <- posterior[, "mu_intercept"] + posterior[, "mu_x_mu"] * x_mu_scaled[1] + expect_equal(pred_mu[1, ], expected_mu_1, tolerance = 1e-10) + + # For first observation in new_data_sigma (with log intercept) + # log_sigma[i] = log(intercept) + x_sigma * x_sigma_scaled[i] + expected_log_sigma_1 <- log(posterior[, "log_sigma_intercept"]) + posterior[, "log_sigma_x_sigma"] * x_sigma_scaled[1] + expect_equal(pred_log_sigma[1, ], expected_log_sigma_1, tolerance = 1e-10) +}) + + # ============================================================================ # # LM-BASED VALIDATION TESTS # ============================================================================ # @@ -596,17 +784,19 @@ test_that("transform_scaled has no effect when formula_scale is NULL", { # ============================================================================ # # Helper: Create formula_scale from data frame and variable names -# Mimics what JAGS_formula does when formula_scale = TRUE +# Creates nested structure matching JAGS_fit output: list(mu = list(mu_x1 = list(mean, sd))) .make_formula_scale <- function(df, var_names, prefix = "mu") { - result <- list() + param_scale <- list() for (var in var_names) { param_name <- paste0(prefix, "_", var) - result[[param_name]] <- list( + param_scale[[param_name]] <- list( mean = mean(df[[var]]), sd = sd(df[[var]]) ) } - attr(result, "parameter") <- prefix + # Return nested structure keyed by parameter name + result <- list() + result[[prefix]] <- param_scale result } From 5bfef4cd3c8dcb80ccd657f874cc9daad0938c32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Tue, 30 Dec 2025 16:41:13 +0100 Subject: [PATCH 20/38] Handle log(intercept) scaling in formula models Adds support for parameters with log(intercept) scaling by storing a log_intercept attribute in formula_scale, updating transform_treatment_samples to correctly transform intercepts, and renaming intercepts to exp(intercept) in format_parameter_names. Updates summary table functions and documentation to reflect these changes. Enhances tests to verify correct handling of log(intercept) scaling. --- R/JAGS-formula.R | 50 ++++++++++++++++++------ R/summary-tables.R | 10 +++-- man/parameter_names.Rd | 7 +++- man/transform_scale_samples.Rd | 7 ++-- tests/testthat/test-00-model-fits.R | 26 ++++++------ tests/testthat/test-JAGS-formula-scale.R | 29 +++++++++++--- 6 files changed, 89 insertions(+), 40 deletions(-) diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 8ad949b..604be12 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -420,6 +420,8 @@ JAGS_formula <- function(formula, parameter, data, prior_list, formula_scale = N names(scale_info) <- paste0(parameter, "_", names(scale_info)) # store the parameter prefix as an attribute for later retrieval attr(scale_info, "parameter") <- parameter + # store log_intercept attribute for proper unscaling transformation + attr(scale_info, "log_intercept") <- log_intercept output$formula_scale <- scale_info } @@ -1364,28 +1366,34 @@ transform_treatment_samples <- function(samples){ return(posterior) } + # Check if this parameter uses log(intercept) + log_intercept <- isTRUE(attr(formula_scale, "log_intercept")) + intercept_col <- paste0(prefix, "_intercept") + # Identify which columns are affected by the transformation - # (have the same prefix and either are scaled or contain scaled components) affected_cols <- grep(paste0("^", prefix, "_"), colnames(posterior), value = TRUE) if (length(affected_cols) == 0) { return(posterior) } - # Build transformation matrix for affected columns - M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) - - # Apply transformation: posterior_new[, affected] = posterior[, affected] %*% t(M) - # Since M[T, S] gives the coefficient of S in the expression for T, - # we want: new_T = sum_S M[T,S] * old_S - # In matrix form: new = old %*% t(M) would give new[i, T] = sum_S old[i, S] * M[T, S] - # But that's transposed... Let me reconsider. - # - # We have: coef_orig = M %*% coef_z (for a single sample as column vector) - # For posterior matrix with samples in rows: posterior_orig = posterior_z %*% t(M) + # For log(intercept): transform to log scale before unscaling, then exp() back + # This works because: log_sigma = log(intercept) + beta * x_z + # is equivalent to: log_sigma = log_int + beta * x_z (standard additive form) + # where log_int = log(intercept) + if (log_intercept && intercept_col %in% colnames(posterior)) { + posterior[, intercept_col] <- log(posterior[, intercept_col]) + } + # Build and apply standard transformation matrix + M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) posterior[, affected_cols] <- posterior[, affected_cols, drop = FALSE] %*% t(M) + # Transform intercept back from log scale + if (log_intercept && intercept_col %in% colnames(posterior)) { + posterior[, intercept_col] <- exp(posterior[, intercept_col]) + } + return(posterior) } @@ -1584,6 +1592,9 @@ contr.independent <- function(n, contrasts = TRUE){ #' @param formula_random a vector of random effects grouping factors #' @param formula_prefix whether the \code{formula_parameters} names should be #' kept. Defaults to \code{TRUE}. +#' @param formula_scale optional nested list containing scaling info. When provided, +#' intercepts from parameters with \code{log_intercept = TRUE} attribute will be +#' renamed to \code{exp(intercept)}. #' #' @examples #' format_parameter_names(c("mu_x_cont", "mu_x_fac3t", "mu_x_fac3t__xXx__x_cont"), @@ -1597,12 +1608,25 @@ contr.independent <- function(n, contrasts = TRUE){ NULL #' @rdname parameter_names -format_parameter_names <- function(parameters, formula_parameters = NULL, formula_random = NULL, formula_prefix = TRUE){ +format_parameter_names <- function(parameters, formula_parameters = NULL, formula_random = NULL, formula_prefix = TRUE, formula_scale = NULL){ check_char(parameters, "parameters", check_length = FALSE) check_char(formula_random, "formula_random", check_length = FALSE, allow_NULL = TRUE) check_char(formula_parameters, "formula_parameters", check_length = FALSE, allow_NULL = TRUE) check_bool(formula_prefix, "formula_prefix") + check_list(formula_scale, "formula_scale", allow_NULL = TRUE) + + # rename intercept to exp(intercept) for parameters with log_intercept attribute + if(!is.null(formula_scale)){ + for(param_name in names(formula_scale)){ + if(isTRUE(attr(formula_scale[[param_name]], "log_intercept"))){ + intercept_name <- paste0(param_name, "_intercept") + if(intercept_name %in% parameters){ + parameters[parameters == intercept_name] <- paste0(param_name, "_exp(intercept)") + } + } + } + } for(i in seq_along(formula_parameters)){ parameters[grep(paste0(formula_parameters[i], "_"), parameters)] <- gsub( diff --git a/R/summary-tables.R b/R/summary-tables.R index 85f9247..f3bed1c 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -119,7 +119,7 @@ ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.95) } if(inherits(samples[[parameter]], "mixed_posteriors.formula")){ - parameter_name <- format_parameter_names(colnames(samples[[parameter]]), formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix) + parameter_name <- format_parameter_names(colnames(samples[[parameter]]), formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix, formula_scale = formula_scale) }else{ parameter_name <- colnames(samples[[parameter]]) } @@ -495,7 +495,7 @@ marginal_estimates_table <- function(samples, inference, parameters, probs = c(0 }else{ parameter_name <- paste0(parameter, "[", names(samples[[parameter]]), "]") } - parameter_name <- format_parameter_names(parameter_name, formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix) + parameter_name <- format_parameter_names(parameter_name, formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix, formula_scale = formula_scale) }else{ parameter_name <- paste0(parameter, "[", names(samples[[parameter]]), "]") } @@ -1012,7 +1012,8 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, parameters = colnames(model_samples), formula_parameters = unique(unlist(lapply(prior_list, attr, which = "parameter"))), formula_random = unique(unlist(lapply(prior_list, attr, which = "random_factor"))), - formula_prefix = formula_prefix) + formula_prefix = formula_prefix, + formula_scale = if(transform_scaled) formula_scale else NULL) } # return samples if requested @@ -1133,7 +1134,8 @@ runjags_inference_table <- function(fit, title = NULL, footnotes = NULL, warnin parameters = rownames(runjags_summary), formula_parameters = unique(unlist(lapply(prior_list, attr, which = "parameter"))), formula_random = unique(unlist(lapply(prior_list, attr, which = "random_factor"))), - formula_prefix = formula_prefix) + formula_prefix = formula_prefix, + formula_scale = NULL) } class(runjags_summary) <- c("BayesTools_table", "BayesTools_runjags_inference", class(runjags_summary)) diff --git a/man/parameter_names.Rd b/man/parameter_names.Rd index 57b34b8..7e1fcf2 100644 --- a/man/parameter_names.Rd +++ b/man/parameter_names.Rd @@ -10,7 +10,8 @@ format_parameter_names( parameters, formula_parameters = NULL, formula_random = NULL, - formula_prefix = TRUE + formula_prefix = TRUE, + formula_scale = NULL ) JAGS_parameter_names(parameters, formula_parameter = NULL) @@ -25,6 +26,10 @@ JAGS_parameter_names(parameters, formula_parameter = NULL) \item{formula_prefix}{whether the \code{formula_parameters} names should be kept. Defaults to \code{TRUE}.} +\item{formula_scale}{optional nested list containing scaling info. When provided, +intercepts from parameters with \code{log_intercept = TRUE} attribute will be +renamed to \code{exp(intercept)}.} + \item{formula_parameter}{a formula parameter prefix name} } \value{ diff --git a/man/transform_scale_samples.Rd b/man/transform_scale_samples.Rd index 1478928..2b03698 100644 --- a/man/transform_scale_samples.Rd +++ b/man/transform_scale_samples.Rd @@ -10,9 +10,10 @@ transform_scale_samples(fit, formula_scale = NULL) \item{fit}{a fitted model object with \code{formula_scale} attribute, or a matrix of posterior samples} -\item{formula_scale}{named list containing standardization information -(mean and sd) for each standardized predictor. If \code{fit} is provided -and has a \code{formula_scale} attribute, this will be used automatically.} +\item{formula_scale}{nested list containing standardization information keyed by +parameter name. Each parameter entry contains scaling info (mean and sd) for +each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}. +If \code{fit} is provided and has a \code{formula_scale} attribute, this will be used automatically.} } \value{ \code{transform_scale_samples} returns posterior samples transformed diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 000af9a..90c1ecd 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -854,7 +854,7 @@ test_that("Formula-based interaction models fit correctly", { y = rnorm(100, 500 * data_unscaled$x_cont1 - 20 * data_unscaled$x_cont1 * data_unscaled$x_cont2, 1), N = 100 ) - + # Manual scaling: scale the data manually before fitting data_manual_scaled <- data_unscaled x_cont1_mean <- mean(data_unscaled$x_cont1) @@ -863,7 +863,7 @@ test_that("Formula-based interaction models fit correctly", { x_cont2_sd <- sd(data_unscaled$x_cont2) data_manual_scaled$x_cont1 <- (data_unscaled$x_cont1 - x_cont1_mean) / x_cont1_sd data_manual_scaled$x_cont2 <- (data_unscaled$x_cont2 - x_cont2_mean) / x_cont2_sd - + formula_list_scale <- list(mu = ~ x_cont1 * x_cont2) formula_prior_list_scale <- list( mu = list( @@ -873,7 +873,7 @@ test_that("Formula-based interaction models fit correctly", { "x_cont1:x_cont2" = prior("normal", list(0, 1)) ) ) - + # Fit 1: Manual scaling formula_data_list_manual <- list(mu = data_manual_scaled) fit_formula_manual_scaled <- JAGS_fit( @@ -886,7 +886,7 @@ test_that("Formula-based interaction models fit correctly", { mu_x_cont1 = list(mean = x_cont1_mean, sd = x_cont1_sd), mu_x_cont2 = list(mean = x_cont2_mean, sd = x_cont2_sd) ) - + # Compute marginal likelihood for manual scaling log_posterior_scale <- function(parameters, data){ sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) @@ -896,14 +896,14 @@ test_that("Formula-based interaction models fit correctly", { prior_list = prior_list, formula_list = formula_list_scale, formula_data_list = formula_data_list_manual, formula_prior_list = formula_prior_list_scale) - + result <- save_fit(fit_formula_manual_scaled, "fit_formula_manual_scaled", marglik = marglik_formula_manual_scaled, formulas = TRUE, interactions = TRUE, simple_priors = TRUE, note = "Manual scaling of continuous predictors") model_registry[["fit_formula_manual_scaled"]] <<- result$registry_entry fit_formula_manual_scaled <- result$fit - + # Fit 2: Automatic scaling formula_data_list_auto <- list(mu = data_unscaled) formula_scale_list_auto <- list(mu = list(x_cont1 = TRUE, x_cont2 = TRUE)) @@ -913,7 +913,7 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_scale, formula_scale_list = formula_scale_list_auto, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - + # Compute marginal likelihood for automatic scaling marglik_formula_auto_scaled <- JAGS_bridgesampling( fit_formula_auto_scaled, log_posterior = log_posterior_scale, data = data_scale, @@ -921,7 +921,7 @@ test_that("Formula-based interaction models fit correctly", { formula_list = formula_list_scale, formula_data_list = formula_data_list_auto, formula_prior_list = formula_prior_list_scale, formula_scale_list = formula_scale_list_auto) - + result <- save_fit(fit_formula_auto_scaled, "fit_formula_auto_scaled", marglik = marglik_formula_auto_scaled, formulas = TRUE, interactions = TRUE, simple_priors = TRUE, @@ -2113,15 +2113,15 @@ test_that("Dual parameter regression with log(intercept) and formula_scale fits set.seed(1) # Generate data with heteroscedastic variance - n <- 100 + n <- 1000 data_formula_dual <- data.frame( x_mu = rnorm(n, mean = 5, sd = 2), x_sigma = rnorm(n, mean = 3, sd = 1.5) ) - # True parameters: mu = 1 + 0.3 * x_mu, log(sigma) = log(0.5) + 0.2 * x_sigma - true_mu <- 1 + 0.3 * scale(data_formula_dual$x_mu)[,1] - true_sigma <- exp(log(0.5) + 0.2 * scale(data_formula_dual$x_sigma)[,1]) + # True parameters + true_mu <- 1 + 0.3 * data_formula_dual$x_mu + true_sigma <- exp(log(0.5) - 0.2 * data_formula_dual$x_sigma) y <- rnorm(n, mean = true_mu, sd = true_sigma) data_dual <- list(y = y, N = n) @@ -2155,7 +2155,7 @@ test_that("Dual parameter regression with log(intercept) and formula_scale fits "x_mu" = prior("normal", list(0, 1)) ), log_sigma = list( - "intercept" = prior("lognormal", list(0, 0.5)), # Must be positive for log() + "intercept" = prior("lognormal", list(0, 0.5)), "x_sigma" = prior("normal", list(0, 0.5)) ) ) diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index fd1ce78..8a48e73 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -622,6 +622,12 @@ test_that("Dual parameter model with log(intercept) has correct formula_scale st expect_equal(names(formula_scale$log_sigma$log_sigma_x_sigma), c("mean", "sd")) expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$mean)) expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$sd)) + + # Verify log_intercept attribute is stored correctly + # mu should NOT have log_intercept (or be FALSE) + expect_false(isTRUE(attr(formula_scale$mu, "log_intercept"))) + # log_sigma SHOULD have log_intercept = TRUE + expect_true(isTRUE(attr(formula_scale$log_sigma, "log_intercept"))) # Verify the model has expected parameters param_names <- colnames(fit_dual$mcmc[[1]]) @@ -661,8 +667,9 @@ test_that("transform_scale_samples works with dual parameter model", { expected_mu_intercept <- posterior[, "mu_intercept"] - expected_mu_x_mu * mu_scale$mean expect_equal(posterior_transformed[, "mu_intercept"], expected_mu_intercept, tolerance = 1e-10) - # Check log_sigma intercept is adjusted: intercept_orig = intercept_z - beta_orig * mean - expected_log_sigma_intercept <- posterior[, "log_sigma_intercept"] - expected_log_sigma_x_sigma * log_sigma_scale$mean + # Check log_sigma intercept is adjusted with multiplicative transformation (due to log(intercept)): + # intercept_orig = intercept_z * exp(-beta_orig * mean) + expected_log_sigma_intercept <- posterior[, "log_sigma_intercept"] * exp(-expected_log_sigma_x_sigma * log_sigma_scale$mean) expect_equal(posterior_transformed[, "log_sigma_intercept"], expected_log_sigma_intercept, tolerance = 1e-10) }) @@ -701,10 +708,20 @@ test_that("JAGS_estimates_table with transform_scaled works for dual parameter m expected_mu_int <- scaled_mu_int - unscaled_mu_coef * mu_mean expect_equal(estimates_unscaled["(mu) intercept", "Mean"], expected_mu_int, tolerance = 1e-10) - # Check log_sigma intercept is correctly adjusted - scaled_log_sigma_int <- estimates_scaled["(log_sigma) intercept", "Mean"] - expected_log_sigma_int <- scaled_log_sigma_int - unscaled_log_sigma_coef * log_sigma_mean - expect_equal(estimates_unscaled["(log_sigma) intercept", "Mean"], expected_log_sigma_int, tolerance = 1e-10) + # Check log_sigma intercept is correctly adjusted with multiplicative transformation + # Due to log(intercept): intercept_orig = intercept_z * exp(-beta_orig * mean) + # For means, we can't use the simple relationship because E[X * exp(Y)] != E[X] * exp(E[Y]) + # Instead, verify that the unscaled intercept is close to the true value (0.5) + # and that it differs from the scaled intercept (which would be biased) + # Note: with transform_scaled=TRUE, the intercept is renamed to exp(intercept) + unscaled_log_sigma_int <- estimates_unscaled["(log_sigma) exp(intercept)", "Mean"] + + # The unscaled intercept should be reasonably close to the true value of 0.5 + expect_true(abs(unscaled_log_sigma_int - 0.5) < 0.15) + + # The scaled intercept should NOT be close to 0.5 (it's on the wrong scale) + scaled_log_sigma_int <- estimates_scaled["(log_sigma) intercept", "Mean"] + expect_true(abs(scaled_log_sigma_int - 0.5) > abs(unscaled_log_sigma_int - 0.5)) }) test_that("JAGS_evaluate_formula applies scaling correctly for dual parameter model", { From 4e8a47680b2d4334125617e83aa5aae97f6b75ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 31 Dec 2025 09:01:49 +0100 Subject: [PATCH 21/38] Add advanced parameter filtering to summary tables Introduces advanced filtering options to `runjags_estimates_table()` and related helpers, allowing removal or retention of parameters by name or formula via `remove_parameters`, `remove_formulas`, `keep_parameters`, and `keep_formulas` arguments. Updates documentation and tests to cover new filtering logic, and adds internal helpers for parameter filtering and removal. --- NEWS.md | 5 + R/posterior-extraction.R | 148 ++++++++++++++++- R/summary-tables.R | 40 +++-- man/BayesTools_model_tables.Rd | 23 ++- man/posterior_extraction_helpers.Rd | 33 +++- tests/results/JAGS-summary-tables/.txt | 10 ++ ...it_dual_param_regression_model_summary.txt | 6 + ...ual_param_regression_runjags_estimates.txt | 5 + .../fit_formula_auto_scaled_model_summary.txt | 7 + ..._formula_auto_scaled_runjags_estimates.txt | 6 + ...it_formula_manual_scaled_model_summary.txt | 7 + ...ormula_manual_scaled_runjags_estimates.txt | 6 + ...summary_parameter_or_formula_removal01.txt | 5 + ...summary_parameter_or_formula_removal02.txt | 3 + ...summary_parameter_or_formula_removal03.txt | 3 + ...summary_parameter_or_formula_removal04.txt | 19 +++ ...summary_parameter_or_formula_removal05.txt | 10 ++ ...summary_parameter_or_formula_removal06.txt | 6 + ...summary_parameter_or_formula_removal07.txt | 13 ++ ...summary_parameter_or_formula_removal08.txt | 16 ++ ...summary_parameter_or_formula_removal09.txt | 10 ++ .../testthat/test-JAGS-posterior-extraction.R | 154 ++++++++++++++++++ tests/testthat/test-JAGS-summary-tables.R | 22 +++ 23 files changed, 537 insertions(+), 20 deletions(-) create mode 100644 tests/results/JAGS-summary-tables/.txt create mode 100644 tests/results/JAGS-summary-tables/fit_dual_param_regression_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_auto_scaled_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_manual_scaled_model_summary.txt create mode 100644 tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt diff --git a/NEWS.md b/NEWS.md index 4232891..bb7399e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,11 @@ - adds automatic standardization of continuous predictors via `formula_scale` parameter in `JAGS_formula()` and `JAGS_fit()` - improves MCMC sampling efficiency and numerical stability - adds `transform_scale_samples()` function to transform posterior samples back to original scale after standardization - adds `log(intercept)` formula attribute for specifying models of the form `log(intercept) + sum(beta_i * x_i)` - useful for parameters that must be positive (e.g., standard deviation) while keeping the intercept on the original scale. Set via `attr(formula, "log(intercept)") <- TRUE`. Supported in `JAGS_formula()`, `JAGS_evaluate_formula()`, and marginal likelihood computation +- adds advanced parameter filtering options to `runjags_estimates_table()`: + - `remove_parameters = TRUE` to remove all non-formula parameters + - `remove_formulas` to remove all parameters from specific formulas + - `keep_parameters` to keep only specified parameters + - `keep_formulas` to keep only parameters from specified formulas ### Fixes - fixes incorrect ordering the printed mixture priors diff --git a/R/posterior-extraction.R b/R/posterior-extraction.R index 9a50580..fa589f5 100644 --- a/R/posterior-extraction.R +++ b/R/posterior-extraction.R @@ -37,9 +37,11 @@ NULL for (i in rev(seq_along(prior_list))) { + par_name <- names(prior_list)[i] + # invgamma support parameter if (is.prior.simple(prior_list[[i]]) && prior_list[[i]][["distribution"]] == "invgamma") { - model_samples <- model_samples[, colnames(model_samples) != paste0("inv_", names(prior_list)[i]), drop = FALSE] + model_samples <- model_samples[, colnames(model_samples) != paste0("inv_", par_name), drop = FALSE] } # weightfunction parameters @@ -64,13 +66,9 @@ NULL prior_list[i] <- NULL } - } else if (names(prior_list)[[i]] %in% remove_parameters) { + } else if (par_name %in% remove_parameters) { # remove parameters to be excluded (note: spike_0 removal is handled by caller) - if (is.prior.factor(prior_list[[i]])) { - model_samples <- model_samples[, !colnames(model_samples) %in% .JAGS_prior_factor_names(names(prior_list)[i], prior_list[[i]]), drop = FALSE] - } else { - model_samples <- model_samples[, colnames(model_samples) != names(prior_list)[i], drop = FALSE] - } + model_samples <- .remove_parameter_columns(model_samples, prior_list[[i]], par_name) prior_list[i] <- NULL } } @@ -79,6 +77,142 @@ NULL } +#' @rdname posterior_extraction_helpers +#' @description Helper to remove all columns associated with a parameter +#' @param model_samples matrix of posterior samples +#' @param prior prior object for the parameter +#' @param par_name name of the parameter +#' @return updated model_samples matrix +.remove_parameter_columns <- function(model_samples, prior, par_name) { + + # collect all column patterns to remove + cols_to_remove <- character(0) + + if (is.prior.spike_and_slab(prior)) { + # spike and slab: remove main parameter, indicator, inclusion, variable + cols_to_remove <- c( + par_name, + paste0(par_name, "_indicator"), + paste0(par_name, "_inclusion"), + paste0(par_name, "_variable") + ) + # also handle factor spike and slab with indexed columns + cols_to_remove <- c(cols_to_remove, + colnames(model_samples)[grepl(paste0("^", par_name, "\\["), colnames(model_samples))], + colnames(model_samples)[grepl(paste0("^", par_name, "_variable\\["), colnames(model_samples))] + ) + + } else if (is.prior.mixture(prior)) { + # mixture: remove main parameter, indicator, and component-specific columns + cols_to_remove <- c( + par_name, + paste0(par_name, "_indicator") + ) + # handle factor mixture with indexed columns + cols_to_remove <- c(cols_to_remove, + colnames(model_samples)[grepl(paste0("^", par_name, "\\["), colnames(model_samples))] + ) + + # check for bias mixture (PET, PEESE, omega) + if (inherits(prior, "prior.bias_mixture")) { + # remove PET, PEESE, and all omega columns + cols_to_remove <- c(cols_to_remove, "PET", "PEESE") + cols_to_remove <- c(cols_to_remove, + colnames(model_samples)[grepl("^omega\\[", colnames(model_samples))] + ) + } + + } else if (is.prior.factor(prior)) { + # factor prior: remove all indexed columns + cols_to_remove <- .JAGS_prior_factor_names(par_name, prior) + + } else { + # simple prior: just remove the main column + cols_to_remove <- par_name + } + + # remove duplicates and filter to existing columns + cols_to_remove <- unique(cols_to_remove) + cols_to_remove <- cols_to_remove[cols_to_remove %in% colnames(model_samples)] + + model_samples <- model_samples[, !colnames(model_samples) %in% cols_to_remove, drop = FALSE] + + return(model_samples) +} + + +#' @rdname posterior_extraction_helpers +#' @param remove_parameters character vector of parameter names to remove, or TRUE to remove all non-formula parameters +#' @param remove_formulas character vector of formula names whose parameters should be removed +#' @param keep_parameters character vector of parameter names to keep (all others removed unless in keep_formulas) +#' @param keep_formulas character vector of formula names whose parameters should be kept (all others removed unless in keep_parameters) +#' @param remove_spike_0 whether to remove spike at 0 priors +#' @return list with filtered model_samples and prior_list +.filter_parameters <- function(prior_list, remove_parameters = NULL, remove_formulas = NULL, + keep_parameters = NULL, keep_formulas = NULL, remove_spike_0 = TRUE) { + + # get formula parameter for each prior + prior_formulas <- sapply(prior_list, function(p) { + form <- attr(p, "parameter") + if (is.null(form)) "__none" else form + }) + + # initialize parameters to remove + params_to_remove <- character(0) + + # handle remove_spike_0 + if (remove_spike_0) { + spike_0_params <- names(prior_list)[sapply(seq_along(prior_list), function(i) { + is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0 + })] + params_to_remove <- c(params_to_remove, spike_0_params) + } + + # handle remove_parameters + if (is.logical(remove_parameters) && isTRUE(remove_parameters)) { + # remove all non-formula parameters + non_formula_params <- names(prior_list)[prior_formulas == "__none"] + params_to_remove <- c(params_to_remove, non_formula_params) + } else if (is.character(remove_parameters)) { + params_to_remove <- c(params_to_remove, remove_parameters) + } + + # handle remove_formulas + if (!is.null(remove_formulas)) { + formula_params <- names(prior_list)[prior_formulas %in% remove_formulas] + params_to_remove <- c(params_to_remove, formula_params) + } + + # handle keep_parameters and keep_formulas (these define what to keep, everything else is removed) + if (!is.null(keep_parameters) || !is.null(keep_formulas)) { + # start with all parameters as candidates for removal + all_params <- names(prior_list) + + # determine which parameters to keep + params_to_keep <- character(0) + + if (!is.null(keep_parameters)) { + params_to_keep <- c(params_to_keep, keep_parameters) + } + + if (!is.null(keep_formulas)) { + formula_params_to_keep <- names(prior_list)[prior_formulas %in% keep_formulas] + params_to_keep <- c(params_to_keep, formula_params_to_keep) + } + + # add parameters not in keep list to removal list + params_not_kept <- all_params[!all_params %in% params_to_keep] + params_to_remove <- c(params_to_remove, params_not_kept) + } + + # remove duplicates + + params_to_remove <- unique(params_to_remove) + + return(params_to_remove) +} + + #' @rdname posterior_extraction_helpers #' @param par parameter name #' @param conditional whether to compute conditional summary diff --git a/R/summary-tables.R b/R/summary-tables.R index f3bed1c..580b1a6 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -608,8 +608,18 @@ marginal_estimates_table <- function(samples, inference, parameters, probs = c(0 #' to be added to the table #' @param remove_inclusion whether estimates of the inclusion probabilities #' should be excluded from the summary table. Defaults to \code{FALSE}. -#' @param remove_parameters parameters to be removed from the summary. Defaults -#' to \code{NULL}, i.e., including all parameters. +#' @param remove_parameters parameters to be removed from the summary. +#' Can be \code{NULL} (default, no removal), a character vector of parameter +#' names to remove, or \code{TRUE} to remove all parameters that are not +#' part of any formula. +#' @param remove_formulas character vector of formula names whose parameters +#' should be removed from the summary. Defaults to \code{NULL}. +#' @param keep_parameters character vector of parameter names to keep. +#' All other parameters will be removed unless they belong to formulas +#' specified in \code{keep_formulas}. Defaults to \code{NULL}. +#' @param keep_formulas character vector of formula names whose parameters +#' should be kept. All other parameters will be removed unless they are +#' specified in \code{keep_parameters}. Defaults to \code{NULL}. #' @param return_samples whether to return the transoformed and formated samples #' instead of the table. Defaults to \code{FALSE}. #' @inheritParams BayesTools_ensemble_tables @@ -734,7 +744,8 @@ model_summary_table <- function(model, model_description = NULL, title = NULL, f #' @rdname BayesTools_model_tables runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, footnotes = NULL, warnings = NULL, conditional = FALSE, - remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, + remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, remove_inclusion = FALSE, + remove_parameters = NULL, remove_formulas = NULL, keep_parameters = NULL, keep_formulas = NULL, return_samples = FALSE, transform_scaled = FALSE){ .check_runjags() @@ -761,7 +772,13 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, check_bool(transform_orthonormal, "transform_orthonormal") check_bool(formula_prefix, "formula_prefix") check_bool(transform_scaled, "transform_scaled") - check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0) + if(!is.null(remove_parameters) && !is.logical(remove_parameters)) + check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0) + if(is.logical(remove_parameters)) + check_bool(remove_parameters, "remove_parameters") + check_char(remove_formulas, "remove_formulas", allow_NULL = TRUE, check_length = 0) + check_char(keep_parameters, "keep_parameters", allow_NULL = TRUE, check_length = 0) + check_char(keep_formulas, "keep_formulas", allow_NULL = TRUE, check_length = 0) # depreciate transform_factors <- .depreciate.transform_orthonormal(transform_orthonormal, transform_factors) @@ -770,12 +787,15 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, model_samples <- .extract_posterior_samples(fit, as_list = FALSE) ### remove un-wanted estimates (or support values) - spike and slab priors already dealt with later (also remove the item from prior list) - # also remove zero spike priors if requested - remove_params_vec <- c(remove_parameters, if(remove_spike_0) { - names(prior_list)[sapply(seq_along(prior_list), function(i) { - is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0 - })] - }) + # compute filtered parameters using the helper function + remove_params_vec <- .filter_parameters( + prior_list = prior_list, + remove_parameters = remove_parameters, + remove_formulas = remove_formulas, + keep_parameters = keep_parameters, + keep_formulas = keep_formulas, + remove_spike_0 = remove_spike_0 + ) cleaned <- .remove_auxiliary_parameters(model_samples, prior_list, remove_params_vec) model_samples <- cleaned$model_samples diff --git a/man/BayesTools_model_tables.Rd b/man/BayesTools_model_tables.Rd index 20a9062..c53d938 100644 --- a/man/BayesTools_model_tables.Rd +++ b/man/BayesTools_model_tables.Rd @@ -41,6 +41,9 @@ runjags_estimates_table( formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, + remove_formulas = NULL, + keep_parameters = NULL, + keep_formulas = NULL, return_samples = FALSE, transform_scaled = FALSE ) @@ -66,6 +69,9 @@ JAGS_estimates_table( formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, + remove_formulas = NULL, + keep_parameters = NULL, + keep_formulas = NULL, return_samples = FALSE, transform_scaled = FALSE ) @@ -139,8 +145,10 @@ shortened. Defaults to \code{FALSE}.} \item{formula_prefix}{whether the parameter prefix from formula should be printed. Defaults to \code{TRUE}.} -\item{remove_parameters}{parameters to be removed from the summary. Defaults -to \code{NULL}, i.e., including all parameters.} +\item{remove_parameters}{parameters to be removed from the summary. +Can be \code{NULL} (default, no removal), a character vector of parameter +names to remove, or \code{TRUE} to remove all parameters that are not +part of any formula.} \item{fit}{runjags model fit} @@ -161,6 +169,17 @@ differences from the grand mean} \item{remove_inclusion}{whether estimates of the inclusion probabilities should be excluded from the summary table. Defaults to \code{FALSE}.} +\item{remove_formulas}{character vector of formula names whose parameters +should be removed from the summary. Defaults to \code{NULL}.} + +\item{keep_parameters}{character vector of parameter names to keep. +All other parameters will be removed unless they belong to formulas +specified in \code{keep_formulas}. Defaults to \code{NULL}.} + +\item{keep_formulas}{character vector of formula names whose parameters +should be kept. All other parameters will be removed unless they are +specified in \code{keep_parameters}. Defaults to \code{NULL}.} + \item{return_samples}{whether to return the transoformed and formated samples instead of the table. Defaults to \code{FALSE}.} diff --git a/man/posterior_extraction_helpers.Rd b/man/posterior_extraction_helpers.Rd index 11f3b0e..f85f3ab 100644 --- a/man/posterior_extraction_helpers.Rd +++ b/man/posterior_extraction_helpers.Rd @@ -4,6 +4,8 @@ \alias{posterior_extraction_helpers} \alias{.extract_posterior_samples} \alias{.remove_auxiliary_parameters} +\alias{.remove_parameter_columns} +\alias{.filter_parameters} \alias{.process_spike_and_slab} \alias{.apply_parameter_transformations} \alias{.transform_factor_contrasts} @@ -18,6 +20,17 @@ remove_parameters = NULL ) +.remove_parameter_columns(model_samples, prior, par_name) + +.filter_parameters( + prior_list, + remove_parameters = NULL, + remove_formulas = NULL, + keep_parameters = NULL, + keep_formulas = NULL, + remove_spike_0 = TRUE +) + .process_spike_and_slab( model_samples, prior_list, @@ -52,7 +65,19 @@ \item{prior_list}{list of prior objects} -\item{remove_parameters}{character vector of parameter names to remove} +\item{remove_parameters}{character vector of parameter names to remove, or TRUE to remove all non-formula parameters} + +\item{prior}{prior object for the parameter} + +\item{par_name}{name of the parameter} + +\item{remove_formulas}{character vector of formula names whose parameters should be removed} + +\item{keep_parameters}{character vector of parameter names to keep (all others removed unless in keep_formulas)} + +\item{keep_formulas}{character vector of formula names whose parameters should be kept (all others removed unless in keep_parameters)} + +\item{remove_spike_0}{whether to remove spike at 0 priors} \item{par}{parameter name} @@ -71,6 +96,10 @@ matrix or mcmc.list of posterior samples list with cleaned model_samples and updated prior_list +updated model_samples matrix + +list with filtered model_samples and prior_list + list with updated model_samples, prior_list, and warnings updated model_samples matrix @@ -84,5 +113,7 @@ Internal helper functions to extract posterior samples from JAGS fits and reformat them for further processing (summary tables, diagnostics, plots). These functions consolidate common logic that was duplicated across \code{runjags_estimates_table}, \code{.diagnostics_plot_data}, and plotting functions. + +Helper to remove all columns associated with a parameter } \keyword{internal} diff --git a/tests/results/JAGS-summary-tables/.txt b/tests/results/JAGS-summary-tables/.txt new file mode 100644 index 0000000..ceaffe2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/.txt @@ -0,0 +1,10 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_dual_param_regression_model_summary.txt b/tests/results/JAGS-summary-tables/fit_dual_param_regression_model_summary.txt new file mode 100644 index 0000000..c45e755 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_dual_param_regression_model_summary.txt @@ -0,0 +1,6 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 2) + log(marglik) -180.58 (mu) x_mu ~ Normal(0, 1) + Post. prob. 1.000 (log_sigma) intercept ~ Lognormal(0, 0.5) + Inclusion BF Inf (log_sigma) x_sigma ~ Normal(0, 0.5) diff --git a/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt new file mode 100644 index 0000000..01b7ecd --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 2.498 0.008 2.482 2.498 2.514 0.00026 0.032 1000 1.009 +(mu) x_mu 0.631 0.008 0.617 0.631 0.646 0.00025 0.033 925 1.000 +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_model_summary.txt new file mode 100644 index 0000000..cb052c0 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_model_summary.txt @@ -0,0 +1,7 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -100363.19 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_cont2 ~ Normal(0, 1) + Inclusion BF Inf (mu) x_cont1:x_cont2 ~ Normal(0, 1) + sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt new file mode 100644 index 0000000..0b6d5de --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 5.734 7.794 -6.822 4.648 25.392 1.94241 0.249 26 1.218 +(mu) x_cont1 0.231 1.061 -1.824 0.266 2.261 0.05771 0.054 598 1.025 +(mu) x_cont2 -0.012 1.016 -1.886 -0.035 2.115 0.03337 0.033 935 1.000 +(mu) x_cont1:x_cont2 0.069 0.996 -1.820 0.057 1.998 0.03152 0.032 1000 1.000 +sigma 19647.945 8335.195 6848.831 18798.352 37249.294 4048.13587 0.486 3 1.824 diff --git a/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_model_summary.txt b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_model_summary.txt new file mode 100644 index 0000000..cb052c0 --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_model_summary.txt @@ -0,0 +1,7 @@ + + Model 1 Parameter prior distributions + Prior prob. 1.000 (mu) intercept ~ Normal(0, 5) + log(marglik) -100363.19 (mu) x_cont1 ~ Normal(0, 1) + Post. prob. 1.000 (mu) x_cont2 ~ Normal(0, 1) + Inclusion BF Inf (mu) x_cont1:x_cont2 ~ Normal(0, 1) + sigma ~ Lognormal(0, 1) diff --git a/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt new file mode 100644 index 0000000..0b6d5de --- /dev/null +++ b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 5.734 7.794 -6.822 4.648 25.392 1.94241 0.249 26 1.218 +(mu) x_cont1 0.231 1.061 -1.824 0.266 2.261 0.05771 0.054 598 1.025 +(mu) x_cont2 -0.012 1.016 -1.886 -0.035 2.115 0.03337 0.033 935 1.000 +(mu) x_cont1:x_cont2 0.069 0.996 -1.820 0.057 1.998 0.03152 0.032 1000 1.000 +sigma 19647.945 8335.195 6848.831 18798.352 37249.294 4048.13587 0.486 3 1.824 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt new file mode 100644 index 0000000..01b7ecd --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt @@ -0,0 +1,5 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 2.498 0.008 2.482 2.498 2.514 0.00026 0.032 1000 1.009 +(mu) x_mu 0.631 0.008 0.617 0.631 0.646 0.00025 0.033 925 1.000 +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt new file mode 100644 index 0000000..b203bde --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt new file mode 100644 index 0000000..b203bde --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt @@ -0,0 +1,3 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt new file mode 100644 index 0000000..203ca27 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt @@ -0,0 +1,19 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA NA NA NA NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt new file mode 100644 index 0000000..2fbecbd --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt @@ -0,0 +1,10 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA NA NA NA NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt new file mode 100644 index 0000000..a3e7c82 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt @@ -0,0 +1,6 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt new file mode 100644 index 0000000..d2ebb85 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt @@ -0,0 +1,13 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA NA NA NA NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt new file mode 100644 index 0000000..5d35d6b --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt @@ -0,0 +1,16 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA +(mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA +(mu) x_fac2t (inclusion) 0.128 NA NA NA NA NA NA NA NA +(mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA +(mu) x_fac3t (inclusion) 0.732 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.218 0.147 0.000 0.261 0.427 0.04047 0.275 13 NA +(mu) x_fac3t[2] -0.010 0.065 -0.147 0.000 0.129 0.00292 0.045 500 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt new file mode 100644 index 0000000..ceaffe2 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt @@ -0,0 +1,10 @@ + Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/testthat/test-JAGS-posterior-extraction.R b/tests/testthat/test-JAGS-posterior-extraction.R index 9666ddf..57eff55 100644 --- a/tests/testthat/test-JAGS-posterior-extraction.R +++ b/tests/testthat/test-JAGS-posterior-extraction.R @@ -185,6 +185,160 @@ test_that(".transform_factor_contrasts transforms orthonormal to differences", { }) +test_that(".filter_parameters removes spike at 0 priors", { + skip_on_cran() + skip_if_not_installed("rjags") + + prior_list <- list( + mu = prior("normal", list(0, 1)), + delta = prior("point", list(0)), # spike at 0 + tau = prior("normal", list(1, 1)) + ) + + # With remove_spike_0 = TRUE + result <- BayesTools:::.filter_parameters(prior_list, remove_spike_0 = TRUE) + expect_true("delta" %in% result) + expect_false("mu" %in% result) + expect_false("tau" %in% result) + + # With remove_spike_0 = FALSE + result <- BayesTools:::.filter_parameters(prior_list, remove_spike_0 = FALSE) + expect_equal(length(result), 0) +}) + + +test_that(".filter_parameters removes character specified parameters", { + skip_on_cran() + skip_if_not_installed("rjags") + + prior_list <- list( + mu = prior("normal", list(0, 1)), + delta = prior("normal", list(0, 1)), + tau = prior("normal", list(1, 1)) + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = c("mu", "tau"), remove_spike_0 = FALSE) + expect_true("mu" %in% result) + expect_true("tau" %in% result) + expect_false("delta" %in% result) +}) + + +test_that(".filter_parameters removes non-formula parameters when TRUE", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create priors with formula attributes + prior_formula <- prior("normal", list(0, 1)) + attr(prior_formula, "parameter") <- "y" + + prior_list <- list( + intercept = prior_formula, + sigma = prior("normal", list(1, 1)) # no formula attribute + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = TRUE, remove_spike_0 = FALSE) + expect_true("sigma" %in% result) + expect_false("intercept" %in% result) +}) + + +test_that(".filter_parameters removes formula-specific parameters", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create priors with different formula attributes + prior_y <- prior("normal", list(0, 1)) + attr(prior_y, "parameter") <- "y" + + prior_x <- prior("normal", list(0, 1)) + attr(prior_x, "parameter") <- "x" + + prior_list <- list( + intercept_y = prior_y, + slope_y = prior_y, + intercept_x = prior_x, + sigma = prior("normal", list(1, 1)) # no formula attribute + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_formulas = "y", remove_spike_0 = FALSE) + expect_true("intercept_y" %in% result) + expect_true("slope_y" %in% result) + expect_false("intercept_x" %in% result) + expect_false("sigma" %in% result) +}) + + +test_that(".filter_parameters keeps only specified parameters", { + skip_on_cran() + skip_if_not_installed("rjags") + + prior_list <- list( + mu = prior("normal", list(0, 1)), + delta = prior("normal", list(0, 1)), + tau = prior("normal", list(1, 1)) + ) + + result <- BayesTools:::.filter_parameters(prior_list, keep_parameters = "mu", remove_spike_0 = FALSE) + expect_false("mu" %in% result) + expect_true("delta" %in% result) + expect_true("tau" %in% result) +}) + + +test_that(".filter_parameters keeps only specified formulas", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create priors with different formula attributes + prior_y <- prior("normal", list(0, 1)) + attr(prior_y, "parameter") <- "y" + + prior_x <- prior("normal", list(0, 1)) + attr(prior_x, "parameter") <- "x" + + prior_list <- list( + intercept_y = prior_y, + slope_y = prior_y, + intercept_x = prior_x, + sigma = prior("normal", list(1, 1)) # no formula attribute + ) + + result <- BayesTools:::.filter_parameters(prior_list, keep_formulas = "y", remove_spike_0 = FALSE) + expect_false("intercept_y" %in% result) + expect_false("slope_y" %in% result) + expect_true("intercept_x" %in% result) + expect_true("sigma" %in% result) +}) + + +test_that(".filter_parameters combines keep_parameters and keep_formulas", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create priors with different formula attributes + prior_y <- prior("normal", list(0, 1)) + attr(prior_y, "parameter") <- "y" + + prior_x <- prior("normal", list(0, 1)) + attr(prior_x, "parameter") <- "x" + + prior_list <- list( + intercept_y = prior_y, + slope_y = prior_y, + intercept_x = prior_x, + sigma = prior("normal", list(1, 1)) # no formula attribute + ) + + # Keep formula "y" and parameter "sigma" + result <- BayesTools:::.filter_parameters(prior_list, keep_parameters = "sigma", keep_formulas = "y", remove_spike_0 = FALSE) + expect_false("intercept_y" %in% result) + expect_false("slope_y" %in% result) + expect_false("sigma" %in% result) + expect_true("intercept_x" %in% result) +}) + + test_that("helper functions work with runjags estimates extraction", { skip_on_cran() skip_if_not_installed("rjags") diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 0247c9e..0ca5b46 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -144,6 +144,28 @@ test_that("Summary table advanced features work correctly", { test_reference_table(runjags_summary_complex2, "runjags_summary_complex2.txt", "Custom probs table mismatch") test_reference_table(runjags_summary_complex3, "runjags_summary_complex3.txt", "Custom probs table mismatch") + # Removal of formula and parameter names + fit_dual_param <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + + runjags_summary_removal_01 <- JAGS_estimates_table(fit_dual_param) + runjags_summary_removal_02 <- JAGS_estimates_table(fit_dual_param, remove_formulas = "mu") + runjags_summary_removal_03 <- JAGS_estimates_table(fit_dual_param, keep_formulas = "log_sigma") + runjags_summary_removal_04 <- JAGS_estimates_table(fit_complex_mixed) + runjags_summary_removal_05 <- JAGS_estimates_table(fit_complex_mixed, remove_parameters = TRUE) + runjags_summary_removal_06 <- JAGS_estimates_table(fit_complex_mixed, remove_parameters = TRUE, remove_inclusion = TRUE) + runjags_summary_removal_07 <- JAGS_estimates_table(fit_complex_mixed, remove_parameters = "bias") + runjags_summary_removal_08 <- JAGS_estimates_table(fit_complex_mixed, remove_parameters = "sigma") + runjags_summary_removal_09 <- JAGS_estimates_table(fit_complex_mixed, remove_formulas = "mu") + + test_reference_table(runjags_summary_removal_01, "summary_parameter_or_formula_removal01.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_02, "summary_parameter_or_formula_removal02.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_03, "summary_parameter_or_formula_removal03.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_04, "summary_parameter_or_formula_removal04.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_05, "summary_parameter_or_formula_removal05.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_06, "summary_parameter_or_formula_removal06.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_07, "summary_parameter_or_formula_removal07.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_08, "summary_parameter_or_formula_removal08.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_removal_09, "summary_parameter_or_formula_removal09.txt", "Parameter/formula removal") }) # ============================================================================ # From e2d22093210f2c3bcd244a054845d76eb41c0d81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 31 Dec 2025 12:03:01 +0100 Subject: [PATCH 22/38] fix documentation --- R/JAGS-marglik.R | 4 ++++ man/JAGS_bridgesampling.Rd | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/R/JAGS-marglik.R b/R/JAGS-marglik.R index fac731c..427886e 100644 --- a/R/JAGS-marglik.R +++ b/R/JAGS-marglik.R @@ -25,6 +25,10 @@ #' (names of the lists correspond to the parameter name created by each of the formula and #' the names of the prior distribution correspond to the parameter names) of parameters specified #' within the \code{formula} +#' @param formula_scale_list named list of named lists for standardizing continuous predictors +#' (names of the lists correspond to the parameter name created by each of the formula). +#' Each entry should be a named list where continuous predictors with \code{TRUE} values will +#' be standardized. Defaults to \code{NULL} (no standardization). #' @param add_parameters vector of additional parameter names that should be used #' in bridgesampling but were not specified in the \code{prior_list} #' @param add_bounds list with two name vectors (\code{"lb"} and \code{"up"}) diff --git a/man/JAGS_bridgesampling.Rd b/man/JAGS_bridgesampling.Rd index d736aea..7e782e3 100644 --- a/man/JAGS_bridgesampling.Rd +++ b/man/JAGS_bridgesampling.Rd @@ -45,6 +45,11 @@ returns the log of the unnormalized posterior density of the model part} the names of the prior distribution correspond to the parameter names) of parameters specified within the \code{formula}} +\item{formula_scale_list}{named list of named lists for standardizing continuous predictors +(names of the lists correspond to the parameter name created by each of the formula). +Each entry should be a named list where continuous predictors with \code{TRUE} values will +be standardized. Defaults to \code{NULL} (no standardization).} + \item{add_parameters}{vector of additional parameter names that should be used in bridgesampling but were not specified in the \code{prior_list}} From 18ad3e932fc092422d64a9eb67a4b7591f609dcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 31 Dec 2025 16:59:25 +0100 Subject: [PATCH 23/38] Add custom quantile support and update column names Introduces a `probs` argument to `runjags_estimates_table()` and `runjags_estimates_empty_table()` for specifying custom quantiles, defaulting to c(0.025, 0.5, 0.975). Quantile column names in `runjags_estimates_table()` and `stan_estimates_table()` are changed from lCI/Median/uCI to their numeric values for consistency. Adds a `remove_diagnostics` argument to exclude MCMC diagnostics from output tables. Updates documentation, tests, and README to reflect these changes. --- NEWS.md | 4 ++ R/model-averaging-plots.R | 4 +- R/summary-tables.R | 57 ++++++++++++------- README.md | 4 +- man/BayesTools_model_tables.Rd | 29 ++++++++-- .../JAGS-fit/runjags_estimates_param_m.txt | 4 +- .../JAGS-fit/runjags_estimates_simple.txt | 6 +- .../advanced_conditional.txt | 2 +- .../advanced_custom_transform.txt | 4 +- .../advanced_factor_treatment.txt | 4 +- .../advanced_formula_prefix_false.txt | 2 +- .../advanced_formula_prefix_true.txt | 2 +- .../advanced_orthonormal_transform.txt | 2 +- .../advanced_orthonormal_transform2.txt | 8 +-- .../advanced_remove_inclusion.txt | 2 +- .../advanced_spike_slab_estimates.txt | 8 +-- .../advanced_transform.txt | 2 +- .../advanced_unconditional.txt | 2 +- .../empty_runjags_estimates.txt | 2 +- .../fit_add_parameters_runjags_estimates.txt | 2 +- .../fit_autofit_error_runjags_estimates.txt | 2 +- .../fit_autofit_ess_runjags_estimates.txt | 2 +- .../fit_complex_bias_runjags_estimates.txt | 18 +++--- .../fit_complex_mixed_runjags_estimates.txt | 2 +- ...ual_param_regression_runjags_estimates.txt | 2 +- ...t_expression_mixture_runjags_estimates.txt | 2 +- ...it_expression_simple_runjags_estimates.txt | 2 +- ...xpression_spike_slab_runjags_estimates.txt | 8 +-- ...t_factor_independent_runjags_estimates.txt | 8 +-- .../fit_factor_meandif_runjags_estimates.txt | 2 +- ...t_factor_orthonormal_runjags_estimates.txt | 6 +- ...fit_factor_treatment_runjags_estimates.txt | 4 +- ..._formula_auto_scaled_runjags_estimates.txt | 2 +- ...rmula_factor_mixture_runjags_estimates.txt | 2 +- ...ula_interaction_cont_runjags_estimates.txt | 2 +- ...mula_interaction_fac_runjags_estimates.txt | 2 +- ...interaction_mix_main_runjags_estimates.txt | 2 +- ...mula_interaction_mix_runjags_estimates.txt | 2 +- ...ormula_manual_scaled_runjags_estimates.txt | 2 +- .../fit_formula_multi_runjags_estimates.txt | 2 +- ..._formula_orthonormal_runjags_estimates.txt | 2 +- .../fit_formula_simple_runjags_estimates.txt | 2 +- ...it_formula_treatment_runjags_estimates.txt | 2 +- .../fit_joint_complex_runjags_estimates.txt | 20 +++---- .../fit_marginal_0_runjags_estimates.txt | 8 +-- .../fit_marginal_1_runjags_estimates.txt | 18 +++--- .../fit_marginal_ss_runjags_estimates.txt | 26 ++++----- .../fit_missing_runjags_estimates.txt | 4 +- ...t_mixture_components_runjags_estimates.txt | 2 +- .../fit_mixture_simple_runjags_estimates.txt | 2 +- .../fit_mixture_spike_runjags_estimates.txt | 2 +- .../fit_no_autofit_runjags_estimates.txt | 4 +- .../fit_orthonormal_0_runjags_estimates.txt | 6 +- .../fit_orthonormal_1_runjags_estimates.txt | 10 ++-- .../fit_parallel_runjags_estimates.txt | 6 +- .../fit_peese_runjags_estimates.txt | 4 +- .../fit_pet_runjags_estimates.txt | 4 +- ...random_factor_slope2_runjags_estimates.txt | 2 +- ...random_factor_slope3_runjags_estimates.txt | 2 +- ..._random_factor_slope_runjags_estimates.txt | 14 ++--- ...fit_random_intercept_runjags_estimates.txt | 8 +-- .../fit_random_slope_runjags_estimates.txt | 8 +-- ...simple_formula_mixed_runjags_estimates.txt | 2 +- .../fit_simple_normal_runjags_estimates.txt | 6 +- .../fit_simple_pub_bias_runjags_estimates.txt | 6 +- .../fit_simple_spike_runjags_estimates.txt | 4 +- .../fit_simple_thin_runjags_estimates.txt | 4 +- .../fit_simple_various_runjags_estimates.txt | 2 +- .../fit_spike_factors_runjags_estimates.txt | 12 ++-- ...it_spike_slab_factor_runjags_estimates.txt | 8 +-- ...it_spike_slab_simple_runjags_estimates.txt | 6 +- .../fit_summary0_runjags_estimates.txt | 4 +- .../fit_summary1_runjags_estimates.txt | 8 +-- .../fit_summary2_runjags_estimates.txt | 10 ++-- .../fit_summary3_runjags_estimates.txt | 8 +-- .../fit_vector_mcauchy_runjags_estimates.txt | 2 +- .../fit_vector_mnormal_runjags_estimates.txt | 2 +- .../fit_vector_mt_runjags_estimates.txt | 6 +- ...weightfunction_fixed_runjags_estimates.txt | 6 +- ...htfunction_onesided2_runjags_estimates.txt | 6 +- ...htfunction_onesided3_runjags_estimates.txt | 8 +-- ...ghtfunction_twosided_runjags_estimates.txt | 6 +- .../fit_wf_missing_runjags_estimates.txt | 4 +- .../fit_wf_onesided_runjags_estimates.txt | 6 +- .../fit_wf_twosided_runjags_estimates.txt | 6 +- .../runjags_factor_conditional.txt | 6 +- ...runjags_factor_conditional_transformed.txt | 2 +- .../runjags_mixture_conditional.txt | 2 +- .../runjags_pub_bias_conditional.txt | 6 +- .../runjags_remove_diagnostics.txt | 5 ++ .../runjags_spike_slab_conditional.txt | 6 +- .../runjags_summary_complex2.txt | 18 +++--- .../runjags_summary_complex3.txt | 2 +- .../stan_estimates_basic.txt | 16 +++--- .../stan_estimates_basic2.txt | 16 +++--- ...summary_parameter_or_formula_removal01.txt | 2 +- ...summary_parameter_or_formula_removal02.txt | 2 +- ...summary_parameter_or_formula_removal03.txt | 2 +- ...summary_parameter_or_formula_removal04.txt | 2 +- ...summary_parameter_or_formula_removal05.txt | 2 +- ...summary_parameter_or_formula_removal06.txt | 2 +- ...summary_parameter_or_formula_removal07.txt | 2 +- ...summary_parameter_or_formula_removal08.txt | 2 +- ...summary_parameter_or_formula_removal09.txt | 20 +++---- .../summary_parameter_probs1.txt | 5 ++ .../summary_parameter_probs2.txt | 5 ++ .../summary_parameter_probs3.txt | 5 ++ tests/testthat/test-JAGS-summary-tables.R | 13 +++++ 108 files changed, 363 insertions(+), 292 deletions(-) create mode 100644 tests/results/JAGS-summary-tables/runjags_remove_diagnostics.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_probs1.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_probs2.txt create mode 100644 tests/results/JAGS-summary-tables/summary_parameter_probs3.txt diff --git a/NEWS.md b/NEWS.md index bb7399e..f92731a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,10 @@ - `remove_formulas` to remove all parameters from specific formulas - `keep_parameters` to keep only specified parameters - `keep_formulas` to keep only parameters from specified formulas +- adds `probs` argument to `runjags_estimates_table()` and `runjags_estimates_empty_table()` for custom quantiles (default: `c(0.025, 0.5, 0.975)`) + +### Changes +- changes quantile column names in `runjags_estimates_table()` and `stan_estimates_table()` from `lCI`/`Median`/`uCI` to numeric values (e.g., `0.025`/`0.5`/`0.975`) for consistency with ensemble summary tables ### Fixes - fixes incorrect ordering the printed mixture priors diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index a550c9b..0c91ab7 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -1707,7 +1707,7 @@ plot_models <- function(model_list, samples, inference, parameter, plot_type = " }), y_lCI = sapply(1:length(models_summary), function(i){ if(any(attr(models_summary[[i]], "parameters") == parameter)){ - return(models_summary[[i]][attr(models_summary[[i]], "parameters") == parameter, "lCI"]) + return(models_summary[[i]][attr(models_summary[[i]], "parameters") == parameter, "0.025"]) }else if(is.prior.point(prior_list[[i]])){ return(prior_list[[i]]$parameters[["location"]]) }else{ @@ -1716,7 +1716,7 @@ plot_models <- function(model_list, samples, inference, parameter, plot_type = " }), y_uCI = sapply(1:length(models_summary), function(i){ if(any(attr(models_summary[[i]], "parameters") == parameter)){ - return(models_summary[[i]][attr(models_summary[[i]], "parameters") == parameter, "uCI"]) + return(models_summary[[i]][attr(models_summary[[i]], "parameters") == parameter, "0.975"]) }else if(is.prior.point(prior_list[[i]])){ return(prior_list[[i]]$parameters[["location"]]) }else{ diff --git a/R/summary-tables.R b/R/summary-tables.R index 580b1a6..c04c190 100644 --- a/R/summary-tables.R +++ b/R/summary-tables.R @@ -622,6 +622,10 @@ marginal_estimates_table <- function(samples, inference, parameters, probs = c(0 #' specified in \code{keep_parameters}. Defaults to \code{NULL}. #' @param return_samples whether to return the transoformed and formated samples #' instead of the table. Defaults to \code{FALSE}. +#' @param remove_diagnostics whether to exclude MCMC diagnostics (MCMC error, +#' ESS, R-hat) from the output table. Defaults to \code{FALSE}. Setting to +#' \code{TRUE} will exclude diagnostics columns regardless of the +#' \code{conditional} setting. #' @inheritParams BayesTools_ensemble_tables #' #' @@ -744,9 +748,10 @@ model_summary_table <- function(model, model_description = NULL, title = NULL, f #' @rdname BayesTools_model_tables runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, footnotes = NULL, warnings = NULL, conditional = FALSE, - remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, remove_inclusion = FALSE, - remove_parameters = NULL, remove_formulas = NULL, keep_parameters = NULL, keep_formulas = NULL, - return_samples = FALSE, transform_scaled = FALSE){ + probs = c(0.025, 0.5, 0.975), remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, + formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, remove_formulas = NULL, + keep_parameters = NULL, keep_formulas = NULL, return_samples = FALSE, transform_scaled = FALSE, + remove_diagnostics = FALSE){ .check_runjags() # most of the code is shared with .diagnostics_plot_data function (keep them in sync on update) @@ -766,12 +771,14 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, check_char(title, "title", allow_NULL = TRUE) check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE) check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE) + check_real(probs, "probs", lower = 0, upper = 1, check_length = 0) check_bool(remove_spike_0, "remove_spike_0") check_bool(conditional, "conditional") check_bool(transform_factors, "transform_factors") check_bool(transform_orthonormal, "transform_orthonormal") check_bool(formula_prefix, "formula_prefix") check_bool(transform_scaled, "transform_scaled") + check_bool(remove_diagnostics, "remove_diagnostics") if(!is.null(remove_parameters) && !is.logical(remove_parameters)) check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0) if(is.logical(remove_parameters)) @@ -1044,14 +1051,15 @@ runjags_estimates_table <- function(fit, transformations = NULL, title = NULL, # compute the summary if(ncol(model_samples) == 0){ - return(runjags_estimates_empty_table(title = title, footnotes = footnotes, warnings = warnings)) + return(runjags_estimates_empty_table(probs = probs, title = title, footnotes = footnotes, warnings = warnings)) }else{ - runjags_summary <- .runjags_summary_fast(model_samples, n_samples = fit$sample, n_chains = length(fit$mcmc), conditional = conditional) + runjags_summary <- .runjags_summary_fast(model_samples, n_samples = fit$sample, n_chains = length(fit$mcmc), conditional = conditional, probs = probs, remove_diagnostics = remove_diagnostics) } # prepare output + n_estimate_cols <- 2 + length(probs) # Mean, SD, quantiles class(runjags_summary) <- c("BayesTools_table", "BayesTools_runjags_summary", class(runjags_summary)) - attr(runjags_summary, "type") <- c(rep("estimate", 5), if(!conditional) c("MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) + attr(runjags_summary, "type") <- c(rep("estimate", n_estimate_cols), if(!conditional && !remove_diagnostics) c("MCMC_error", "MCMC_SD_error", "ESS", "R_hat")) attr(runjags_summary, "parameters") <- parameter_names attr(runjags_summary, "rownames") <- TRUE attr(runjags_summary, "title") <- title @@ -1215,13 +1223,14 @@ model_summary_empty_table <- function(model_description = NULL, title = NULL, fo } #' @rdname BayesTools_model_tables -runjags_estimates_empty_table <- function(title = NULL, footnotes = NULL, warnings = NULL){ +runjags_estimates_empty_table <- function(probs = c(0.025, 0.5, 0.975), title = NULL, footnotes = NULL, warnings = NULL){ - empty_table <- data.frame(matrix(nrow = 0, ncol = 9)) - colnames(empty_table) <- c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat") + n_estimate_cols <- 2 + length(probs) # Mean, SD, quantiles + empty_table <- data.frame(matrix(nrow = 0, ncol = n_estimate_cols + 4), check.names = FALSE) + colnames(empty_table) <- c("Mean", "SD", as.character(probs), "MCMC_error", "MCMC_SD_error", "ESS", "R_hat") class(empty_table) <- c("BayesTools_table", "BayesTools_runjags_summary", class(empty_table)) - attr(empty_table, "type") <- c(rep("estimate", 5), "MCMC_error", "MCMC_SD_error", "ESS", "R_hat") + attr(empty_table, "type") <- c(rep("estimate", n_estimate_cols), "MCMC_error", "MCMC_SD_error", "ESS", "R_hat") attr(empty_table, "rownames") <- FALSE attr(empty_table, "title") <- title attr(empty_table, "footnotes") <- footnotes @@ -1303,15 +1312,16 @@ stan_estimates_table <- function(fit, transformations = NULL, title = NULL, foo # rename the rest - colnames(stan_summary)[colnames(stan_summary) == "Lower95"] <- "lCI" - colnames(stan_summary)[colnames(stan_summary) == "Upper95"] <- "uCI" + colnames(stan_summary)[colnames(stan_summary) == "Lower95"] <- "0.025" + colnames(stan_summary)[colnames(stan_summary) == "Median"] <- "0.5" + colnames(stan_summary)[colnames(stan_summary) == "Upper95"] <- "0.975" colnames(stan_summary)[colnames(stan_summary) == "MCerr"] <- "MCMC_error" colnames(stan_summary)[colnames(stan_summary) == "MC.ofSD"] <- "MCMC_SD_error" colnames(stan_summary)[colnames(stan_summary) == "SSeff"] <- "ESS" colnames(stan_summary)[colnames(stan_summary) == "psrf"] <- "R_hat" # reorder the columns - stan_summary <- stan_summary[,c("Mean", "SD", "lCI", "Median", "uCI", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat"), drop = FALSE] + stan_summary <- stan_summary[,c("Mean", "SD", "0.025", "0.5", "0.975", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat"), drop = FALSE] # store parameter names parameter_names <- rownames(stan_summary) @@ -1673,22 +1683,25 @@ update.BayesTools_table <- function(object, title = NULL, footnotes = NULL, warn "ESS", "R_hat", "MCMC_error", "MCMC_SD_error", "min_ESS", "max_R_hat", "max_MCMC_error", "max_MCMC_SD_error"), allow_NULL = allow_NULL) } -.runjags_summary_fast <- function(model_samples, n_samples, n_chains, conditional){ +.runjags_summary_fast <- function(model_samples, n_samples, n_chains, conditional, probs = c(0.025, 0.975), remove_diagnostics = FALSE){ + + # compute quantiles dynamically + quantile_cols <- lapply(probs, function(p) apply(model_samples, 2, stats::quantile, probs = p, na.rm = TRUE)) + names(quantile_cols) <- as.character(probs) # the chains needs to be kept merged for conditional summary (due to NAs in the chains) runjags_summary <- cbind.data.frame( - "Mean" = apply(model_samples, 2, mean, na.rm = TRUE), - "SD" = apply(model_samples, 2, stats::sd, na.rm = TRUE), - "lCI" = apply(model_samples, 2, stats::quantile, probs = 0.025, na.rm = TRUE), - "Median" = apply(model_samples, 2, stats::median, na.rm = TRUE), - "uCI" = apply(model_samples, 2, stats::quantile, probs = 0.975, na.rm = TRUE) + "Mean" = apply(model_samples, 2, mean, na.rm = TRUE), + "SD" = apply(model_samples, 2, stats::sd, na.rm = TRUE), + as.data.frame(quantile_cols, check.names = FALSE) ) # remove all but Mean for inclusions - runjags_summary[grepl("(inclusion)", rownames(runjags_summary)), c("SD", "lCI", "Median", "uCI")] <- NA + quantile_col_names <- as.character(probs) + runjags_summary[grepl("(inclusion)", rownames(runjags_summary)), c("SD", quantile_col_names)] <- NA - # don't produce fit diagnostics for conditional samples (different chain lengths etc...) - if(conditional){ + # don't produce fit diagnostics for conditional samples (different chain lengths etc...) or if remove_diagnostics is TRUE + if(conditional || remove_diagnostics){ return(runjags_summary) } diff --git a/README.md b/README.md index 4707cd2..9023d62 100644 --- a/README.md +++ b/README.md @@ -196,8 +196,8 @@ summary for the fitted model. ``` r # formatted summary tables runjags_estimates_table(fit1, priors_list1) -#> Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -#> mu 0.116 0.304 -0.469 0.117 0.715 0.00242 0.008 15748 1.000 +#> Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +#> mu 0.116 0.304 -0.469 0.117 0.715 0.00242 0.008 15748 1.000 ``` We create a `log_posterior` function that defines the log likelihood of diff --git a/man/BayesTools_model_tables.Rd b/man/BayesTools_model_tables.Rd index c53d938..bd04bd2 100644 --- a/man/BayesTools_model_tables.Rd +++ b/man/BayesTools_model_tables.Rd @@ -35,6 +35,7 @@ runjags_estimates_table( footnotes = NULL, warnings = NULL, conditional = FALSE, + probs = c(0.025, 0.5, 0.975), remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, @@ -45,7 +46,8 @@ runjags_estimates_table( keep_parameters = NULL, keep_formulas = NULL, return_samples = FALSE, - transform_scaled = FALSE + transform_scaled = FALSE, + remove_diagnostics = FALSE ) runjags_inference_table( @@ -63,6 +65,7 @@ JAGS_estimates_table( footnotes = NULL, warnings = NULL, conditional = FALSE, + probs = c(0.025, 0.5, 0.975), remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE, @@ -73,7 +76,8 @@ JAGS_estimates_table( keep_parameters = NULL, keep_formulas = NULL, return_samples = FALSE, - transform_scaled = FALSE + transform_scaled = FALSE, + remove_diagnostics = FALSE ) JAGS_inference_table( @@ -103,11 +107,21 @@ model_summary_empty_table( warnings = NULL ) -runjags_estimates_empty_table(title = NULL, footnotes = NULL, warnings = NULL) +runjags_estimates_empty_table( + probs = c(0.025, 0.5, 0.975), + title = NULL, + footnotes = NULL, + warnings = NULL +) runjags_inference_empty_table(title = NULL, footnotes = NULL, warnings = NULL) -JAGS_estimates_empty_table(title = NULL, footnotes = NULL, warnings = NULL) +JAGS_estimates_empty_table( + probs = c(0.025, 0.5, 0.975), + title = NULL, + footnotes = NULL, + warnings = NULL +) JAGS_inference_empty_table(title = NULL, footnotes = NULL, warnings = NULL) @@ -158,6 +172,8 @@ to specific parameters} \item{conditional}{summarizes estimates conditional on being included in the model for spike and slab priors. Defaults to \code{FALSE}.} +\item{probs}{quantiles for parameter estimates} + \item{transform_factors}{whether factors with orthonormal/meandif prior distribution should be transformed to differences from the grand mean} @@ -186,6 +202,11 @@ instead of the table. Defaults to \code{FALSE}.} \item{transform_scaled}{whether coefficients from standardized continuous predictors should be transformed back to the original scale. Defaults to \code{FALSE}.} + +\item{remove_diagnostics}{whether to exclude MCMC diagnostics (MCMC error, +ESS, R-hat) from the output table. Defaults to \code{FALSE}. Setting to +\code{TRUE} will exclude diagnostics columns regardless of the +\code{conditional} setting.} } \value{ \code{model_summary_table} returns a table with diff --git a/tests/results/JAGS-fit/runjags_estimates_param_m.txt b/tests/results/JAGS-fit/runjags_estimates_param_m.txt index b059b16..89e8cca 100644 --- a/tests/results/JAGS-fit/runjags_estimates_param_m.txt +++ b/tests/results/JAGS-fit/runjags_estimates_param_m.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-fit/runjags_estimates_simple.txt b/tests/results/JAGS-fit/runjags_estimates_simple.txt index 7d673c6..a19f99d 100644 --- a/tests/results/JAGS-fit/runjags_estimates_simple.txt +++ b/tests/results/JAGS-fit/runjags_estimates_simple.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 -s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-summary-tables/advanced_conditional.txt b/tests/results/JAGS-summary-tables/advanced_conditional.txt index 3c43238..13e8edc 100644 --- a/tests/results/JAGS-summary-tables/advanced_conditional.txt +++ b/tests/results/JAGS-summary-tables/advanced_conditional.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI + Mean SD 0.025 0.5 0.975 (mu) intercept 0.035 0.104 -0.178 0.040 0.243 (mu) x_cont1 0.361 0.123 0.124 0.365 0.587 (mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 diff --git a/tests/results/JAGS-summary-tables/advanced_custom_transform.txt b/tests/results/JAGS-summary-tables/advanced_custom_transform.txt index 1612b96..620b400 100644 --- a/tests/results/JAGS-summary-tables/advanced_custom_transform.txt +++ b/tests/results/JAGS-summary-tables/advanced_custom_transform.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt b/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt index 1612b96..620b400 100644 --- a/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt +++ b/tests/results/JAGS-summary-tables/advanced_factor_treatment.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt b/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt index 9229c5b..b208fc2 100644 --- a/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt +++ b/tests/results/JAGS-summary-tables/advanced_formula_prefix_false.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt b/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt index 3d5f3d2..29fb99d 100644 --- a/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt +++ b/tests/results/JAGS-summary-tables/advanced_formula_prefix_true.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 (mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 (mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt index cff708f..fd09626 100644 --- a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt +++ b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 0.02589 0.032 1000 1.001 p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 0.02517 0.032 1000 0.999 p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 0.02565 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt index 37d8ffa..8413e44 100644 --- a/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt +++ b/tests/results/JAGS-summary-tables/advanced_orthonormal_transform2.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1 [dif: 1] 1.437 1.295 0.196 1.062 4.979 0.04097 0.032 1000 1.009 -p1 [dif: 2] 1.326 1.230 0.199 0.972 4.605 0.03891 0.032 1000 1.000 -p1 [dif: 3] 1.376 1.289 0.212 0.991 4.776 0.04076 0.032 1000 1.002 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1 [dif: 1] 1.437 1.295 0.196 1.062 4.979 0.04097 0.032 1000 1.009 +p1 [dif: 2] 1.326 1.230 0.199 0.972 4.605 0.03891 0.032 1000 1.000 +p1 [dif: 3] 1.376 1.289 0.212 0.991 4.776 0.04076 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt b/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt index f0c07d4..ce43bdf 100644 --- a/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt +++ b/tests/results/JAGS-summary-tables/advanced_remove_inclusion.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI + Mean SD 0.025 0.5 0.975 beta [dif: 1] 0.008 0.811 -1.606 0.010 1.632 beta [dif: 2] -0.049 0.842 -1.669 -0.084 1.618 beta [dif: 3] 0.041 0.823 -1.482 0.029 1.751 diff --git a/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt b/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt index c8bb523..0ea7f34 100644 --- a/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt +++ b/tests/results/JAGS-summary-tables/advanced_spike_slab_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -beta (inclusion) 0.527 NA NA NA NA NA NA NA NA -beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 -beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion) 0.527 NA NA NA NA NA NA NA NA +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_transform.txt b/tests/results/JAGS-summary-tables/advanced_transform.txt index f651959..f253e8f 100644 --- a/tests/results/JAGS-summary-tables/advanced_transform.txt +++ b/tests/results/JAGS-summary-tables/advanced_transform.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 1.041 0.109 0.837 1.040 1.276 0.00365 0.034 901 1.001 (mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 (mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 diff --git a/tests/results/JAGS-summary-tables/advanced_unconditional.txt b/tests/results/JAGS-summary-tables/advanced_unconditional.txt index 3d5f3d2..29fb99d 100644 --- a/tests/results/JAGS-summary-tables/advanced_unconditional.txt +++ b/tests/results/JAGS-summary-tables/advanced_unconditional.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 (mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 (mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 diff --git a/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt b/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt index ef5e212..ef02455 100644 --- a/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/empty_runjags_estimates.txt @@ -1,2 +1,2 @@ -[1] Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat +[1] Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat <0 rows> (or 0-length row.names) diff --git a/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt index 6bb0deb..dfadb67 100644 --- a/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_add_parameters_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat m 0.168 0.209 -0.252 0.164 0.570 0.00854 0.041 600 1.004 s 0.951 0.157 0.696 0.925 1.318 0.00861 0.055 332 1.002 g 0.027 0.980 -1.774 -0.001 1.967 0.04004 0.041 600 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt index b8c75bb..b0f9afd 100644 --- a/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_autofit_error_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat m -0.034 1.003 -1.932 -0.060 2.012 0.04937 0.049 452 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt index bc1644d..a0bd9b4 100644 --- a/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_autofit_ess_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat m 0.025 1.002 -1.701 -0.012 2.039 0.06445 0.064 249 0.998 diff --git a/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt index 13ec7aa..63f32c7 100644 --- a/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_complex_bias_runjags_estimates.txt @@ -1,9 +1,9 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 1.019 0.588 0.243 0.891 2.460 0.02375 0.040 613 NA -bias (inclusion) 0.526 NA NA NA NA NA NA NA NA -PET 0.097 0.328 0.000 0.000 1.229 0.01465 0.045 500 NA -PEESE 0.166 0.583 0.000 0.000 2.134 0.02609 0.045 500 NA -omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.025,0.05] 0.887 0.229 0.127 1.000 1.000 0.01024 0.045 500 NA -omega[0.05,0.975] 0.836 0.297 0.070 1.000 1.000 0.01328 0.045 500 NA -omega[0.975,1] 0.896 0.256 0.099 1.000 1.000 0.01146 0.045 500 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 1.019 0.588 0.243 0.891 2.460 0.02375 0.040 613 NA +bias (inclusion) 0.526 NA NA NA NA NA NA NA NA +PET 0.097 0.328 0.000 0.000 1.229 0.01465 0.045 500 NA +PEESE 0.166 0.583 0.000 0.000 2.134 0.02609 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.887 0.229 0.127 1.000 1.000 0.01024 0.045 500 NA +omega[0.05,0.975] 0.836 0.297 0.070 1.000 1.000 0.01328 0.045 500 NA +omega[0.975,1] 0.896 0.256 0.099 1.000 1.000 0.01146 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt index 203ca27..2430665 100644 --- a/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_complex_mixed_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt index 01b7ecd..07bea70 100644 --- a/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_dual_param_regression_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 2.498 0.008 2.482 2.498 2.514 0.00026 0.032 1000 1.009 (mu) x_mu 0.631 0.008 0.617 0.631 0.646 0.00025 0.033 925 1.000 (log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 diff --git a/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt index 7c2585f..590659e 100644 --- a/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_expression_mixture_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat x (inclusion) 0.466 NA NA NA NA NA NA NA NA x 3457.005 110604.018 -62.527 -0.100 65.334 3497.63310 0.032 1000 1.291 x_sigma 2009.580 44689.794 0.233 2.394 1843.054 1809.67684 0.040 804 1.287 diff --git a/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt index 61afab5..dfcc7e4 100644 --- a/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_expression_simple_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat x 6283.001 208274.534 -129.928 -0.009 144.604 5394.96951 0.026 1307 1.192 x_sigma 14992.279 321938.407 0.235 2.202 508.311 10181.93310 0.032 1000 1.236 diff --git a/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt index a54dd03..9771070 100644 --- a/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_expression_spike_slab_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -x (inclusion) 0.530 NA NA NA NA NA NA NA NA -x 542.626 17568.812 -99.394 0.000 34.736 555.57478 0.032 1000 1.290 -x_sigma 3306.894 89013.203 0.158 2.367 831.086 2815.16476 0.032 1000 1.279 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +x (inclusion) 0.530 NA NA NA NA NA NA NA NA +x 542.626 17568.812 -99.394 0.000 34.736 555.57478 0.032 1000 1.290 +x_sigma 3306.894 89013.203 0.158 2.367 831.086 2815.16476 0.032 1000 1.279 diff --git a/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt index 5960ff8..73ceb84 100644 --- a/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_factor_independent_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[1] 0.652 0.486 0.071 0.537 1.886 0.01604 0.033 925 0.999 -p1[2] 0.694 0.476 0.090 0.594 1.922 0.01442 0.030 1105 1.000 -p1[3] 0.685 0.483 0.085 0.595 1.948 0.01527 0.032 1000 1.002 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.652 0.486 0.071 0.537 1.886 0.01604 0.033 925 0.999 +p1[2] 0.694 0.476 0.090 0.594 1.922 0.01442 0.030 1105 1.000 +p1[3] 0.685 0.483 0.085 0.595 1.948 0.01527 0.032 1000 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt index 13ded9d..3ab5d22 100644 --- a/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_factor_meandif_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat p1[1] 0.039 0.496 -0.986 0.060 0.937 0.01570 0.032 1000 1.000 p1[2] -0.012 0.503 -0.967 -0.001 1.026 0.01590 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt index 52e0bfe..988cc6c 100644 --- a/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_factor_orthonormal_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[1] 0.017 0.977 -1.862 0.031 1.936 0.03092 0.032 1000 1.000 -p1[2] 0.050 1.002 -1.998 0.074 1.966 0.03171 0.032 1000 1.001 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 0.017 0.977 -1.862 0.031 1.936 0.03092 0.032 1000 1.000 +p1[2] 0.050 1.002 -1.998 0.074 1.966 0.03171 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt index 1612b96..620b400 100644 --- a/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_factor_treatment_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[2] 0.497 0.291 0.022 0.491 0.973 0.00921 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt index 0b6d5de..5c3642c 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_auto_scaled_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 5.734 7.794 -6.822 4.648 25.392 1.94241 0.249 26 1.218 (mu) x_cont1 0.231 1.061 -1.824 0.266 2.261 0.05771 0.054 598 1.025 (mu) x_cont2 -0.012 1.016 -1.886 -0.035 2.115 0.03337 0.033 935 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt index f8d8234..292028e 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_factor_mixture_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.004 0.120 -0.218 -0.008 0.260 0.00568 0.047 447 1.000 (mu) x_cont 0.195 0.112 -0.039 0.195 0.410 0.00354 0.032 1000 1.001 (mu) x_fac3t (inclusion) 0.398 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt index 3d5f3d2..29fb99d 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_cont_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.035 0.104 -0.178 0.040 0.243 0.00350 0.034 902 1.001 (mu) x_cont1 0.361 0.123 0.124 0.365 0.587 0.00384 0.031 1027 1.000 (mu) x_cont2 -0.029 0.109 -0.241 -0.028 0.190 0.00357 0.033 931 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt index 582aa6f..ec6341a 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_fac_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.060 0.164 -0.251 0.062 0.400 0.00840 0.051 392 1.001 (mu) x_fac2t[B] 0.046 0.228 -0.414 0.048 0.476 0.01168 0.051 381 0.999 (mu) x_fac3o[1] -0.077 0.263 -0.585 -0.074 0.458 0.01262 0.048 437 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt index 4f803e0..0872820 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_main_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.025 0.110 -0.199 0.025 0.228 0.00338 0.031 1071 1.001 (mu) x_cont1 0.448 0.124 0.207 0.449 0.689 0.00392 0.032 1000 1.000 (mu) x_fac3o[1] -0.007 0.185 -0.378 -0.006 0.362 0.00584 0.032 1000 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt index 5b7ba70..bc1d356 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_interaction_mix_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.013 0.113 -0.197 0.016 0.234 0.00359 0.032 1000 1.002 (mu) x_cont1 0.457 0.125 0.215 0.457 0.710 0.00411 0.033 928 1.000 (mu) x_fac3o[1] 0.029 0.189 -0.334 0.026 0.417 0.00585 0.031 1045 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt index 0b6d5de..5c3642c 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_manual_scaled_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 5.734 7.794 -6.822 4.648 25.392 1.94241 0.249 26 1.218 (mu) x_cont1 0.231 1.061 -1.824 0.266 2.261 0.05771 0.054 598 1.025 (mu) x_cont2 -0.012 1.016 -1.886 -0.035 2.115 0.03337 0.033 935 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt index cce5c63..ddd8ea3 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_multi_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.014 0.039 -0.097 -0.013 0.061 0.00115 0.029 1187 1.001 (mu) x_cont1 0.194 0.044 0.110 0.194 0.282 0.00142 0.032 1005 1.000 (sigma_exp) x_fac2t 0.511 0.072 0.368 0.508 0.652 0.00533 0.074 183 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt index 0cd322f..fa464a3 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_orthonormal_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.041 0.097 -0.226 -0.041 0.150 0.00306 0.032 1000 1.001 (mu) x_cont1 0.401 0.107 0.193 0.405 0.600 0.00364 0.034 883 0.999 (mu) x_fac3o[1] 0.187 0.168 -0.148 0.186 0.518 0.00604 0.036 818 1.008 diff --git a/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt index 5c41c2c..5de9197 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_simple_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.042 0.097 -0.242 -0.040 0.149 0.00308 0.032 1000 1.001 (mu) x_cont1 0.391 0.108 0.183 0.393 0.603 0.00317 0.029 1218 1.000 sigma 0.970 0.069 0.846 0.964 1.124 0.00267 0.039 674 1.016 diff --git a/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt index d070a06..9bda0a3 100644 --- a/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_formula_treatment_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.049 0.130 -0.299 -0.048 0.206 0.00679 0.052 371 1.004 (mu) x_cont1 0.394 0.111 0.177 0.399 0.613 0.00351 0.032 1000 0.999 (mu) x_fac2t[B] 0.019 0.182 -0.355 0.021 0.350 0.00950 0.052 380 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt index 3b9dc16..bc04710 100644 --- a/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_joint_complex_runjags_estimates.txt @@ -1,10 +1,10 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept (inclusion) 0.027 NA NA NA NA NA NA NA NA -(mu) intercept -0.001 0.017 0.000 0.000 0.000 0.00052 0.030 1085 1.062 -(mu) x_cont1 (inclusion) 0.363 NA NA NA NA NA NA NA NA -(mu) x_cont1 0.077 0.124 0.000 0.000 0.390 0.00569 0.046 471 1.009 -(mu) x_fac3t (inclusion) 0.066 NA NA NA NA NA NA NA NA -(mu) x_fac3t[1] 0.007 0.049 0.000 0.000 0.126 0.00261 0.053 467 1.000 -(mu) x_fac3t[2] 0.008 0.051 0.000 0.000 0.167 0.00216 0.042 638 1.034 -sigma (inclusion) 0.495 NA NA NA NA NA NA NA NA -sigma 0.972 0.070 0.843 0.969 1.125 0.00250 0.036 815 1.005 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept (inclusion) 0.027 NA NA NA NA NA NA NA NA +(mu) intercept -0.001 0.017 0.000 0.000 0.000 0.00052 0.030 1085 1.062 +(mu) x_cont1 (inclusion) 0.363 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.077 0.124 0.000 0.000 0.390 0.00569 0.046 471 1.009 +(mu) x_fac3t (inclusion) 0.066 NA NA NA NA NA NA NA NA +(mu) x_fac3t[1] 0.007 0.049 0.000 0.000 0.126 0.00261 0.053 467 1.000 +(mu) x_fac3t[2] 0.008 0.051 0.000 0.000 0.167 0.00216 0.042 638 1.034 +sigma (inclusion) 0.495 NA NA NA NA NA NA NA NA +sigma 0.972 0.070 0.843 0.969 1.125 0.00250 0.036 815 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt index c0fad92..58406d6 100644 --- a/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_marginal_0_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.616 0.037 0.543 0.615 0.689 0.00117 0.032 1000 1.001 -(mu) x_cont1 0.367 0.083 0.205 0.366 0.531 0.00262 0.032 1000 1.002 -sigma 0.517 0.029 0.465 0.515 0.582 0.00114 0.039 646 1.010 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.616 0.037 0.543 0.615 0.689 0.00117 0.032 1000 1.001 +(mu) x_cont1 0.367 0.083 0.205 0.366 0.531 0.00262 0.032 1000 1.002 +sigma 0.517 0.029 0.465 0.515 0.582 0.00114 0.039 646 1.010 diff --git a/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt index 1f3742e..a5dad31 100644 --- a/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_marginal_1_runjags_estimates.txt @@ -1,9 +1,9 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.612 0.055 0.500 0.614 0.724 0.00291 0.053 382 1.000 -(mu) x_cont1 0.354 0.086 0.185 0.354 0.515 0.00298 0.035 824 1.000 -(mu) x_fac2t[B] 0.009 0.077 -0.134 0.006 0.170 0.00422 0.055 341 1.001 -(mu) x_fac3md[1] 0.019 0.053 -0.087 0.020 0.124 0.00150 0.028 1423 1.003 -(mu) x_fac3md[2] 0.154 0.054 0.047 0.155 0.258 0.00180 0.033 916 1.006 -(mu) x_cont1:x_fac3md[1] 0.018 0.058 -0.094 0.018 0.136 0.00192 0.033 928 0.999 -(mu) x_cont1:x_fac3md[2] 0.036 0.058 -0.081 0.037 0.150 0.00197 0.034 871 1.001 -sigma 0.509 0.028 0.458 0.508 0.566 0.00136 0.049 442 1.022 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.612 0.055 0.500 0.614 0.724 0.00291 0.053 382 1.000 +(mu) x_cont1 0.354 0.086 0.185 0.354 0.515 0.00298 0.035 824 1.000 +(mu) x_fac2t[B] 0.009 0.077 -0.134 0.006 0.170 0.00422 0.055 341 1.001 +(mu) x_fac3md[1] 0.019 0.053 -0.087 0.020 0.124 0.00150 0.028 1423 1.003 +(mu) x_fac3md[2] 0.154 0.054 0.047 0.155 0.258 0.00180 0.033 916 1.006 +(mu) x_cont1:x_fac3md[1] 0.018 0.058 -0.094 0.018 0.136 0.00192 0.033 928 0.999 +(mu) x_cont1:x_fac3md[2] 0.036 0.058 -0.081 0.037 0.150 0.00197 0.034 871 1.001 +sigma 0.509 0.028 0.458 0.508 0.566 0.00136 0.049 442 1.022 diff --git a/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt index fb47423..4a5dd6a 100644 --- a/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_marginal_ss_runjags_estimates.txt @@ -1,13 +1,13 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.618 0.038 0.545 0.618 0.690 0.00132 0.035 853 0.999 -(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA -(mu) x_cont1 0.358 0.084 0.197 0.357 0.518 0.00282 0.034 897 1.003 -(mu) x_fac2t (inclusion) 0.056 NA NA NA NA NA NA NA NA -(mu) x_fac2t[B] 0.000 0.018 -0.009 0.000 0.009 0.00086 0.048 469 1.003 -(mu) x_fac3md (inclusion) 0.827 NA NA NA NA NA NA NA NA -(mu) x_fac3md[1] 0.016 0.050 -0.083 0.004 0.129 0.00161 0.032 958 1.002 -(mu) x_fac3md[2] 0.135 0.078 0.000 0.150 0.262 0.00520 0.067 225 1.004 -(mu) x_cont1:x_fac3md (inclusion) 0.075 NA NA NA NA NA NA NA NA -(mu) x_cont1:x_fac3md[1] 0.002 0.016 0.000 0.000 0.039 0.00048 0.031 1092 1.046 -(mu) x_cont1:x_fac3md[2] 0.003 0.018 0.000 0.000 0.062 0.00056 0.031 1107 1.027 -sigma 0.509 0.028 0.459 0.507 0.564 0.00119 0.043 535 1.001 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.618 0.038 0.545 0.618 0.690 0.00132 0.035 853 0.999 +(mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA +(mu) x_cont1 0.358 0.084 0.197 0.357 0.518 0.00282 0.034 897 1.003 +(mu) x_fac2t (inclusion) 0.056 NA NA NA NA NA NA NA NA +(mu) x_fac2t[B] 0.000 0.018 -0.009 0.000 0.009 0.00086 0.048 469 1.003 +(mu) x_fac3md (inclusion) 0.827 NA NA NA NA NA NA NA NA +(mu) x_fac3md[1] 0.016 0.050 -0.083 0.004 0.129 0.00161 0.032 958 1.002 +(mu) x_fac3md[2] 0.135 0.078 0.000 0.150 0.262 0.00520 0.067 225 1.004 +(mu) x_cont1:x_fac3md (inclusion) 0.075 NA NA NA NA NA NA NA NA +(mu) x_cont1:x_fac3md[1] 0.002 0.016 0.000 0.000 0.039 0.00048 0.031 1092 1.046 +(mu) x_cont1:x_fac3md[2] 0.003 0.018 0.000 0.000 0.062 0.00056 0.031 1107 1.027 +sigma 0.509 0.028 0.459 0.507 0.564 0.00119 0.043 535 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt index 21bd192..116f13d 100644 --- a/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_missing_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 0.201 0.198 -0.181 0.200 0.591 0.00442 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.201 0.198 -0.181 0.200 0.591 0.00442 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt index 030990e..0aa6d2c 100644 --- a/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_mixture_components_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat beta (inclusion: b) 0.171 NA NA NA NA NA NA NA NA beta (inclusion: a) 0.829 NA NA NA NA NA NA NA NA beta -2.532 1.502 -4.985 -2.755 0.888 0.04607 0.031 1073 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt index 43fd1d5..e10b28f 100644 --- a/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_mixture_simple_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat mu (inclusion) 0.721 NA NA NA NA NA NA NA NA mu -2.094 1.720 -4.668 -2.463 1.020 0.05747 0.033 908 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt index 6e9c0ae..60a820f 100644 --- a/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_mixture_spike_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat gamma (inclusion) 1.000 NA NA NA NA NA NA NA NA gamma -0.489 2.545 -4.498 -0.843 2.000 0.08051 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt index 1ebcd40..10fc547 100644 --- a/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_no_autofit_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.046 0.990 -1.728 0.000 2.114 0.09487 0.096 112 1.024 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.046 0.990 -1.728 0.000 2.114 0.09487 0.096 112 1.024 diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt index d52d75a..c80a6c8 100644 --- a/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_0_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.510 0.084 0.345 0.510 0.675 0.00067 0.008 15675 1.000 -sigma 0.922 0.060 0.812 0.919 1.049 0.00060 0.010 10076 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.510 0.084 0.345 0.510 0.675 0.00067 0.008 15675 1.000 +sigma 0.922 0.060 0.812 0.919 1.049 0.00060 0.010 10076 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt index 6259c80..f21425e 100644 --- a/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_orthonormal_1_runjags_estimates.txt @@ -1,5 +1,5 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.512 0.081 0.352 0.512 0.667 0.00063 0.008 16217 1.000 -(mu) x_fac3o[1] 0.445 0.135 0.181 0.445 0.709 0.00107 0.008 15913 1.000 -(mu) x_fac3o[2] 0.024 0.136 -0.247 0.027 0.289 0.00109 0.008 15629 1.000 -sigma 0.885 0.058 0.781 0.882 1.005 0.00058 0.010 9955 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.512 0.081 0.352 0.512 0.667 0.00063 0.008 16217 1.000 +(mu) x_fac3o[1] 0.445 0.135 0.181 0.445 0.709 0.00107 0.008 15913 1.000 +(mu) x_fac3o[2] 0.024 0.136 -0.247 0.027 0.289 0.00109 0.008 15629 1.000 +sigma 0.885 0.058 0.781 0.882 1.005 0.00058 0.010 9955 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt index d41ce15..14d1855 100644 --- a/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_parallel_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.189 0.206 -0.229 0.185 0.621 0.00838 0.041 600 1.012 -s 0.946 0.157 0.689 0.928 1.309 0.00859 0.055 332 1.008 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.189 0.206 -0.229 0.185 0.621 0.00838 0.041 600 1.012 +s 0.946 0.157 0.689 0.928 1.309 0.00859 0.055 332 1.008 diff --git a/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt index 28d7416..f3e6e5b 100644 --- a/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_peese_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -PEESE 0.644 0.489 0.025 0.545 1.774 0.01094 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +PEESE 0.644 0.489 0.025 0.545 1.774 0.01094 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt index 1691276..df01a71 100644 --- a/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_pet_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -PET 0.157 0.120 0.005 0.130 0.444 0.00269 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +PET 0.157 0.120 0.005 0.130 0.444 0.00269 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt index b2eec47..c367424 100644 --- a/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope2_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 0.286 0.138 0.016 0.282 0.560 0.00610 0.044 513 1.007 (mu) x_fac3[1] -0.345 0.185 -0.726 -0.340 0.013 0.00773 0.042 573 1.002 (mu) x_fac3[2] 0.134 0.179 -0.228 0.136 0.493 0.00750 0.042 687 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt index f8c278e..360dbd8 100644 --- a/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope3_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) x_fac3[A] 0.433 0.190 0.060 0.433 0.824 0.00666 0.035 856 1.005 (mu) x_fac3[B] 0.517 0.215 0.071 0.523 0.932 0.00901 0.042 608 1.002 (mu) x_fac3[C] -0.081 0.248 -0.559 -0.074 0.396 0.00942 0.038 693 1.004 diff --git a/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt index 8b0f29e..95759ef 100644 --- a/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_random_factor_slope_runjags_estimates.txt @@ -1,7 +1,7 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.298 0.134 0.024 0.300 0.545 0.00668 0.050 419 1.014 -(mu) x_cont1 0.495 0.120 0.261 0.496 0.734 0.00379 0.032 1005 1.003 -sd((mu) intercept|id) 0.185 0.141 0.007 0.155 0.530 0.00690 0.049 418 1.001 -sd((mu) x_fac3[B]|id) 0.336 0.226 0.021 0.294 0.837 0.01145 0.051 395 1.002 -sd((mu) x_fac3[C]|id) 0.343 0.235 0.013 0.317 0.870 0.01117 0.048 444 1.000 -sigma 1.043 0.084 0.895 1.033 1.222 0.00365 0.044 544 1.009 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.298 0.134 0.024 0.300 0.545 0.00668 0.050 419 1.014 +(mu) x_cont1 0.495 0.120 0.261 0.496 0.734 0.00379 0.032 1005 1.003 +sd((mu) intercept|id) 0.185 0.141 0.007 0.155 0.530 0.00690 0.049 418 1.001 +sd((mu) x_fac3[B]|id) 0.336 0.226 0.021 0.294 0.837 0.01145 0.051 395 1.002 +sd((mu) x_fac3[C]|id) 0.343 0.235 0.013 0.317 0.870 0.01117 0.048 444 1.000 +sigma 1.043 0.084 0.895 1.033 1.222 0.00365 0.044 544 1.009 diff --git a/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt index 591eba8..c4fbb54 100644 --- a/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_random_intercept_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.331 0.145 0.054 0.328 0.619 0.00590 0.041 603 1.027 -sd((mu) intercept|id) 0.195 0.148 0.008 0.166 0.578 0.00811 0.055 335 0.999 -sigma 1.152 0.081 1.004 1.149 1.319 0.00355 0.044 519 1.002 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.331 0.145 0.054 0.328 0.619 0.00590 0.041 603 1.027 +sd((mu) intercept|id) 0.195 0.148 0.008 0.166 0.578 0.00811 0.055 335 0.999 +sigma 1.152 0.081 1.004 1.149 1.319 0.00355 0.044 519 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt index d64e1f6..fd15e78 100644 --- a/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_random_slope_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) intercept 0.326 0.109 0.117 0.327 0.536 0.00358 0.033 933 1.005 -sd((mu) x_cont1|id) 0.513 0.191 0.156 0.501 0.923 0.01198 0.063 256 1.000 -sigma 1.068 0.079 0.922 1.065 1.231 0.00408 0.052 377 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 0.326 0.109 0.117 0.327 0.536 0.00358 0.033 933 1.005 +sd((mu) x_cont1|id) 0.513 0.191 0.156 0.501 0.923 0.01198 0.063 256 1.000 +sigma 1.068 0.079 0.922 1.065 1.231 0.00408 0.052 377 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt index e6c714c..14962c2 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_formula_mixed_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.151 0.044 -0.235 -0.150 -0.065 0.00198 0.045 500 NA (mu) x_cont1 0.285 0.064 0.166 0.289 0.412 0.00285 0.045 500 NA (mu) x_fac2t 0.064 0.066 -0.071 0.066 0.194 0.00297 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt index 7d673c6..a19f99d 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_normal_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 -s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.047 0.059 -0.070 0.047 0.161 0.00185 0.032 1000 1.003 +s 0.425 0.046 0.348 0.421 0.525 0.00199 0.043 540 1.005 diff --git a/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt index 7585d05..f83ba58 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_pub_bias_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -PET 0.819 0.625 0.041 0.671 2.263 0.01978 0.032 1000 0.999 -PEESE 1.031 1.020 0.034 0.735 3.787 0.03222 0.032 1000 1.013 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +PET 0.819 0.625 0.041 0.671 2.263 0.01978 0.032 1000 0.999 +PEESE 1.031 1.020 0.034 0.735 3.787 0.03222 0.032 1000 1.013 diff --git a/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt index 1e074a2..1c5ca83 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_spike_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -s 0.423 0.043 0.352 0.420 0.514 0.00191 0.044 509 1.002 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +s 0.423 0.043 0.352 0.420 0.514 0.00191 0.044 509 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt index ccae69e..017c74e 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_thin_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 0.033 1.031 -1.956 0.080 2.016 0.04722 0.046 496 1.001 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.033 1.031 -1.956 0.080 2.016 0.04722 0.046 496 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt index e1ce884..1f9e118 100644 --- a/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_simple_various_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat p1 0.038 1.023 -1.996 0.021 2.135 0.03234 0.032 1000 1.002 p2 1.117 0.632 0.372 0.965 2.706 0.02082 0.033 919 1.005 p3 -0.010 0.666 -1.270 -0.022 1.408 0.02265 0.034 886 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt index 9ffa3ae..fa02693 100644 --- a/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_spike_factors_runjags_estimates.txt @@ -1,6 +1,6 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -(mu) x_fac2i[A] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA -(mu) x_fac2i[B] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA -(mu) x_fac3t[B] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA -(mu) x_fac3t[C] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA -sigma 2.575 0.185 2.257 2.561 2.969 0.00853 0.046 557 1.043 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) x_fac2i[A] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA +(mu) x_fac2i[B] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA +(mu) x_fac3t[B] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA +(mu) x_fac3t[C] 2.000 0.000 2.000 2.000 2.000 0.00000 NA 0 NA +sigma 2.575 0.185 2.257 2.561 2.969 0.00853 0.046 557 1.043 diff --git a/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt index c8bb523..0ea7f34 100644 --- a/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_spike_slab_factor_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -beta (inclusion) 0.527 NA NA NA NA NA NA NA NA -beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 -beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +beta (inclusion) 0.527 NA NA NA NA NA NA NA NA +beta[1] 0.034 0.747 -1.569 0.000 1.759 0.02357 0.032 1000 1.006 +beta[2] 0.005 0.721 -1.680 0.000 1.639 0.02281 0.032 1000 1.000 diff --git a/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt index 9f5d5b8..a5be759 100644 --- a/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_spike_slab_simple_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu (inclusion) 0.504 NA NA NA NA NA NA NA NA -mu -0.003 0.666 -1.553 0.000 1.506 0.02105 0.032 1000 1.003 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu (inclusion) 0.504 NA NA NA NA NA NA NA NA +mu -0.003 0.666 -1.553 0.000 1.506 0.02105 0.032 1000 1.003 diff --git a/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt index 171d74d..393793e 100644 --- a/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_summary0_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.198 0.212 -0.204 0.193 0.632 0.01019 0.048 434 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.198 0.212 -0.204 0.193 0.632 0.01019 0.048 434 NA diff --git a/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt index 564650e..400c1bc 100644 --- a/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_summary1_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.155 0.198 -0.247 0.167 0.497 0.00921 0.047 461 NA -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.509 0.301 0.028 0.508 0.983 0.01348 0.045 500 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.155 0.198 -0.247 0.167 0.497 0.00921 0.047 461 NA +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.509 0.301 0.028 0.508 0.983 0.01348 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt index 9a0dc20..c694388 100644 --- a/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_summary2_runjags_estimates.txt @@ -1,5 +1,5 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.125 0.176 -0.202 0.128 0.479 0.00787 0.045 500 NA -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,0.5] 0.666 0.237 0.157 0.710 0.988 0.01061 0.045 500 NA -omega[0.5,1] 0.353 0.229 0.017 0.333 0.837 0.01023 0.045 500 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.125 0.176 -0.202 0.128 0.479 0.00787 0.045 500 NA +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,0.5] 0.666 0.237 0.157 0.710 0.988 0.01061 0.045 500 NA +omega[0.5,1] 0.353 0.229 0.017 0.333 0.837 0.01023 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt index c489ca4..eaf0a2a 100644 --- a/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_summary3_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -m 0.132 0.173 -0.219 0.132 0.482 0.00772 0.045 500 NA -omega[0,0.2] 0.300 0.000 0.300 0.300 0.300 NA NA NA NA -omega[0.2,1] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +m 0.132 0.173 -0.219 0.132 0.482 0.00772 0.045 500 NA +omega[0,0.2] 0.300 0.000 0.300 0.300 0.300 NA NA NA NA +omega[0.2,1] 1.000 0.000 1.000 1.000 1.000 0.00000 NA 0 NA diff --git a/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt index 173fd55..3f17467 100644 --- a/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_vector_mcauchy_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat p1[1] -0.227 16.382 -16.511 -0.071 18.750 0.51809 0.032 1000 1.031 p1[2] 1.192 34.440 -15.713 -0.088 19.254 1.08910 0.032 1000 1.244 diff --git a/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt index e3d0127..51a8896 100644 --- a/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_vector_mnormal_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat p1[1] 0.012 0.997 -1.956 0.042 1.967 0.03154 0.032 1000 1.001 p1[2] -0.009 0.994 -1.884 -0.024 2.035 0.03144 0.032 1000 0.999 p1[3] 0.010 0.988 -1.985 0.047 1.893 0.03124 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt index 1e411d9..b4ed8d2 100644 --- a/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_vector_mt_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -p1[1] 1.990 0.627 0.887 1.974 3.230 0.01982 0.032 1000 1.002 -p1[2] 2.026 0.639 0.737 2.044 3.280 0.02022 0.032 1000 1.001 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +p1[1] 1.990 0.627 0.887 1.974 3.230 0.01982 0.032 1000 1.002 +p1[2] 2.026 0.639 0.737 2.044 3.280 0.02022 0.032 1000 1.001 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt index 9877c68..27ade75 100644 --- a/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_fixed_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.500 0.000 0.500 0.500 0.500 0.00000 NA 0 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.500 0.000 0.500 0.500 0.500 0.00000 NA 0 NA diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt index dcfb027..5309229 100644 --- a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided2_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.510 0.283 0.037 0.525 0.968 0.00894 0.032 1000 0.999 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.510 0.283 0.037 0.525 0.968 0.00894 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt index 527e780..0bb034e 100644 --- a/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_onesided3_runjags_estimates.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,0.1] 0.834 0.145 0.467 0.871 0.994 0.00458 0.032 1000 1.001 -omega[0.1,1] 0.510 0.187 0.154 0.510 0.852 0.00592 0.032 1000 0.999 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,0.1] 0.834 0.145 0.467 0.871 0.994 0.00458 0.032 1000 1.001 +omega[0.1,1] 0.510 0.187 0.154 0.510 0.852 0.00592 0.032 1000 0.999 diff --git a/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt index acdcbe8..bee0b45 100644 --- a/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_weightfunction_twosided_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.506 0.297 0.027 0.514 0.975 0.00998 0.034 896 1.002 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.506 0.297 0.027 0.514 0.975 0.00998 0.034 896 1.002 diff --git a/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt index ed26799..2d5d8d1 100644 --- a/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_wf_missing_runjags_estimates.txt @@ -1,2 +1,2 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 0.005 0.790 -1.525 0.002 1.564 0.01767 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 0.005 0.790 -1.525 0.002 1.564 0.01767 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt index 873897a..0289900 100644 --- a/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_wf_onesided_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.025,1] 0.509 0.289 0.028 0.517 0.978 0.00647 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,1] 0.509 0.289 0.028 0.517 0.978 0.00647 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt b/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt index 31d8a6c..a83381d 100644 --- a/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt +++ b/tests/results/JAGS-summary-tables/fit_wf_twosided_runjags_estimates.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.05,1] 0.503 0.285 0.032 0.508 0.979 0.00638 0.022 2000 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +omega[0,0.05] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.05,1] 0.503 0.285 0.032 0.508 0.979 0.00638 0.022 2000 NA diff --git a/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt b/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt index ba1be3e..e0a1c3e 100644 --- a/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt +++ b/tests/results/JAGS-summary-tables/runjags_factor_conditional.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI -p1[1] 0.017 0.977 -1.862 0.031 1.936 -p1[2] 0.050 1.002 -1.998 0.074 1.966 + Mean SD 0.025 0.5 0.975 +p1[1] 0.017 0.977 -1.862 0.031 1.936 +p1[2] 0.050 1.002 -1.998 0.074 1.966 diff --git a/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt b/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt index 1625dee..80e739a 100644 --- a/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt +++ b/tests/results/JAGS-summary-tables/runjags_factor_conditional_transformed.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI + Mean SD 0.025 0.5 0.975 p1 [dif: 1] 0.041 0.818 -1.631 0.060 1.605 p1 [dif: 2] -0.033 0.796 -1.612 -0.029 1.527 p1 [dif: 3] -0.008 0.811 -1.550 -0.009 1.564 diff --git a/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt b/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt index 06c9e01..2312efa 100644 --- a/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt +++ b/tests/results/JAGS-summary-tables/runjags_mixture_conditional.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI + Mean SD 0.025 0.5 0.975 mu (inclusion) 0.721 NA NA NA NA mu -3.003 0.951 -4.813 -2.981 -1.128 diff --git a/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt b/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt index 88747a6..e42c529 100644 --- a/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt +++ b/tests/results/JAGS-summary-tables/runjags_pub_bias_conditional.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI -PET 0.819 0.625 0.041 0.671 2.263 -PEESE 1.031 1.020 0.034 0.735 3.787 + Mean SD 0.025 0.5 0.975 +PET 0.819 0.625 0.041 0.671 2.263 +PEESE 1.031 1.020 0.034 0.735 3.787 diff --git a/tests/results/JAGS-summary-tables/runjags_remove_diagnostics.txt b/tests/results/JAGS-summary-tables/runjags_remove_diagnostics.txt new file mode 100644 index 0000000..2e2ce8e --- /dev/null +++ b/tests/results/JAGS-summary-tables/runjags_remove_diagnostics.txt @@ -0,0 +1,5 @@ + Mean SD 0.025 0.5 0.975 +(mu) intercept 2.498 0.008 2.482 2.498 2.514 +(mu) x_mu 0.631 0.008 0.617 0.631 0.646 +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 diff --git a/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt b/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt index a5a5ceb..b4cd50b 100644 --- a/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt +++ b/tests/results/JAGS-summary-tables/runjags_spike_slab_conditional.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI -mu (inclusion) 0.504 NA NA NA NA -mu -0.006 0.939 -2.015 0.013 1.900 + Mean SD 0.025 0.5 0.975 +mu (inclusion) 0.504 NA NA NA NA +mu -0.006 0.939 -2.015 0.013 1.900 diff --git a/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt b/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt index 6551bab..94c330f 100644 --- a/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt +++ b/tests/results/JAGS-summary-tables/runjags_summary_complex2.txt @@ -1,12 +1,12 @@ - Mean SD lCI Median uCI -mu 1.019 0.588 0.243 0.891 2.460 -bias (inclusion) 0.526 NA NA NA NA -PET 0.823 0.562 0.034 0.831 2.016 -PEESE 1.365 1.080 0.060 1.208 3.836 -omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 -omega[0.025,0.05] 0.604 0.267 0.062 0.657 0.970 -omega[0.05,0.975] 0.427 0.272 0.018 0.408 0.937 -omega[0.975,1] 0.635 0.367 0.038 0.651 1.000 + Mean SD 0.025 0.5 0.975 +mu 1.019 0.588 0.243 0.891 2.460 +bias (inclusion) 0.526 NA NA NA NA +PET 0.823 0.562 0.034 0.831 2.016 +PEESE 1.365 1.080 0.060 1.208 3.836 +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 +omega[0.025,0.05] 0.604 0.267 0.062 0.657 0.970 +omega[0.05,0.975] 0.427 0.272 0.018 0.408 0.937 +omega[0.975,1] 0.635 0.367 0.038 0.651 1.000 Conditional summary for PET is based on 59 samples. Conditional summary for PEESE is based on 61 samples. Conditional summary for omega is based on 143 samples. diff --git a/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt b/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt index 79430be..fdd01a3 100644 --- a/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt +++ b/tests/results/JAGS-summary-tables/runjags_summary_complex3.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI + Mean SD 0.025 0.5 0.975 (mu) intercept (inclusion) 0.738 NA NA NA NA (mu) intercept -0.140 0.049 -0.228 -0.143 -0.034 (mu) x_cont1 (inclusion) 1.000 NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/stan_estimates_basic.txt b/tests/results/JAGS-summary-tables/stan_estimates_basic.txt index 76d4fc3..1fdc38e 100644 --- a/tests/results/JAGS-summary-tables/stan_estimates_basic.txt +++ b/tests/results/JAGS-summary-tables/stan_estimates_basic.txt @@ -1,8 +1,8 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 -sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 -pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 -mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 +pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 diff --git a/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt b/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt index 87caabb..39cb308 100644 --- a/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt +++ b/tests/results/JAGS-summary-tables/stan_estimates_basic2.txt @@ -1,8 +1,8 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -mu 4.514 1.718 0.811 4.157 2.159 1.06422 0.620 37 1.012 -sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 -pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 -mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 -mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +mu 4.514 1.718 0.811 4.157 2.159 1.06422 0.620 37 1.012 +sigma2 1.501 1.075 0.525 1.270 3.784 0.21677 0.202 25 1.150 +pooled_sigma 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[1] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +sigma_i[2] 1.169 0.371 0.725 1.127 1.945 0.07779 0.210 23 1.178 +mu_i[1] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 +mu_i[2] 1.439 0.377 0.811 1.425 2.159 0.06224 0.165 37 1.012 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt index 01b7ecd..07bea70 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal01.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept 2.498 0.008 2.482 2.498 2.514 0.00026 0.032 1000 1.009 (mu) x_mu 0.631 0.008 0.617 0.631 0.646 0.00025 0.033 925 1.000 (log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt index b203bde..4adc2b8 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal02.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 (log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt index b203bde..4adc2b8 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal03.txt @@ -1,3 +1,3 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 (log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt index 203ca27..2430665 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal04.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt index 2fbecbd..b91bff7 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal05.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt index a3e7c82..b08b656 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal06.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 0.273 0.063 0.150 0.273 0.398 0.00330 0.053 361 NA (mu) x_fac2t 0.009 0.032 0.000 0.000 0.129 0.00217 0.069 211 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt index d2ebb85..5f5bdab 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal07.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt index 5d35d6b..627084f 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal08.txt @@ -1,4 +1,4 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat (mu) intercept (inclusion) 0.738 NA NA NA NA NA NA NA NA (mu) intercept -0.103 0.075 -0.222 -0.118 0.000 0.01088 0.146 47 NA (mu) x_cont1 (inclusion) 1.000 NA NA NA NA NA NA NA NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt index ceaffe2..04da98b 100644 --- a/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt +++ b/tests/results/JAGS-summary-tables/summary_parameter_or_formula_removal09.txt @@ -1,10 +1,10 @@ - Mean SD lCI Median uCI error(MCMC) error(MCMC)/SD ESS R-hat -sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA -sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA -sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA -bias (inclusion) 0.476 NA NA NA NA NA NA NA NA -PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA -omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA -omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA -omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA -omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +sigma (inclusion: normal) 0.422 NA NA NA NA NA NA NA NA +sigma (inclusion: lognormal) 0.578 NA NA NA NA NA NA NA NA +sigma 0.803 0.034 0.736 0.803 0.876 0.00263 0.078 166 NA +bias (inclusion) 0.476 NA NA NA NA NA NA NA NA +PET 0.105 0.332 0.000 0.000 1.346 0.01484 0.045 500 NA +omega[0,0.025] 1.000 0.000 1.000 1.000 1.000 NA NA NA NA +omega[0.025,0.05] 0.871 0.249 0.100 1.000 1.000 0.01112 0.045 500 NA +omega[0.05,0.975] 0.815 0.314 0.047 1.000 1.000 0.01406 0.045 500 NA +omega[0.975,1] 0.895 0.261 0.091 1.000 1.000 0.01169 0.045 500 NA diff --git a/tests/results/JAGS-summary-tables/summary_parameter_probs1.txt b/tests/results/JAGS-summary-tables/summary_parameter_probs1.txt new file mode 100644 index 0000000..07bea70 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_probs1.txt @@ -0,0 +1,5 @@ + Mean SD 0.025 0.5 0.975 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 2.498 0.008 2.482 2.498 2.514 0.00026 0.032 1000 1.009 +(mu) x_mu 0.631 0.008 0.617 0.631 0.646 0.00025 0.033 925 1.000 +(log_sigma) intercept 0.285 0.006 0.273 0.285 0.298 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.370 -0.325 -0.280 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_probs2.txt b/tests/results/JAGS-summary-tables/summary_parameter_probs2.txt new file mode 100644 index 0000000..531ea59 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_probs2.txt @@ -0,0 +1,5 @@ + Mean SD 0.5 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 2.498 0.008 2.498 0.00026 0.032 1000 1.009 +(mu) x_mu 0.631 0.008 0.631 0.00025 0.033 925 1.000 +(log_sigma) intercept 0.285 0.006 0.285 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.325 0.00106 0.045 524 1.001 diff --git a/tests/results/JAGS-summary-tables/summary_parameter_probs3.txt b/tests/results/JAGS-summary-tables/summary_parameter_probs3.txt new file mode 100644 index 0000000..11d46d1 --- /dev/null +++ b/tests/results/JAGS-summary-tables/summary_parameter_probs3.txt @@ -0,0 +1,5 @@ + Mean SD 0.25 0.2 0.99 error(MCMC) error(MCMC)/SD ESS R-hat +(mu) intercept 2.498 0.008 2.492 2.491 2.517 0.00026 0.032 1000 1.009 +(mu) x_mu 0.631 0.008 0.626 0.625 0.651 0.00025 0.033 925 1.000 +(log_sigma) intercept 0.285 0.006 0.281 0.280 0.300 0.00025 0.039 669 1.003 +(log_sigma) x_sigma -0.324 0.024 -0.341 -0.344 -0.270 0.00106 0.045 524 1.001 diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index 0ca5b46..bac6fdf 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -166,6 +166,19 @@ test_that("Summary table advanced features work correctly", { test_reference_table(runjags_summary_removal_07, "summary_parameter_or_formula_removal07.txt", "Parameter/formula removal") test_reference_table(runjags_summary_removal_08, "summary_parameter_or_formula_removal08.txt", "Parameter/formula removal") test_reference_table(runjags_summary_removal_09, "summary_parameter_or_formula_removal09.txt", "Parameter/formula removal") + + # Custom probs + runjags_summary_probs_01 <- JAGS_estimates_table(fit_dual_param) + runjags_summary_probs_02 <- JAGS_estimates_table(fit_dual_param, probs = c(0.5)) + runjags_summary_probs_03 <- JAGS_estimates_table(fit_dual_param, probs = c(0.25, 0.20, 0.99)) + + test_reference_table(runjags_summary_probs_01, "summary_parameter_probs1.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_probs_02, "summary_parameter_probs2.txt", "Parameter/formula removal") + test_reference_table(runjags_summary_probs_03, "summary_parameter_probs3.txt", "Parameter/formula removal") + + # Remove diagnostics + runjags_remove_diagnostics <- JAGS_estimates_table(fit_dual_param, remove_diagnostics = TRUE) + test_reference_table(runjags_remove_diagnostics, "runjags_remove_diagnostics.txt", "Diagnostics removal") }) # ============================================================================ # From 5056f476478e27071417a2a0be89437e409c5d9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Thu, 1 Jan 2026 22:46:48 +0100 Subject: [PATCH 24/38] Handle bias-related parameters in filter helpers Enhances parameter filtering to automatically include PET, PEESE, and omega when 'bias' is specified in remove_parameters or keep_parameters, based on the bias prior type. Updates documentation and adds comprehensive tests to verify correct handling of bias-related parameters. --- NEWS.md | 1 + R/posterior-extraction.R | 60 +++++++- man/posterior_extraction_helpers.Rd | 8 +- .../testthat/test-JAGS-posterior-extraction.R | 136 ++++++++++++++++++ 4 files changed, 201 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index f92731a..0f52857 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,7 @@ - `remove_formulas` to remove all parameters from specific formulas - `keep_parameters` to keep only specified parameters - `keep_formulas` to keep only parameters from specified formulas + - when `bias` is specified in `remove_parameters` or `keep_parameters`, the corresponding bias-related parameters (`PET`, `PEESE`, `omega`) are automatically included based on the bias prior type - adds `probs` argument to `runjags_estimates_table()` and `runjags_estimates_empty_table()` for custom quantiles (default: `c(0.025, 0.5, 0.975)`) ### Changes diff --git a/R/posterior-extraction.R b/R/posterior-extraction.R index fa589f5..e46e8e6 100644 --- a/R/posterior-extraction.R +++ b/R/posterior-extraction.R @@ -126,6 +126,14 @@ NULL # factor prior: remove all indexed columns cols_to_remove <- .JAGS_prior_factor_names(par_name, prior) + } else if (is.prior.PET(prior)) { + # PET prior: remove the PET column (samples are stored as "PET", not par_name) + cols_to_remove <- c(par_name, "PET") + + } else if (is.prior.PEESE(prior)) { + # PEESE prior: remove the PEESE column (samples are stored as "PEESE", not par_name) + cols_to_remove <- c(par_name, "PEESE") + } else { # simple prior: just remove the main column cols_to_remove <- par_name @@ -142,9 +150,13 @@ NULL #' @rdname posterior_extraction_helpers -#' @param remove_parameters character vector of parameter names to remove, or TRUE to remove all non-formula parameters +#' @param remove_parameters character vector of parameter names to remove, or TRUE to remove all non-formula parameters. +#' If "bias" is specified and the bias prior contains PET, PEESE, or weightfunction priors, +#' the corresponding parameters (PET, PEESE, omega) are also added to the removal list. #' @param remove_formulas character vector of formula names whose parameters should be removed -#' @param keep_parameters character vector of parameter names to keep (all others removed unless in keep_formulas) +#' @param keep_parameters character vector of parameter names to keep (all others removed unless in keep_formulas). +#' If "bias" is specified and the bias prior contains PET, PEESE, or weightfunction priors, +#' the corresponding parameters (PET, PEESE, omega) are also added to the keep list. #' @param keep_formulas character vector of formula names whose parameters should be kept (all others removed unless in keep_parameters) #' @param remove_spike_0 whether to remove spike at 0 priors #' @return list with filtered model_samples and prior_list @@ -155,8 +167,39 @@ NULL prior_formulas <- sapply(prior_list, function(p) { form <- attr(p, "parameter") if (is.null(form)) "__none" else form + }) + # helper function to get bias-related parameters (PET, PEESE, omega) from a bias prior + .get_bias_params <- function(prior_list, bias_name = "bias") { + bias_params <- character(0) + if (bias_name %in% names(prior_list)) { + bias_prior <- prior_list[[bias_name]] + if (is.prior.mixture(bias_prior)) { + if (any(sapply(bias_prior, is.prior.PET))) { + bias_params <- c(bias_params, "PET") + } + if (any(sapply(bias_prior, is.prior.PEESE))) { + bias_params <- c(bias_params, "PEESE") + } + if (any(sapply(bias_prior, is.prior.weightfunction))) { + bias_params <- c(bias_params, "omega") + } + } else { + if (is.prior.PET(bias_prior)) { + bias_params <- c(bias_params, "PET") + } + if (is.prior.PEESE(bias_prior)) { + bias_params <- c(bias_params, "PEESE") + } + if (is.prior.weightfunction(bias_prior)) { + bias_params <- c(bias_params, "omega") + } + } + } + return(bias_params) + } + # initialize parameters to remove params_to_remove <- character(0) @@ -175,6 +218,10 @@ NULL params_to_remove <- c(params_to_remove, non_formula_params) } else if (is.character(remove_parameters)) { params_to_remove <- c(params_to_remove, remove_parameters) + # if "bias" is in remove_parameters, also add corresponding bias-related parameters + if ("bias" %in% remove_parameters) { + params_to_remove <- c(params_to_remove, .get_bias_params(prior_list, "bias")) + } } # handle remove_formulas @@ -193,6 +240,10 @@ NULL if (!is.null(keep_parameters)) { params_to_keep <- c(params_to_keep, keep_parameters) + # if "bias" is in keep_parameters, also add corresponding bias-related parameters + if ("bias" %in% keep_parameters) { + params_to_keep <- c(params_to_keep, .get_bias_params(prior_list, "bias")) + } } if (!is.null(keep_formulas)) { @@ -203,6 +254,11 @@ NULL # add parameters not in keep list to removal list params_not_kept <- all_params[!all_params %in% params_to_keep] params_to_remove <- c(params_to_remove, params_not_kept) + + # if "bias" is in params_not_kept, also add corresponding bias-related parameters + if ("bias" %in% params_not_kept) { + params_to_remove <- c(params_to_remove, .get_bias_params(prior_list, "bias")) + } } # remove duplicates diff --git a/man/posterior_extraction_helpers.Rd b/man/posterior_extraction_helpers.Rd index f85f3ab..92df5bf 100644 --- a/man/posterior_extraction_helpers.Rd +++ b/man/posterior_extraction_helpers.Rd @@ -65,7 +65,9 @@ \item{prior_list}{list of prior objects} -\item{remove_parameters}{character vector of parameter names to remove, or TRUE to remove all non-formula parameters} +\item{remove_parameters}{character vector of parameter names to remove, or TRUE to remove all non-formula parameters. +If "bias" is specified and the bias prior contains PET, PEESE, or weightfunction priors, +the corresponding parameters (PET, PEESE, omega) are also added to the removal list.} \item{prior}{prior object for the parameter} @@ -73,7 +75,9 @@ \item{remove_formulas}{character vector of formula names whose parameters should be removed} -\item{keep_parameters}{character vector of parameter names to keep (all others removed unless in keep_formulas)} +\item{keep_parameters}{character vector of parameter names to keep (all others removed unless in keep_formulas). +If "bias" is specified and the bias prior contains PET, PEESE, or weightfunction priors, +the corresponding parameters (PET, PEESE, omega) are also added to the keep list.} \item{keep_formulas}{character vector of formula names whose parameters should be kept (all others removed unless in keep_parameters)} diff --git a/tests/testthat/test-JAGS-posterior-extraction.R b/tests/testthat/test-JAGS-posterior-extraction.R index 57eff55..c725839 100644 --- a/tests/testthat/test-JAGS-posterior-extraction.R +++ b/tests/testthat/test-JAGS-posterior-extraction.R @@ -339,6 +339,142 @@ test_that(".filter_parameters combines keep_parameters and keep_formulas", { }) +test_that(".filter_parameters removes bias-related parameters when bias is removed", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a mixture prior with PET component (simulating bias) + bias_prior <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PET("normal", list(0, 1), prior_weights = 1) + )) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + bias = bias_prior + ) + + # When bias is removed, PET should also be removed + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = "bias", remove_spike_0 = FALSE) + expect_true("bias" %in% result) + expect_true("PET" %in% result) + expect_false("mu" %in% result) +}) + + +test_that(".filter_parameters removes bias-related parameters when bias contains PEESE", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a mixture prior with PEESE component + bias_prior <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PEESE("normal", list(0, 1), prior_weights = 1) + )) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + bias = bias_prior + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = "bias", remove_spike_0 = FALSE) + expect_true("bias" %in% result) + expect_true("PEESE" %in% result) + expect_false("mu" %in% result) +}) + + +test_that(".filter_parameters removes bias-related parameters when bias contains weightfunction", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a mixture prior with weightfunction component + bias_prior <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_weightfunction("one.sided", list(c(0.05), c(1, 1)), prior_weights = 1) + )) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + bias = bias_prior + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = "bias", remove_spike_0 = FALSE) + expect_true("bias" %in% result) + expect_true("omega" %in% result) + expect_false("mu" %in% result) +}) + + +test_that(".filter_parameters keeps bias-related parameters when bias is kept", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a mixture prior with PET component + bias_prior <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PET("normal", list(0, 1), prior_weights = 1) + )) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + tau = prior("normal", list(1, 1)), + bias = bias_prior + ) + + # When only bias is kept, mu and tau should be removed, but PET should be kept + result <- BayesTools:::.filter_parameters(prior_list, keep_parameters = "bias", remove_spike_0 = FALSE) + expect_false("bias" %in% result) + expect_false("PET" %in% result) + expect_true("mu" %in% result) + expect_true("tau" %in% result) +}) + + +test_that(".filter_parameters handles non-mixture bias priors", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a single PET prior named bias (not a mixture) + bias_prior <- prior_PET("normal", list(0, 1)) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + bias = bias_prior + ) + + result <- BayesTools:::.filter_parameters(prior_list, remove_parameters = "bias", remove_spike_0 = FALSE) + expect_true("bias" %in% result) + expect_true("PET" %in% result) + expect_false("mu" %in% result) +}) + + +test_that(".filter_parameters removes bias-related parameters when bias is not in keep list", { + skip_on_cran() + skip_if_not_installed("rjags") + + # Create a mixture prior with PET component + bias_prior <- prior_mixture(list( + prior_none(prior_weights = 1), + prior_PET("normal", list(0, 1), prior_weights = 1) + )) + + prior_list <- list( + mu = prior("normal", list(0, 1)), + tau = prior("normal", list(1, 1)), + bias = bias_prior + ) + + # When only mu is kept, bias should be removed along with PET + result <- BayesTools:::.filter_parameters(prior_list, keep_parameters = "mu", remove_spike_0 = FALSE) + expect_false("mu" %in% result) + expect_true("bias" %in% result) + expect_true("PET" %in% result) + expect_true("tau" %in% result) +}) + + test_that("helper functions work with runjags estimates extraction", { skip_on_cran() skip_if_not_installed("rjags") From 417acb52431ae91f3e8aa5693d901e10972f0b8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Fri, 2 Jan 2026 09:09:48 +0100 Subject: [PATCH 25/38] fix cmd check notes --- .github/workflows/R-CMD-check.yaml | 5 ++++- vignettes/ComparisonR.Rmd | 1 - vignettes/SpikeAndSlab.Rmd | 3 +-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 1c88835..9dd794c 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -24,6 +24,9 @@ jobs: with: r-version: ${{ matrix.config.r }} + - name: Setup Pandoc + uses: r-lib/actions/setup-pandoc@v2 + # Cache R packages - name: Cache R packages uses: actions/cache@v3 @@ -140,7 +143,7 @@ jobs: options(repos = c(CRAN = "https://cloud.r-project.org")) # Check if packages are already installed before installing - required_packages <- c('devtools', 'rcmdcheck', 'BayesFactor', 'RoBMA', 'runjags', 'rjags', 'rstan', 'scales', 'vdiffr', 'testthat', 'covr', 'pandoc') + required_packages <- c('devtools', 'rcmdcheck', 'BayesFactor', 'RoBMA', 'runjags', 'rjags', 'rstan', 'scales', 'vdiffr', 'testthat', 'covr') missing_packages <- required_packages[!sapply(required_packages, requireNamespace, quietly = TRUE)] if (length(missing_packages) > 0) { diff --git a/vignettes/ComparisonR.Rmd b/vignettes/ComparisonR.Rmd index 1bdae28..ff4cdfb 100644 --- a/vignettes/ComparisonR.Rmd +++ b/vignettes/ComparisonR.Rmd @@ -11,7 +11,6 @@ vignette: > %\VignetteIndexEntry{Comparison to other R packages} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown_notangle} --- diff --git a/vignettes/SpikeAndSlab.Rmd b/vignettes/SpikeAndSlab.Rmd index 33b3d24..d777215 100644 --- a/vignettes/SpikeAndSlab.Rmd +++ b/vignettes/SpikeAndSlab.Rmd @@ -4,14 +4,13 @@ author: "František Bartoš" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: - self_contained: yes + self_contained: yes bibliography: ../inst/REFERENCES.bib csl: ../inst/apa.csl vignette: > %\VignetteIndexEntry{Bayes factors via spike and slab prior vs. bridge sampling} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown_notangle} --- From 6007070ae7142eb6886370d58b44cdfd58497813 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sun, 4 Jan 2026 21:39:42 +0100 Subject: [PATCH 26/38] add test caching --- .github/instructions/tests.instructions.md | 4 +- tests/testthat/common-functions.R | 90 ++++++++++- tests/testthat/test-00-model-fits.R | 148 +----------------- tests/testthat/test-JAGS-ensemble-plots.R | 20 +-- tests/testthat/test-JAGS-ensemble-tables.R | 26 +-- tests/testthat/test-JAGS-formula-scale.R | 6 +- .../test-JAGS-marginal-distributions.R | 4 +- tests/testthat/test-JAGS-summary-tables.R | 4 +- tests/testthat/test-model-averaging-plots.R | 20 +-- tests/testthat/test-model-averaging.R | 24 +-- tests/testthat/test-summary-tables.R | 34 ++-- 11 files changed, 158 insertions(+), 222 deletions(-) diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 31adeea..1b43bfc 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -95,7 +95,7 @@ Use pattern: `fit_{category}_{descriptor}` (e.g., `fit_simple_normal`, `fit_form **Model Registry**: `test-00-model-fits.R` maintains a registry of all fitted models in `model_registry.RDS`. Other test files should load this registry to discover available models rather than hardcoding model names: ```r -registry_file <- file.path(temp_fits_dir, "model_registry.RDS") +registry_file <- file.path(test_files_dir, "model_registry.RDS") model_registry <- readRDS(registry_file) model_names <- model_registry$model_name ``` @@ -198,7 +198,7 @@ test_that("multivariate sampling works", { ### Important Notes 1. **`common-functions.R` does NOT call `skip_on_cran()`** - each test file manages its own skip conditions -2. **`skip_if_no_fits()`** checks for `model_registry.RDS` in `temp_fits_dir` - use this for any test that loads pre-fitted models +2. **`skip_if_no_fits()`** checks for `model_registry.RDS` in `test_files_dir` - use this for any test that loads pre-fitted models 3. **`skip_on_os()`** should ONLY be used for tests involving multivariate priors (meandif, orthonormal) where RNG differs across platforms 4. **Pure R tests** (e.g., `test-priors-print.R`, `test-tools-input.R`) should have NO file-level skips and can run on CRAN ``` diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index 650cac8..427cbe9 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -5,14 +5,22 @@ if (!exists("GENERATE_REFERENCE_FILES")) { GENERATE_REFERENCE_FILES <- FALSE } -# Get the directory where prefitted models are stored -temp_fits_dir <- Sys.getenv("BAYESTOOLS_TEST_FITS_DIR") -if (temp_fits_dir == "" || !dir.exists(temp_fits_dir)) { - temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") + +test_files_dir <- Sys.getenv("BAYESTOOLS_TEST_FILES_DIR") +if (test_files_dir == "" || !dir.exists(test_files_dir)) { + test_files_dir <- file.path(tempdir(), "BayesTools_test_files") } -# NOTE: File-level skip_on_cran() was removed intentionally. -# Each test file should manage its own skip conditions appropriately. +# Setup directory for saving fitted models +temp_fits_dir <- file.path(test_files_dir, "fits") +temp_marglik_dir <- file.path(test_files_dir, "margliks") + +if (!dir.exists(temp_fits_dir)) dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) +if (!dir.exists(temp_marglik_dir)) dir.create(temp_marglik_dir, showWarnings = FALSE, recursive = TRUE) + +# Set environment variable so other test files can locate pre-fitted models +Sys.setenv(BAYESTOOLS_TEST_FILES_DIR = test_files_dir) + # Use skip_if_no_fits() for tests that need pre-fitted models. # ============================================================================ # @@ -65,7 +73,7 @@ test_reference_text <- function(text, filename, info_msg = NULL, # Skip if pre-fitted models are not available skip_if_no_fits <- function() { - model_registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + model_registry_file <- file.path(test_files_dir, "model_registry.RDS") if (!file.exists(model_registry_file)) { skip("Pre-fitted models not found. Run test-00-model-fits.R first.") } @@ -293,3 +301,71 @@ test_meandif <- function(prior, skip_moments = FALSE) { } return(invisible()) } + +# Helper function to save fitted models and register metadata +save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_priors = FALSE, + factor_priors = FALSE, pub_bias_priors = FALSE, + weightfunction_priors = FALSE, spike_and_slab_priors = FALSE, + mixture_priors = FALSE, formulas = FALSE, + random_effects = FALSE, interactions = FALSE, + expression_priors = FALSE, multi_formula = FALSE, + autofit = FALSE, parallel = FALSE, thinning = FALSE, + add_parameters = FALSE, note = "") { + + saveRDS(fit, file = file.path(temp_fits_dir, paste0(name, ".RDS"))) + + # Save marglik if provided + if (!is.null(marglik)) { + saveRDS(marglik, file = file.path(temp_marglik_dir, paste0(name, ".RDS"))) + } + + # Return model metadata entry for registry + list( + fit = fit, + marglik = marglik, + registry_entry = data.frame( + model_name = name, + has_marglik = !is.null(marglik), + simple_priors = simple_priors, + vector_priors = vector_priors, + factor_priors = factor_priors, + pub_bias_priors = pub_bias_priors, + weightfunction_priors = weightfunction_priors, + spike_and_slab_priors = spike_and_slab_priors, + mixture_priors = mixture_priors, + formulas = formulas, + random_effects = random_effects, + interactions = interactions, + expression_priors = expression_priors, + multi_formula = multi_formula, + autofit = autofit, + parallel = parallel, + thinning = thinning, + add_parameters = add_parameters, + note = note, + stringsAsFactors = FALSE + ) + ) +} + +# Skip model fitting if cached fits exist and ROBMA_TEST_SKIP_REFIT is TRUE +skip_refit_if_cached <- function() { + skip_refit <- Sys.getenv("BAYESTOOLS_TEST_SKIP_REFIT") + if (skip_refit != "" && as.logical(skip_refit) && length(list.files(temp_fits_dir)) > 0) { + skip("Skipping model refitting: cached fits exist and BAYESTOOLS_TEST_SKIP_REFIT=TRUE.") + } +} + +# Clean cached fitted models and margliks +clean_cached_fits <- function() { + + # Remove all cached files from test directories + unlink(temp_fits_dir, recursive = TRUE) + unlink(temp_marglik_dir, recursive = TRUE) + + # Recreate empty directories + dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) + dir.create(temp_marglik_dir, showWarnings = FALSE, recursive = TRUE) + + return(invisible(TRUE)) +} diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 90c1ecd..1ef0b53 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -29,60 +29,13 @@ skip_on_cran() skip_if_not_installed("rjags") -# Setup directory for saving fitted models -temp_fits_dir <- file.path(tempdir(), "BayesTools_test_fits") -dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) -# Set environment variable so other test files can locate pre-fitted models -Sys.setenv(BAYESTOOLS_TEST_FITS_DIR = temp_fits_dir) +# Load common test helpers +source(testthat::test_path("common-functions.R")) +skip_refit_if_cached() # Initialize model registry to track metadata about each fitted model model_registry <- list() -# Helper function to save fitted models and register metadata -save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_priors = FALSE, - factor_priors = FALSE, pub_bias_priors = FALSE, - weightfunction_priors = FALSE, spike_and_slab_priors = FALSE, - mixture_priors = FALSE, formulas = FALSE, - random_effects = FALSE, interactions = FALSE, - expression_priors = FALSE, multi_formula = FALSE, - autofit = FALSE, parallel = FALSE, thinning = FALSE, - add_parameters = FALSE, note = "") { - saveRDS(fit, file = file.path(temp_fits_dir, paste0(name, ".RDS"))) - - # Save marglik if provided - if (!is.null(marglik)) { - saveRDS(marglik, file = file.path(temp_fits_dir, paste0(name, "_marglik.RDS"))) - } - - # Return model metadata entry for registry - list( - fit = fit, - marglik = marglik, - registry_entry = data.frame( - model_name = name, - has_marglik = !is.null(marglik), - simple_priors = simple_priors, - vector_priors = vector_priors, - factor_priors = factor_priors, - pub_bias_priors = pub_bias_priors, - weightfunction_priors = weightfunction_priors, - spike_and_slab_priors = spike_and_slab_priors, - mixture_priors = mixture_priors, - formulas = formulas, - random_effects = random_effects, - interactions = interactions, - expression_priors = expression_priors, - multi_formula = multi_formula, - autofit = autofit, - parallel = parallel, - thinning = thinning, - add_parameters = add_parameters, - note = note, - stringsAsFactors = FALSE - ) - ) -} - # ============================================================================ # # SECTION 1: SIMPLE PRIOR DISTRIBUTIONS # ============================================================================ # @@ -202,12 +155,6 @@ test_that("Simple prior models fit correctly", { note = "Simple normal prior with thinning parameter (thin=3)") model_registry[["fit_simple_thin"]] <<- result$registry_entry fit_simple_thin <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_normal.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_spike.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_various.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_pub_bias.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_thin.RDS"))) }) @@ -317,11 +264,6 @@ test_that("Summary tables models fit correctly", { note = "Model for summary tables with fixed weightfunction") model_registry[["fit_summary3"]] <<- result$registry_entry fit_summary3 <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_summary0.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_summary1.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_summary2.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_summary3.RDS"))) }) @@ -376,10 +318,6 @@ test_that("Vector prior models fit correctly", { note = "Multivariate t prior with df=5 (K=2)") model_registry[["fit_vector_mt"]] <<- result$registry_entry fit_vector_mt <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mnormal.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mcauchy.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_vector_mt.RDS"))) }) @@ -454,11 +392,6 @@ test_that("Factor prior models fit correctly", { note = "Meandif contrast with 3 levels") model_registry[["fit_factor_meandif"]] <<- result$registry_entry fit_factor_meandif <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_orthonormal.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_treatment.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_independent.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_factor_meandif.RDS"))) }) @@ -528,11 +461,6 @@ test_that("Weightfunction prior models fit correctly", { note = "One-sided fixed weightfunction (weights: 1, .5)") model_registry[["fit_weightfunction_fixed"]] <<- result$registry_entry fit_weightfunction_fixed <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided2.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_onesided3.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_twosided.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_weightfunction_fixed.RDS"))) }) @@ -581,9 +509,6 @@ test_that("Spike-and-slab prior models fit correctly", { note = "Spike-and-slab with orthonormal factor prior (3 levels) as alternative") model_registry[["fit_spike_slab_factor"]] <<- result$registry_entry fit_spike_slab_factor <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_slab_simple.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_slab_factor.RDS"))) }) @@ -656,10 +581,6 @@ test_that("Mixture prior models fit correctly", { note = "Mixture containing spike prior at value 2") model_registry[["fit_mixture_spike"]] <<- result$registry_entry fit_mixture_spike <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_simple.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_components.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_mixture_spike.RDS"))) }) @@ -785,10 +706,6 @@ test_that("Simple formula-based regression models fit correctly", { note = "Regression with continuous predictor and 3-level orthonormal factor") model_registry[["fit_formula_orthonormal"]] <<- result$registry_entry fit_formula_orthonormal <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_simple.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_treatment.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS"))) }) @@ -1052,11 +969,6 @@ test_that("Formula-based interaction models fit correctly", { note = "Regression with mixture prior on 3-level treatment factor (spike vs normal)") model_registry[["fit_formula_factor_mixture"]] <<- result$registry_entry fit_formula_factor_mixture <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_cont.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_interaction_fac.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_factor_mixture.RDS"))) }) @@ -1120,8 +1032,6 @@ test_that("Multi-formula models fit correctly", { note = "Two formulas: mu (continuous) and sigma_exp (meandif factor)") model_registry[["fit_formula_multi"]] <<- result$registry_entry fit_formula_multi <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_formula_multi.RDS"))) }) @@ -1265,14 +1175,6 @@ test_that("Random effects models fit correctly", { note = "Random factor slopes with random intercept") model_registry[["fit_random_factor_slope3"]] <<- result$registry_entry fit_random_factor_slope3 <- result$fit - - - - expect_true(file.exists(file.path(temp_fits_dir, "fit_random_intercept.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_random_slope.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope2.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_random_factor_slope3.RDS"))) }) @@ -1325,12 +1227,6 @@ test_that("Spike factor prior models fit correctly", { note = "Spike priors with all 4 contrast types: independent, orthonormal, treatment, meandif") model_registry[["fit_spike_factors"]] <<- result$registry_entry fit_spike_factors <- result$fit - - # NOTE: fit_spike_factors_null and fit_spike_factors_alt have been removed - # because they are now replaced by fit_marginal_0 and fit_marginal_1 - # (which have the same meandif factor structure plus additional features) - - expect_true(file.exists(file.path(temp_fits_dir, "fit_spike_factors.RDS"))) }) @@ -1410,8 +1306,6 @@ test_that("Joint complex models fit correctly", { note = "Complex model: mixture intercept, mixture sigma, spike-and-slab continuous, spike-and-slab factor") model_registry[["fit_joint_complex"]] <<- result$registry_entry fit_joint_complex <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_joint_complex.RDS"))) }) @@ -1474,10 +1368,6 @@ test_that("Expression prior models fit correctly", { note = "Mixture prior with expression in one component") model_registry[["fit_expression_mixture"]] <<- result$registry_entry fit_expression_mixture <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_simple.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_spike_slab.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_expression_mixture.RDS"))) }) @@ -1621,12 +1511,6 @@ test_that("Advanced JAGS_fit features work correctly", { # Verify the fit worked and has the expected structure expect_equal(length(fit_parallel$mcmc), 2) # 2 chains expect_true(all(sapply(fit_parallel$mcmc, function(mcmc) ncol(mcmc) == 2))) # m and s - - expect_true(file.exists(file.path(temp_fits_dir, "fit_add_parameters.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_no_autofit.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_autofit_error.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_autofit_ess.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_parallel.RDS"))) }) @@ -1765,12 +1649,6 @@ test_that("Marginal distribution models fit correctly", { note = "Marginal dist model: spike-and-slab and mixture priors with interaction and multiply_by") model_registry[["fit_marginal_ss"]] <<- result$registry_entry fit_marginal_ss <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_0.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_1.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_ss.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS"))) }) @@ -1814,10 +1692,6 @@ test_that("PET-PEESE models fit correctly", { marglik_missing <- JAGS_bridgesampling(fit_missing, log_posterior = log_posterior, data = data, prior_list = priors_missing) result <- save_fit(fit_missing, "fit_missing", marglik = marglik_missing, simple_priors = TRUE, note = "Overwhelming missing model") model_registry[["fit_missing"]] <<- result$registry_entry - - expect_true(file.exists(file.path(temp_fits_dir, "fit_pet.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_peese.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_missing.RDS"))) }) test_that("Weightfunction models fit correctly", { @@ -1855,10 +1729,6 @@ test_that("Weightfunction models fit correctly", { marglik_wf_missing <- JAGS_bridgesampling(fit_wf_missing, log_posterior = log_posterior, data = data, prior_list = priors_wf_missing) result <- save_fit(fit_wf_missing, "fit_wf_missing", marglik = marglik_wf_missing, simple_priors = TRUE, note = "Overwhelming missing model for WF") model_registry[["fit_wf_missing"]] <<- result$registry_entry - - expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_onesided.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_twosided.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_wf_missing.RDS"))) }) test_that("Orthonormal contrast models fit correctly", { @@ -1922,9 +1792,6 @@ test_that("Orthonormal contrast models fit correctly", { formula_list = formula_list1, formula_data_list = formula_data_list, formula_prior_list = formula_prior_list1) result <- save_fit(fit_orthonormal_1, "fit_orthonormal_1", marglik = marglik_orthonormal_1, formulas = TRUE, factor_priors = TRUE, note = "Orthonormal alternative model") model_registry[["fit_orthonormal_1"]] <<- result$registry_entry - - expect_true(file.exists(file.path(temp_fits_dir, "fit_orthonormal_0.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_orthonormal_1.RDS"))) }) @@ -2059,8 +1926,6 @@ test_that("Complex models for plotting fit correctly", { note = "Simple formula model with continuous, orthonormal factor, and meandif factor") model_registry[["fit_simple_formula_mixed"]] <<- result$registry_entry fit_simple_formula_mixed <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_simple_formula_mixed.RDS"))) }) # ============================================================================ # @@ -2097,8 +1962,6 @@ test_that("Complex models for plotting fit correctly", { note = "Model with complex publication bias mixture prior") model_registry[["fit_complex_bias"]] <<- result$registry_entry fit_complex_bias <- result$fit - - expect_true(file.exists(file.path(temp_fits_dir, "fit_complex_bias.RDS"))) }) @@ -2207,9 +2070,6 @@ test_that("Dual parameter regression with log(intercept) and formula_scale fits expect_true("mu_x_mu" %in% colnames(fit_dual_param_regression$mcmc[[1]])) expect_true("log_sigma_intercept" %in% colnames(fit_dual_param_regression$mcmc[[1]])) expect_true("log_sigma_x_sigma" %in% colnames(fit_dual_param_regression$mcmc[[1]])) - - expect_true(file.exists(file.path(temp_fits_dir, "fit_dual_param_regression.RDS"))) - expect_true(file.exists(file.path(temp_fits_dir, "fit_dual_param_regression_marglik.RDS"))) }) @@ -2226,7 +2086,7 @@ test_that("Model registry is created and saved", { rownames(model_registry_df) <- NULL # Save the registry alongside the fitted models - registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + registry_file <- file.path(test_files_dir, "model_registry.RDS") saveRDS(model_registry_df, registry_file) # Verify registry was created diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index c334984..26aacc2 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -576,10 +576,10 @@ test_that("posterior plot functions (simple) work", { skip_if_not_installed("bridgesampling") fit0 <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) fit1 <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) # automatically mix posteriors models <- list( @@ -639,9 +639,9 @@ test_that("posterior plot functions (PET-PEESE) work", { skip_if_not_installed("bridgesampling") fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_pet_marglik.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_pet.RDS")) fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_peese_marglik.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_peese.RDS")) # automatically mix posteriors models <- list( @@ -690,7 +690,7 @@ test_that("posterior plot functions (PET-PEESE) work", { # add an overhelming missing model fit2 <- readRDS(file.path(temp_fits_dir, "fit_missing.RDS")) - marglik2 <- readRDS(file.path(temp_fits_dir, "fit_missing_marglik.RDS")) + marglik2 <- readRDS(file.path(temp_marglik_dir, "fit_missing.RDS")) models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), @@ -710,9 +710,9 @@ test_that("posterior plot functions (weightfunctions) work", { skip_if_not_installed("bridgesampling") fit0 <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided_marglik.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_wf_onesided.RDS")) fit1 <- readRDS(file.path(temp_fits_dir, "fit_wf_twosided.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_wf_twosided_marglik.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_wf_twosided.RDS")) # automatically mix posteriors models <- list( @@ -766,7 +766,7 @@ test_that("posterior plot functions (weightfunctions) work", { # add an overhelming missing model fit2 <- readRDS(file.path(temp_fits_dir, "fit_wf_missing.RDS")) - marglik2 <- readRDS(file.path(temp_fits_dir, "fit_wf_missing_marglik.RDS")) + marglik2 <- readRDS(file.path(temp_marglik_dir, "fit_wf_missing.RDS")) models <- list( list(fit = fit0, marglik = marglik0, prior_weights = 1), @@ -787,9 +787,9 @@ test_that("posterior plot functions (orthonormal) work", { skip_if_not_installed("bridgesampling") fit0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_0.RDS")) fit1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_1.RDS")) # mix posteriors models <- list( diff --git a/tests/testthat/test-JAGS-ensemble-tables.R b/tests/testthat/test-JAGS-ensemble-tables.R index 84152ec..b0edf05 100644 --- a/tests/testthat/test-JAGS-ensemble-tables.R +++ b/tests/testthat/test-JAGS-ensemble-tables.R @@ -58,13 +58,13 @@ test_that("Summary table advanced features work correctly", { # 1. Simple models (m, omega) # -------------------------------------------------------------- # fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) - marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + marglik_summary2 <- readRDS(file.path(temp_marglik_dir, "fit_summary2.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), @@ -144,13 +144,13 @@ test_that("Summary table advanced features work correctly", { # 2. Complex models (Formula) # -------------------------------------------------------------- # fit_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple.RDS")) - marglik_formula_simple <- readRDS(file.path(temp_fits_dir, "fit_formula_simple_marglik.RDS")) + marglik_formula_simple <- readRDS(file.path(temp_marglik_dir, "fit_formula_simple.RDS")) fit_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment.RDS")) - marglik_formula_treatment <- readRDS(file.path(temp_fits_dir, "fit_formula_treatment_marglik.RDS")) + marglik_formula_treatment <- readRDS(file.path(temp_marglik_dir, "fit_formula_treatment.RDS")) fit_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal.RDS")) - marglik_formula_orthonormal <- readRDS(file.path(temp_fits_dir, "fit_formula_orthonormal_marglik.RDS")) + marglik_formula_orthonormal <- readRDS(file.path(temp_marglik_dir, "fit_formula_orthonormal.RDS")) models_complex <- list( list(fit = fit_formula_simple, marglik = marglik_formula_simple, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_simple)), @@ -194,10 +194,10 @@ test_that("Summary table advanced features work correctly", { # 3. Simple Spike vs Normal (Model Averaging) # -------------------------------------------------------------- # fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) models_simple_ma <- list( list(fit = fit_simple_spike, marglik = marglik_simple_spike, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_spike)), @@ -230,7 +230,7 @@ test_that("Summary table advanced features work correctly", { # -------------------------------------------------------------- # # Re-using summary models 0-2 and adding a fixed weightfunction model fit_summary3 <- readRDS(file.path(temp_fits_dir, "fit_summary3.RDS")) - marglik_summary3 <- readRDS(file.path(temp_fits_dir, "fit_summary3_marglik.RDS")) + marglik_summary3 <- readRDS(file.path(temp_marglik_dir, "fit_summary3.RDS")) models_fixed_wf <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), @@ -263,10 +263,10 @@ test_that("Summary table advanced features work correctly", { # 5. Interactions # -------------------------------------------------------------- # fit_formula_interaction_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS")) - marglik_formula_interaction_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_marglik.RDS")) + marglik_formula_interaction_mix <- readRDS(file.path(temp_marglik_dir, "fit_formula_interaction_mix.RDS")) fit_formula_interaction_mix_main <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_main.RDS")) - marglik_formula_interaction_mix_main <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_main_marglik.RDS")) + marglik_formula_interaction_mix_main <- readRDS(file.path(temp_marglik_dir, "fit_formula_interaction_mix_main.RDS")) models_interaction <- list( list(fit = fit_formula_interaction_mix_main, marglik = marglik_formula_interaction_mix_main, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_interaction_mix_main)), @@ -307,10 +307,10 @@ test_that("Summary table advanced features work correctly", { # -------------------------------------------------------------- # # Using fit_marginal_0 (spike) and fit_marginal_1 (normal) which have meandif factors fit_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_marginal_0.RDS")) - marglik_spike_factors_null <- readRDS(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS")) + marglik_spike_factors_null <- readRDS(file.path(temp_marglik_dir, "fit_marginal_0.RDS")) fit_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) - marglik_spike_factors_alt <- readRDS(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS")) + marglik_spike_factors_alt <- readRDS(file.path(temp_marglik_dir, "fit_marginal_1.RDS")) models_spike_factors <- list( list(fit = fit_spike_factors_null, marglik = marglik_spike_factors_null, prior_weights = 1, fit_summary = runjags_estimates_table(fit_spike_factors_null)), diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index 8a48e73..c9bcb34 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -339,8 +339,8 @@ test_that("Marginal likelihoods match for manual and automatic scaling", { skip_if_no_fits() # Load pre-fitted marginal likelihoods - marglik_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled_marglik.RDS")) - marglik_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled_marglik.RDS")) + marglik_manual <- readRDS(file.path(temp_marglik_dir, "fit_formula_manual_scaled.RDS")) + marglik_auto <- readRDS(file.path(temp_marglik_dir, "fit_formula_auto_scaled.RDS")) # The log marginal likelihoods should be very similar # (both models use same scaled data internally) @@ -497,7 +497,7 @@ test_that("ensemble_estimates_table with transform_scaled unscales coefficients" # Load pre-fitted models fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) - marglik_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled_marglik.RDS")) + marglik_auto <- readRDS(file.path(temp_marglik_dir, "fit_formula_auto_scaled.RDS")) formula_scale <- attr(fit_auto, "formula_scale") diff --git a/tests/testthat/test-JAGS-marginal-distributions.R b/tests/testthat/test-JAGS-marginal-distributions.R index f606fe7..c958388 100644 --- a/tests/testthat/test-JAGS-marginal-distributions.R +++ b/tests/testthat/test-JAGS-marginal-distributions.R @@ -39,8 +39,8 @@ test_that("Marginal distribution prior and posterior functions work", { # Load pre-fitted marginal distribution models fit0 <- readRDS(file.path(temp_fits_dir, "fit_marginal_0.RDS")) fit1 <- readRDS(file.path(temp_fits_dir, "fit_marginal_1.RDS")) - marglik0 <- readRDS(file.path(temp_fits_dir, "fit_marginal_0_marglik.RDS")) - marglik1 <- readRDS(file.path(temp_fits_dir, "fit_marginal_1_marglik.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_marginal_0.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_marginal_1.RDS")) # Define prior lists (needed for manual mixing validation and prior_samples) prior_list_0 <- list( diff --git a/tests/testthat/test-JAGS-summary-tables.R b/tests/testthat/test-JAGS-summary-tables.R index bac6fdf..1b999af 100644 --- a/tests/testthat/test-JAGS-summary-tables.R +++ b/tests/testthat/test-JAGS-summary-tables.R @@ -193,7 +193,7 @@ test_that("Summary tables for all saved models", { runjags::runjags.options(silent.jags = TRUE, silent.runjags = TRUE) # Load model registry to get list of all fitted models - registry_file <- file.path(temp_fits_dir, "model_registry.RDS") + registry_file <- file.path(test_files_dir, "model_registry.RDS") model_registry <- readRDS(registry_file) model_names <- model_registry$model_name @@ -202,7 +202,7 @@ test_that("Summary tables for all saved models", { for (model_name in model_names) { fit_file <- file.path(temp_fits_dir, paste0(model_name, ".RDS")) - marglik_file <- file.path(temp_fits_dir, paste0(model_name, "_marglik.RDS")) + marglik_file <- file.path(temp_marglik_dir, paste0(model_name, ".RDS")) fit <- readRDS(fit_file) has_marglik <- file.exists(marglik_file) diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-model-averaging-plots.R index bc827a5..be0f78d 100644 --- a/tests/testthat/test-model-averaging-plots.R +++ b/tests/testthat/test-model-averaging-plots.R @@ -235,10 +235,10 @@ test_that("plot_posterior handles various sample types", { # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), @@ -284,10 +284,10 @@ test_that("plot_posterior handles weightfunction posteriors", { # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), @@ -321,10 +321,10 @@ test_that("plot_models handles various configurations", { # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), @@ -367,10 +367,10 @@ test_that("plot_models handles order argument", { # Load fits fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), @@ -438,10 +438,10 @@ test_that("plot_models handles orthonormal priors", { # Load orthonormal models with marginal likelihoods fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_0.RDS")) fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_1.RDS")) models <- list( list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1, diff --git a/tests/testthat/test-model-averaging.R b/tests/testthat/test-model-averaging.R index 8cc1436..300cb9c 100644 --- a/tests/testthat/test-model-averaging.R +++ b/tests/testthat/test-model-averaging.R @@ -215,10 +215,10 @@ test_that("mix_posteriors handles various prior types correctly", { # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) # Create model list for simple priors models_simple <- list( @@ -269,13 +269,13 @@ test_that("mix_posteriors handles weightfunction priors", { # Load summary models which have weightfunction priors fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) fit_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2.RDS")) - marglik_summary2 <- readRDS(file.path(temp_fits_dir, "fit_summary2_marglik.RDS")) + marglik_summary2 <- readRDS(file.path(temp_marglik_dir, "fit_summary2.RDS")) models_wf <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), @@ -303,10 +303,10 @@ test_that("mix_posteriors handles factor priors", { # Load the orthonormal factor models (have both factor priors and marginal likelihoods) fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_0.RDS")) fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_1.RDS")) # Create model list with two different models models_factor <- list( @@ -379,10 +379,10 @@ test_that("ensemble_inference handles different configurations", { # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) models <- list( list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), @@ -434,10 +434,10 @@ test_that("models_inference computes correctly", { # Load fits with margliks fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) models <- list( list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1), @@ -491,4 +491,4 @@ test_that("as_mixed_posteriors works correctly with BayesTools_fit objects", { mixed <- as_mixed_posteriors(fit_simple_normal, parameters = c("m", "s")) expect_true(inherits(mixed, "mixed_posteriors")) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-summary-tables.R b/tests/testthat/test-summary-tables.R index 9525865..7f0ab1d 100644 --- a/tests/testthat/test-summary-tables.R +++ b/tests/testthat/test-summary-tables.R @@ -36,10 +36,10 @@ test_that("ensemble_estimates_table handles matrix posteriors", { # Load fits with margliks for creating mixed posteriors fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), @@ -82,10 +82,10 @@ test_that("ensemble_estimates_table handles transform_factors", { # Load orthonormal models with marginal likelihoods fit_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_orthonormal_0 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + marglik_orthonormal_0 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_0.RDS")) fit_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_orthonormal_1 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + marglik_orthonormal_1 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_1.RDS")) models <- list( list(fit = fit_orthonormal_0, marglik = marglik_orthonormal_0, prior_weights = 1), @@ -124,10 +124,10 @@ test_that("ensemble_estimates_table handles formula posteriors", { # Use orthonormal models (have formulas and marginal likelihoods) fit_formula <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0.RDS")) - marglik_formula <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_0_marglik.RDS")) + marglik_formula <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_0.RDS")) fit_formula2 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1.RDS")) - marglik_formula2 <- readRDS(file.path(temp_fits_dir, "fit_orthonormal_1_marglik.RDS")) + marglik_formula2 <- readRDS(file.path(temp_marglik_dir, "fit_orthonormal_1.RDS")) models <- list( list(fit = fit_formula, marglik = marglik_formula, prior_weights = 1), @@ -180,10 +180,10 @@ test_that("ensemble_inference_table handles multiple parameters", { skip_if_no_fits() fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1), @@ -226,10 +226,10 @@ test_that("ensemble_summary_table handles different model configurations", { # Use models with and without spike-at-zero to test remove_spike_0 fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) models <- list( list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), @@ -263,10 +263,10 @@ test_that("ensemble_summary_table handles parameters as list", { skip_if_no_fits() fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) models <- list( list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), @@ -290,10 +290,10 @@ test_that("ensemble_diagnostics_table handles different configurations", { # Use models with and without spike-at-zero to test remove_spike_0 fit_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal.RDS")) - marglik_simple_normal <- readRDS(file.path(temp_fits_dir, "fit_simple_normal_marglik.RDS")) + marglik_simple_normal <- readRDS(file.path(temp_marglik_dir, "fit_simple_normal.RDS")) fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) models <- list( list(fit = fit_simple_normal, marglik = marglik_simple_normal, prior_weights = 1, fit_summary = runjags_estimates_table(fit_simple_normal)), @@ -384,7 +384,7 @@ test_that("model_summary_table handles various configurations", { # Use model with spike-at-zero to test remove_spike_0 fit_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike.RDS")) - marglik_simple_spike <- readRDS(file.path(temp_fits_dir, "fit_simple_spike_marglik.RDS")) + marglik_simple_spike <- readRDS(file.path(temp_marglik_dir, "fit_simple_spike.RDS")) model <- list( fit = fit_simple_spike, @@ -420,10 +420,10 @@ test_that("update.BayesTools_table works correctly", { skip_if_no_fits() fit_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0.RDS")) - marglik_summary0 <- readRDS(file.path(temp_fits_dir, "fit_summary0_marglik.RDS")) + marglik_summary0 <- readRDS(file.path(temp_marglik_dir, "fit_summary0.RDS")) fit_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1.RDS")) - marglik_summary1 <- readRDS(file.path(temp_fits_dir, "fit_summary1_marglik.RDS")) + marglik_summary1 <- readRDS(file.path(temp_marglik_dir, "fit_summary1.RDS")) models <- list( list(fit = fit_summary0, marglik = marglik_summary0, prior_weights = 1, fit_summary = runjags_estimates_table(fit_summary0)), From 506f2197d81152d7ecd22190d2c7c2ae62091995 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 5 Jan 2026 08:26:50 +0100 Subject: [PATCH 27/38] as_mixed PET and PEESE individual plots --- R/model-averaging-plots.R | 3 ++- tests/testthat/common-functions.R | 1 + tests/testthat/test-JAGS-ensemble-plots.R | 22 +++++++++++++++++++--- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 0c91ab7..6cfb20c 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -926,7 +926,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE rescale_x = FALSE, par_name = NULL, dots_prior = list(), ...){ # TODO: add plots for individual parameters for weightfunction and PET-PEESE - individual = FALSE + # but these seem to be already possible to a degree? + individual = FALSE show_figures = if(individual) 1 else NULL # check input diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index 427cbe9..2796c13 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -26,6 +26,7 @@ Sys.setenv(BAYESTOOLS_TEST_FILES_DIR = test_files_dir) # ============================================================================ # # HELPER FUNCTIONS: Reference File Testing # ============================================================================ # +require("runjags") # Process reference file: save if GENERATE_REFERENCE_FILES=TRUE, test otherwise test_reference_table <- function(table, filename, info_msg = NULL, diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index 26aacc2..137a2ec 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1336,8 +1336,24 @@ test_that("posterior plot model averaging based on complex bias mixture model (P }) - - - +# test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { +# +# skip_if_not_installed("rjags") +# skip_if_not_installed("bridgesampling") +# +# fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) +# fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) +# +# mixed_posteriors0 <- as_mixed_posteriors( +# mode = fit0, +# parameters = names(attr(fit0, "prior_list")) +# ) +# +# +# vdiffr::expect_doppelganger("model-as_mixed_posteriors-PET", function(){ +# plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) +# }) +# }) +# From c0b2329b87564fab515a70f443602609da3f8852 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 5 Jan 2026 10:18:22 +0100 Subject: [PATCH 28/38] init changes for individual PET/weightfunction plots --- .github/instructions/tests.instructions.md | 299 +++++---------------- R/model-averaging-plots.R | 38 ++- man/geom_prior_list.Rd | 5 + man/lines_prior_list.Rd | 5 + man/plot_posterior.Rd | 9 + man/plot_prior_list.Rd | 5 + tests/testthat/common-functions.R | 38 ++- tests/testthat/test-00-model-fits.R | 2 +- tests/testthat/test-JAGS-ensemble-plots.R | 42 +-- tests/testthat/test-JAGS-marglik.R | 1 + 10 files changed, 158 insertions(+), 286 deletions(-) diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 1b43bfc..4c64777 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -1,274 +1,105 @@ +````instructions --- applyTo: "**/tests/testthat/*.R" --- -# BayesTools Test Organization Guidelines +# BayesTools Test Guidelines ## Overview -Tests in BayesTools follow a structured organization where model fitting is centralized in `test-00-model-fits.R` and consumed by other test files. This approach ensures consistency, avoids duplication, and speeds up test execution. +- Model fitting is centralized in `test-00-model-fits.R`; other tests load cached models +- **testthat Edition 3** - do not use `context()` calls +- Tests use `common-functions.R` for shared helpers -**testthat Edition**: This package uses testthat Edition 3. Do not use `context()` calls. +## Test Caching (TDD Workflow) -## Test File Structure +Model fitting is slow. The caching system lets you run the full suite once and reuse fits. -### Naming Conventions +### Environment Variables -| Pattern | Purpose | Example | -|---------|---------|---------| -| `test-{feature}.R` | Main evaluation tests | `test-priors.R` | -| `test-{feature}-input.R` | Input validation tests | `test-tools-input.R` | -| `test-{feature}-evaluation.R` | Behavior/evaluation tests | `test-tools-evaluation.R` | -| `test-{feature}-coverage.R` | Edge case coverage tests | `test-priors-coverage.R` | -| `test-{feature}-edge-cases.R` | Edge case tests | `test-model-averaging-edge-cases.R` | +| Variable | Purpose | Default | +|----------|---------|---------| +| `BAYESTOOLS_TEST_FILES_DIR` | Cache directory location | `../temp/BayesTools_test_files` | +| `BAYESTOOLS_TEST_SKIP_REFIT` | Skip fitting if cache exists | TRUE | -### File Header Template - -Every test file should include a standardized header for AI discoverability: - -```r -# ============================================================================ # -# TEST FILE: {Description} -# ============================================================================ # -# -# PURPOSE: -# {Brief description of what this file tests} -# -# DEPENDENCIES: -# - {package}: {Why needed} -# - common-functions.R: {What helpers used} -# -# SKIP CONDITIONS: -# - {skip condition and why} -# -# MODELS/FIXTURES: -# - {What pre-fitted models or fixtures are used} -# -# TAGS: @{category}, @{speed}, @{feature} -# ============================================================================ # -``` - -### Common Tags - -- `@input-validation`: Tests for input checking (fast) -- `@evaluation`: Tests for correct behavior/output -- `@visual`: Visual regression tests (vdiffr) -- `@coverage`: Gap-filling coverage tests -- `@edge-cases`: Edge case and error path tests -- `@fast`: Quick tests (< 1s) -- `@slow`: Long-running tests (JAGS fitting) -- `@priors`, `@JAGS`, `@model-averaging`: Feature tags - -## Key Principles - -### 1. Single Source of Truth for Model Fitting - -**All model fitting and marginal likelihood computation must be done in `test-00-model-fits.R`.** - -- `test-00-model-fits.R` is the **only** file that should: - - Fit JAGS models using `JAGS_fit()` - - Compute marginal likelihoods using `JAGS_bridgesampling()` - - Save fitted models as RDS files - - Save marginal likelihoods as separate RDS files - -- Other test files should: - - **Only load** pre-fitted models using `readRDS()` - - **Only load** pre-computed marginal likelihoods using `readRDS()` - - Test the functionality they are designed for (e.g., model averaging, plotting, etc.) - -### 2. STRICTLY Avoid Duplication - -**Before adding a new model to `test-00-model-fits.R`, you MUST exhaustively check if an existing model can be used.** - -- **Do not create a new model just to test a specific function** (e.g., a plot or summary). Use an existing model that has the necessary components (e.g., if you need a model with a factor prior, use `fit_factor_independent` or `fit_formula_interaction_fac`). -- **Models are duplicates** if they have the same model structure, prior types, and data structure. -- **Reuse Strategy**: - 1. Read `test-00-model-fits.R` to see available models. - 2. Identify a model that has the features you need (e.g., "I need a model with a spike-and-slab prior"). - 3. Use that model in your test. - 4. **Only** if no such model exists, add a new one to `test-00-model-fits.R`. - -### 3. Model Naming Convention - -Use pattern: `fit_{category}_{descriptor}` (e.g., `fit_simple_normal`, `fit_formula_treatment`) - -**Model Registry**: `test-00-model-fits.R` maintains a registry of all fitted models in `model_registry.RDS`. Other test files should load this registry to discover available models rather than hardcoding model names: - -```r -registry_file <- file.path(test_files_dir, "model_registry.RDS") -model_registry <- readRDS(registry_file) -model_names <- model_registry$model_name -``` - -### 4. Saving and Loading Models - -```r -# In test-00-model-fits.R: Save with save_fit() helper -result <- save_fit(fit_model_name, "fit_model_name", - marglik = marglik_model_name, # If available - simple_priors = TRUE, note = "Description") - -# In other test files: Load with readRDS() -fit_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name.RDS")) -marglik_model_name <- readRDS(file.path(temp_fits_dir, "fit_model_name_marglik.RDS")) -``` - -**Note**: Marginal likelihoods are only computed for models with actual data (not spike-and-slab or mixture priors). - -### 5. Helper Functions in common-functions.R - -The shared helper file provides: +### Recommended TDD Workflow ```r -# Reference file testing -test_reference_table(table, filename, ...) -test_reference_text(text, filename, ...) +# 1. Run full suite once to verify current code and populate cache (if missing) +devtools::test() -# Prior distribution testing -test_prior(prior, skip_moments = FALSE) -test_weightfunction(prior, skip_moments = FALSE) -test_orthonormal(prior, skip_moments = FALSE) -test_meandif(prior, skip_moments = FALSE) +# 2. Iterate on your feature (uses cached fits) +devtools::test(filter = "your-feature") -# Skip helpers -skip_if_no_fits() +# 3. Final verification (disable cache if fit / marglik code or its dependencies changed) +clean_cached_fits() +devtools::test() ``` -Load at the top of test files: -```r -source(testthat::test_path("common-functions.R")) -``` +### When to Clear Cache -### 6. Test File Organization +Clear with `clean_cached_fits()` when you modify: +- `JAGS_fit()` or `JAGS_bridgesampling()` logic (or any of its dependencies) +- Model definitions in `test-00-model-fits.R` -#### test-00-model-fits.R -- **Purpose**: Fit all models and compute marginal likelihoods -- **Run order**: First (prefix `00-`) -- **Outputs**: RDS files in `tempdir()` via `BAYESTOOLS_TEST_FITS_DIR` env var -- **Registry**: Maintains `model_registry` with model metadata +## Key Rules -#### Tests Using JAGS Models -All tests that use JAGS models (e.g., `test-model-averaging.R`, `test-JAGS-*.R`, `test-summary-tables.R`) must: -- Load pre-fitted models from `temp_fits_dir` using `readRDS()` -- **Never** fit models directly (only `test-00-model-fits.R` fits models) -- Check model availability with `if (!dir.exists(temp_fits_dir))` and skip appropriately -- Use `skip_if_not_installed("rjags")` and `skip_if_not_installed("bridgesampling")` +### Model Fitting -**For tests with reference files** (e.g., `test-summary-tables.R`, visual regression tests): -- **Configuration**: `GENERATE_REFERENCE_FILES` flag (FALSE = test, TRUE = generate) - - **IMPORTANT**: **Never** modify this flag. Only the package maintainer changes this flag when intentionally updating reference files after format changes. - - Default value is `FALSE` (testing mode) - - Changing to `TRUE` regenerates all reference files (tables, figures, etc.) and should only be done by the maintainer -- **Outputs**: Reference files (`.txt`, `.svg`, `.png`, etc.) stored in `tests/results/` subdirectories +- **Only `test-00-model-fits.R`** fits models and computes marginal likelihoods +- Other tests load with `readRDS(file.path(temp_fits_dir, "model_name.RDS"))` +- Check `model_registry.RDS` for available models before creating new ones -## Skip Condition Standards +### File Naming -### Skip Condition Hierarchy +| Pattern | Purpose | +|---------|---------| +| `test-{feature}.R` | Main tests | +| `test-{feature}-input.R` | Input validation | +| `test-{feature}-coverage.R` | Edge cases | -Use the appropriate skip condition based on what your test needs: +### Skip Conditions -| Skip Condition | When to Use | Example Use Case | -|----------------|-------------|------------------| -| `skip_if_no_fits()` | Test loads pre-fitted models from `temp_fits_dir` | Model averaging tests, diagnostic plots | -| `skip_if_not_installed("rjags")` | Test requires JAGS execution (fitting or syntax) | JAGS syntax tests, marglik tests | -| `skip_if_not_installed("bridgesampling")` | Test computes marginal likelihoods | Ensemble inference tests | -| `skip_if_not_installed("vdiffr")` | Test uses visual regression | Prior plot tests | -| `skip_on_os(c("mac", "linux", "solaris"))` | Test involves multivariate sampling (meandif/orthonormal) | Multivariate prior tests | +| Condition | When to Use | +|-----------|-------------| +| `skip_if_no_fits()` | Test loads pre-fitted models | +| `skip_if_not_installed("rjags")` | Test requires JAGS | +| `skip_if_not_installed("bridgesampling")` | Test computes marginal likelihoods | +| `skip_if_not_installed("vdiffr")` | Visual regression tests | -### File-Level vs Per-Test Skips +### Helper Functions (common-functions.R) -**File-level skips** (after `source(common-functions.R)`): ```r source(testthat::test_path("common-functions.R")) -# File-level skips - ALL tests in this file need these -skip_if_no_fits() -skip_if_not_installed("rjags") -skip_if_not_installed("vdiffr") -``` - -**Per-test skips** (only when specific tests have additional requirements): -```r -test_that("multivariate sampling works", { - skip_on_os(c("mac", "linux", "solaris")) # Only this test needs OS skip - # ... -}) -``` +# Prior testing +test_prior(prior) +test_weightfunction(prior) +test_orthonormal(prior) -### Important Notes +# Reference file testing +test_reference_table(table, filename) +test_reference_text(text, filename) -1. **`common-functions.R` does NOT call `skip_on_cran()`** - each test file manages its own skip conditions -2. **`skip_if_no_fits()`** checks for `model_registry.RDS` in `test_files_dir` - use this for any test that loads pre-fitted models -3. **`skip_on_os()`** should ONLY be used for tests involving multivariate priors (meandif, orthonormal) where RNG differs across platforms -4. **Pure R tests** (e.g., `test-priors-print.R`, `test-tools-input.R`) should have NO file-level skips and can run on CRAN +# Skip/cache helpers +skip_if_no_fits() +skip_refit_if_cached(name) +clean_cached_fits() ``` ## AI Agent Protocol -When asked to write or refactor tests: - -1. **Scan `test-00-model-fits.R` FIRST.** Understand the inventory of available models. -2. **Map requirements to existing models.** If the user needs a test for "diagnostic plots for factor priors", find an existing model with factor priors (e.g., `fit_formula_interaction_fac`). -3. **Refuse to create new models** unless the test requires a specific mathematical structure not present in the entire suite. -4. **Never** add a model to `test-00-model-fits.R` without explicitly explaining why none of the existing 15+ models suffice. -5. **Use descriptive test names** - never use line numbers or implementation details in test names. -6. **Follow file naming conventions** - split input validation into `-input.R` files. - -## Maintenance Checklist - -**Adding a new model:** -- [ ] Check for duplicates in `test-00-model-fits.R` -- [ ] Add model to `test-00-model-fits.R` with `save_fit()` and appropriate metadata - -**Using pre-fitted models:** -- [ ] Load with `readRDS()`, never fit models outside `test-00-model-fits.R` -- [ ] Add skip conditions for missing models/packages -- [ ] Check marginal likelihood file existence before loading - -**Updating summary table tests (MAINTAINER ONLY):** -- [ ] Set `GENERATE_REFERENCE_FILES <- TRUE` -- [ ] Run tests to generate reference files -- [ ] Review diffs carefully before committing -- [ ] Reset flag to `FALSE` -- **Note**: Contributors/agents should **never** modify `GENERATE_REFERENCE_FILES` - -## Quick Examples - -### Adding and Using a Model - -```r -# 1. In test-00-model-fits.R -fit_new <- JAGS_fit(model_syntax, data, priors, ...) -marglik_new <- JAGS_bridgesampling(fit_new, log_posterior, data, priors) -result <- save_fit(fit_new, "fit_new", marglik = marglik_new, note = "Description") - -# 2. In any test file using JAGS models -fit_new <- readRDS(file.path(temp_fits_dir, "fit_new.RDS")) -marglik_file <- file.path(temp_fits_dir, "fit_new_marglik.RDS") -if (file.exists(marglik_file)) { - marglik_new <- readRDS(marglik_file) -} - -# 3. Add to test-summary-tables.R model_names vector -model_names <- c(..., "fit_new") -``` - -## Common Pitfalls - -❌ Fitting models outside `test-00-model-fits.R` -❌ Creating duplicate models with different parameters -❌ **Modifying `GENERATE_REFERENCE_FILES` flag** (maintainer only) -❌ Using line numbers in test names (e.g., "line 115") -❌ Using `context()` calls (Edition 2 deprecated) - -✅ Always load pre-fitted models with `readRDS()` -✅ Use one model per prior type -✅ Leave `GENERATE_REFERENCE_FILES <- FALSE` unchanged -✅ Use descriptive, behavior-focused test names -✅ Include standardized file headers +1. **Scan `test-00-model-fits.R` first** - understand available models +2. **Reuse existing models** - don't create duplicates +3. **Never fit models** outside `test-00-model-fits.R` +4. **Never modify** `GENERATE_REFERENCE_FILES` flag (maintainer only) ## Troubleshooting -- **"Pre-fitted models not available"**: Run `devtools::test(filter = "00-model-fits")` -- **Summary table mismatch**: Contact maintainer; **do not** modify `GENERATE_REFERENCE_FILES` -- **Marginal likelihood not found**: Check model has data and isn't spike-and-slab/mixture +| Problem | Solution | +|---------|----------| +| "Pre-fitted models not available" | Run `devtools::test(filter = "00-model-fits")` | +| Stale cache causing failures | `clean_cached_fits()` then rerun | +| Tests pass locally, fail on CI | Clear cache, run full suite | + +```` diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 6cfb20c..7bf6e3e 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -15,19 +15,17 @@ plot_prior_list <- function(prior_list, plot_type = "base", x_seq = NULL, xlim = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, show_parameter = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, par_name = NULL, prior_list_mu = NULL, ...){ - # TODO: add plots for individual parameters for weightfunction and PET-PEESE - individual = FALSE - show_figures = if(individual) 1 else NULL - # check input (most arguments are checked within density) check_list(prior_list, "prior_list") if(is.prior(prior_list) | !all(sapply(prior_list, is.prior))) stop("'prior_list' must be a list of priors.") check_char(plot_type, "plot_type", allow_values = c("base", "ggplot")) check_bool(individual, "individual") + check_int(show_parameter, "show_parameter", allow_NULL = TRUE) check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE) # check that there is no mixing of PET-PEESE and weightfunctions @@ -71,14 +69,16 @@ plot_prior_list <- function(prior_list, plot_type = "base", # get the plotting data - if(prior_type == "weightfunction"){ + if(prior_type == "weightfunction" && !individual){ + # special dispatching for visualizing the whole weightfunction # use samples (not sure how to provide analytic solution for this yes) plot_data <- .plot_data_prior_list.weightfunction(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, n_points = n_points, n_samples = n_samples) plot <- .plot.prior.weightfunction(prior_list, plot_type = plot_type, plot_data = plot_data, rescale_x = rescale_x, par_name = par_name, ...) - }else if(prior_type == "PETPEESE"){ + }else if(prior_type == "PETPEESE" && !individual){ + # special dispatching for visualizing the PET-PEESE regression # use samples (not sure how to provide analytic solution for this yes) plot_data <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, @@ -88,6 +88,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", plot <- .plot.prior.PETPEESE(prior_list, plot_type = plot_type, plot_data = plot_data, par_name = par_name, ...) }else if(prior_type %in% c("simple", "orthonormal", "meandif")){ + # regular prior distributions (or individual plots for parameters from weightfunctions/PET-PEESE) # solve analytically plot_data <- .plot_data_prior_list.simple(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, @@ -712,13 +713,10 @@ plot_prior_list <- function(prior_list, plot_type = "base", #' @export lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, show_parameter = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ - # TODO: add plots for individual parameters for weightfunction and PET-PEESE - individual = FALSE - show_parameter = if(individual) 1 else NULL - # check input (most arguments are checked within density) check_list(prior_list, "prior_list") if(!all(sapply(prior_list, is.prior))) @@ -813,13 +811,10 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @export geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, show_parameter = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ - # TODO: add plots for individual parameters for weightfunction and PET-PEESE - individual = FALSE - show_parameter = if(individual) 1 else NULL - # check input (most arguments are checked within density) check_list(prior_list, "prior_list") if(is.prior(prior_list) | !all(sapply(prior_list, is.prior))) @@ -922,14 +917,10 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @export plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE, n_points = 1000, n_samples = 10000, force_samples = FALSE, + individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, par_name = NULL, dots_prior = list(), ...){ - # TODO: add plots for individual parameters for weightfunction and PET-PEESE - # but these seem to be already possible to a degree? - individual = FALSE - show_figures = if(individual) 1 else NULL - # check input check_list(samples, "prior_list") if(any(!sapply(samples, inherits, what = "mixed_posteriors"))) @@ -944,7 +935,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # deal with bad parameter names for PET-PEESE, weightfunction if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% c("weightfunction", "weigthfunction", "omega")){ parameter <- "omega" - }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) == "petpeese"){ + }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% c("pet", "peese", "petpeese")){ parameter <- "PETPEESE" } @@ -961,7 +952,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } - if(parameter == "omega"){ + if(parameter == "omega" && !individual){ + # special dispatching for visualizing the whole weightfunction plot_data <- .plot_data_samples.weightfunction(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points) @@ -1011,7 +1003,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } - }else if(parameter == "PETPEESE"){ + }else if(parameter == "PETPEESE" && !individual){ + # special dispatching for visualizing the PET-PEESE regression plot_data <- .plot_data_samples.PETPEESE(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points, transformation = transformation, transformation_arguments = transformation_arguments, transformation_settings = transformation_settings) @@ -1081,6 +1074,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE }else{ + # regular prior distributions (or individual plots for parameters from weightfunctions/PET-PEESE) prior_list <- attr(samples[[parameter]], "prior_list") prior_list <- .simplify_prior_list(prior_list) diff --git a/man/geom_prior_list.Rd b/man/geom_prior_list.Rd index 0894e02..4abd7b0 100644 --- a/man/geom_prior_list.Rd +++ b/man/geom_prior_list.Rd @@ -12,6 +12,8 @@ geom_prior_list( n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, + show_parameter = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -47,6 +49,9 @@ analytically (or if samples are forced with \item{force_samples}{should prior be sampled instead of obtaining analytic solution whenever possible} +\item{individual}{should individual densities be returned +(e.g., in case of weightfunction)} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/man/lines_prior_list.Rd b/man/lines_prior_list.Rd index 33157a7..cd3fbfb 100644 --- a/man/lines_prior_list.Rd +++ b/man/lines_prior_list.Rd @@ -12,6 +12,8 @@ lines_prior_list( n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, + show_parameter = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -47,6 +49,9 @@ analytically (or if samples are forced with \item{force_samples}{should prior be sampled instead of obtaining analytic solution whenever possible} +\item{individual}{should individual densities be returned +(e.g., in case of weightfunction)} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/man/plot_posterior.Rd b/man/plot_posterior.Rd index c70338b..69b14b4 100644 --- a/man/plot_posterior.Rd +++ b/man/plot_posterior.Rd @@ -12,6 +12,8 @@ plot_posterior( n_points = 1000, n_samples = 10000, force_samples = FALSE, + individual = FALSE, + show_figures = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -46,6 +48,13 @@ analytically (or if samples are forced with \item{force_samples}{should prior be sampled instead of obtaining analytic solution whenever possible} +\item{individual}{should individual densities be returned +(e.g., in case of weightfunction)} + +\item{show_figures}{which figures should be returned in case of +multiple plots are generated. Useful when priors for the omega +parameter are plotted and \code{individual = TRUE}.} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/man/plot_prior_list.Rd b/man/plot_prior_list.Rd index 8b19630..48efdc7 100644 --- a/man/plot_prior_list.Rd +++ b/man/plot_prior_list.Rd @@ -13,6 +13,8 @@ plot_prior_list( n_points = 500, n_samples = 10000, force_samples = FALSE, + individual = FALSE, + show_parameter = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -51,6 +53,9 @@ analytically (or if samples are forced with \item{force_samples}{should prior be sampled instead of obtaining analytic solution whenever possible} +\item{individual}{should individual densities be returned +(e.g., in case of weightfunction)} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index 2796c13..469a3a7 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -14,9 +14,11 @@ if (test_files_dir == "" || !dir.exists(test_files_dir)) { # Setup directory for saving fitted models temp_fits_dir <- file.path(test_files_dir, "fits") temp_marglik_dir <- file.path(test_files_dir, "margliks") +temp_temp_dir <- file.path(test_files_dir, "temp") -if (!dir.exists(temp_fits_dir)) dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) +if (!dir.exists(temp_fits_dir)) dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) if (!dir.exists(temp_marglik_dir)) dir.create(temp_marglik_dir, showWarnings = FALSE, recursive = TRUE) +if (!dir.exists(temp_temp_dir)) dir.create(temp_temp_dir, showWarnings = FALSE, recursive = TRUE) # Set environment variable so other test files can locate pre-fitted models Sys.setenv(BAYESTOOLS_TEST_FILES_DIR = test_files_dir) @@ -350,23 +352,39 @@ save_fit <- function(fit, name, marglik = NULL, simple_priors = FALSE, vector_pr } # Skip model fitting if cached fits exist and ROBMA_TEST_SKIP_REFIT is TRUE -skip_refit_if_cached <- function() { +skip_refit_if_cached <- function(name) { + # refitting settings skip_refit <- Sys.getenv("BAYESTOOLS_TEST_SKIP_REFIT") - if (skip_refit != "" && as.logical(skip_refit) && length(list.files(temp_fits_dir)) > 0) { + skip_refit <- skip_refit != "" && as.logical(skip_refit) + + # fitted indicator + fitted_indicator <- file.exists(file.path(temp_temp_dir, paste0(name, ".txt"))) + + if (skip_refit && fitted_indicator) { skip("Skipping model refitting: cached fits exist and BAYESTOOLS_TEST_SKIP_REFIT=TRUE.") } + + # tests are not going to be skipped -- add fits done indicator into `temp_temp_dir` + file.create(file.path(temp_temp_dir, paste0(name, ".txt"))) } # Clean cached fitted models and margliks clean_cached_fits <- function() { - # Remove all cached files from test directories - unlink(temp_fits_dir, recursive = TRUE) - unlink(temp_marglik_dir, recursive = TRUE) - - # Recreate empty directories - dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) - dir.create(temp_marglik_dir, showWarnings = FALSE, recursive = TRUE) + if (!missing(name)) { + # remove only the specific `name`` fitted indicator files side-effects from `temp_temp_dir` + file.remove(file.path(temp_temp_dir, paste0(name, ".txt"))) + } else { + # Remove all cached files from test directories + unlink(temp_fits_dir, recursive = TRUE) + unlink(temp_marglik_dir, recursive = TRUE) + unlink(temp_temp_dir, recursive = TRUE) + + # Recreate empty directories + dir.create(temp_fits_dir, showWarnings = FALSE, recursive = TRUE) + dir.create(temp_marglik_dir, showWarnings = FALSE, recursive = TRUE) + dir.create(temp_temp_dir, showWarnings = FALSE, recursive = TRUE) + } return(invisible(TRUE)) } diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 1ef0b53..9ddaa48 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -31,7 +31,7 @@ skip_if_not_installed("rjags") # Load common test helpers source(testthat::test_path("common-functions.R")) -skip_refit_if_cached() +skip_refit_if_cached("model-fit") # Initialize model registry to track metadata about each fitted model model_registry <- list() diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index 137a2ec..a03d5a9 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1336,24 +1336,28 @@ test_that("posterior plot model averaging based on complex bias mixture model (P }) -# test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { -# -# skip_if_not_installed("rjags") -# skip_if_not_installed("bridgesampling") -# -# fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) -# fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) -# -# mixed_posteriors0 <- as_mixed_posteriors( -# mode = fit0, -# parameters = names(attr(fit0, "prior_list")) -# ) -# -# -# vdiffr::expect_doppelganger("model-as_mixed_posteriors-PET", function(){ -# plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) -# }) -# }) -# +test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) + + mixed_posteriors0 <- as_mixed_posteriors( + mode = fit0, + parameters = names(attr(fit0, "prior_list")) + ) + + plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey")) + plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey"), individual = TRUE) + + plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) + plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = TRUE) + # vdiffr::expect_doppelganger("model-as_mixed_posteriors-PET", function(){ + # plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) + # }) +}) + diff --git a/tests/testthat/test-JAGS-marglik.R b/tests/testthat/test-JAGS-marglik.R index 692285a..d68201d 100644 --- a/tests/testthat/test-JAGS-marglik.R +++ b/tests/testthat/test-JAGS-marglik.R @@ -23,6 +23,7 @@ # Load common test helpers source(testthat::test_path("common-functions.R")) +skip_refit_if_cached("JAGS-marglik") # This file tests the JAGS marginal likelihood computation functions # It uses simple models where the log marginal likelihood is known to be 0 From c670dac322ffefccf752c0369eb3499ecb59055c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Mon, 5 Jan 2026 17:38:48 +0100 Subject: [PATCH 29/38] Improve PET-PEESE and bias parameter handling in plots Refactored plotting functions to better handle PET, PEESE, PETPEESE, and weightfunction parameters, especially when present in the bias parameter as mixtures. Added .simplify_as_mixed_posterior_bias helper for extracting and simplifying bias posteriors. Updated as_mixed_posteriors to correctly set prior weights for conditional mixture posteriors. Expanded and improved tests for model averaging plots with complex JAGS models, including new vdiffr visual regression checks for PETPEESE and bias parameters. --- R/model-averaging-plots.R | 187 +++-- R/model-averaging.R | 113 +-- ...mplex-bias-conditional-posterior-peese.svg | 50 -- ...complex-bias-conditional-posterior-pet.svg | 80 -- ...plot-complex-bias-posterior-bias-peese.svg | 76 -- ...l-averaging-plot-ss-posterior-bias-pet.svg | 6 +- ...raging-plot-ss-posterior-bias-petpeese.svg | 60 ++ ...g-plot-ss-posterior-bias-weighfunction.svg | 59 ++ ...-averaging-plot-ss-posterior-omega-con.svg | 740 ------------------ ...el-averaging-plot-ss-posterior-pet-con.svg | 325 +++----- ...eraging-plot-ss-posterior-petpeese-con.svg | 60 ++ ...l-averaging-plot-ss-posterior-petpeese.svg | 60 ++ ...g-plot-ss-posterior-weightfunction-con.svg | 4 +- ...aging-plot-ss-posterior-weightfunction.svg | 4 +- .../ggplot-marginal-ss-mu-x-cont1.svg | 6 +- .../ggplot-marginal-ss-mu-x-fac2t-3.svg | 56 +- .../ggplot-marginal-ss-mu-x-fac2t-4.svg | 4 +- .../ggplot-marginal-ss-mu-x-fac3md.svg | 6 +- .../marginal-factor-independent-hist.svg | 6 +- .../marginal-inference-ss-fac-md-p.svg | 6 +- .../marginal-wf-onesided-hist.svg | 2 +- .../plot-marginal-ss-mu-x-cont1.svg | 6 +- .../plot-marginal-ss-mu-x-fac2t-3.svg | 36 +- .../plot-marginal-ss-mu-x-fac2t-4.svg | 4 +- .../plot-marginal-ss-mu-x-fac2t-5.svg | 4 +- .../plot-marginal-ss-mu-x-fac3md.svg | 6 +- tests/testthat/test-JAGS-ensemble-plots.R | 124 +-- 27 files changed, 682 insertions(+), 1408 deletions(-) delete mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg delete mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg delete mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-petpeese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-weighfunction.svg delete mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 7bf6e3e..4015964 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -15,7 +15,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", x_seq = NULL, xlim = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, - individual = FALSE, show_parameter = if(individual) 1 else NULL, + individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, par_name = NULL, prior_list_mu = NULL, ...){ @@ -25,7 +25,6 @@ plot_prior_list <- function(prior_list, plot_type = "base", stop("'prior_list' must be a list of priors.") check_char(plot_type, "plot_type", allow_values = c("base", "ggplot")) check_bool(individual, "individual") - check_int(show_parameter, "show_parameter", allow_NULL = TRUE) check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE) # check that there is no mixing of PET-PEESE and weightfunctions @@ -47,7 +46,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", } - if(prior_type == "PETPEESE"){ + if(prior_type == "PETPEESE" && !individual){ check_list(prior_list_mu, "prior_list_mu", check_length = length(prior_list)) if(is.prior(prior_list_mu) | !all(sapply(prior_list_mu, is.prior))) stop("'prior_list_mu' must be a list of priors (priors for the mu parameter are required for plotting PET-PEESE).") @@ -713,7 +712,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", #' @export lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, - individual = FALSE, show_parameter = if(individual) 1 else NULL, + individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ @@ -723,7 +722,7 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan stop("'prior_list' must be a list of priors.") check_bool(individual, "individual") check_bool(rescale_x, "rescale_x") - check_int(show_parameter, "show_parameter", allow_NULL = TRUE) + check_int(show_figures, "show_figures", allow_NULL = TRUE) check_real(scale_y2, "scale_y2", lower = 0, allow_NULL = TRUE) @@ -811,7 +810,7 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @export geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quant = NULL, n_points = 500, n_samples = 10000, force_samples = FALSE, - individual = FALSE, show_parameter = if(individual) 1 else NULL, + individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ @@ -821,7 +820,7 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan stop("'prior_list' must be a list of priors.") check_bool(individual, "individual") check_bool(rescale_x, "rescale_x") - check_int(show_parameter, "show_parameter", allow_NULL = TRUE) + check_int(show_figures, "show_figures", allow_NULL = TRUE) check_real(scale_y2, "scale_y2", lower = 0, allow_NULL = TRUE) @@ -935,24 +934,30 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # deal with bad parameter names for PET-PEESE, weightfunction if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% c("weightfunction", "weigthfunction", "omega")){ parameter <- "omega" - }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% c("pet", "peese", "petpeese")){ + }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% "petpeese"){ parameter <- "PETPEESE" + }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% "pet"){ + parameter <- "PET" + }else if(tolower(gsub("-", "", gsub("_", "", gsub(".", "", parameter, fixed = TRUE),fixed = TRUE), fixed = TRUE)) %in% "peese"){ + parameter <- "PEESE" } # get the plotting range dots <- list(...) xlim <- dots[["xlim"]] if(is.null(xlim)){ - if(parameter %in% c("omega", "PETPEESE") & !individual){ - xlim <- c(0, 1) + if(parameter %in% c("PET", "PEESE", "PETPEESE") & !individual){ + xlim <- c(0, 1) + }else if(parameter == "omega"){ + xlim <- c(0, 1) }else{ # use the data range otherwise - xlim <- NULL + xlim <- NULL } } - if(parameter == "omega" && !individual){ + if(is.element(parameter, "omega") && !individual){ # special dispatching for visualizing the whole weightfunction plot_data <- .plot_data_samples.weightfunction(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points) @@ -1003,7 +1008,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } - }else if(parameter == "PETPEESE" && !individual){ + }else if(is.element(parameter, c("PET", "PEESE", "PETPEESE")) && !individual){ # special dispatching for visualizing the PET-PEESE regression plot_data <- .plot_data_samples.PETPEESE(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points, @@ -1012,28 +1017,45 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # add priors, if requested if(prior){ - if(is.null(samples[["mu"]])) - stop("'mu' samples are required for plotting PET-PEESE.") - prior_list_mu <- attr(samples[["mu"]], "prior_list") - - # TODO: a bit of a hack - removing priors that were added as a fill for sampling - if(!is.null(samples[["PET"]]) & !is.null(samples[["PEESE"]])){ - prior_list_PET <- attr(samples[["PET"]], "prior_list") - prior_list_PEESE <- attr(samples[["PEESE"]], "prior_list") - prior_fill <- seq_along(prior_list_PET)[!sapply(prior_list_PET, is.prior.PET) & !sapply(prior_list_PEESE, is.prior.PEESE)] - prior_list <- c(prior_list_PET[sapply(prior_list_PET, is.prior.PET)], prior_list_PEESE[sapply(prior_list_PEESE, is.prior.PEESE)], - prior_list_PET[prior_fill]) - prior_list_mu <- prior_list_mu[c(c(1:length(prior_list_mu))[sapply(prior_list_PET, is.prior.PET)], c(1:length(prior_list_mu))[sapply(prior_list_PEESE, is.prior.PEESE)], c(1:length(prior_list_mu))[prior_fill])] - }else if(is.null(samples[["PET"]]) & !is.null(samples[["PEESE"]])){ - prior_list <- attr(samples[["PEESE"]], "prior_list") - }else if(!is.null(samples[["PET"]]) & is.null(samples[["PEESE"]])){ - prior_list <- attr(samples[["PET"]], "prior_list") - }else{ - stop("Either PET or PEESE samples need to be provided.") + if(is.null(samples[["mu"]]) && is.null(samples[["mu_intercept"]])) + stop("'mu' or 'mu_intercept' samples are required for plotting PET-PEESE.") + + if(!is.null(samples[["mu"]])){ + prior_list_mu <- attr(samples[["mu"]], "prior_list") + }else if(!is.null(samples[["mu_intercept"]])){ + prior_list_mu <- attr(samples[["mu_intercept"]], "prior_list") } - # cannot simplify prior_list - it would break the dependency with mu + if (is.null(samples[["bias"]])){ + # TODO: a bit of a hack - removing priors that were added as a fill for sampling + if(!is.null(samples[["PET"]]) & !is.null(samples[["PEESE"]])){ + prior_list_PET <- attr(samples[["PET"]], "prior_list") + prior_list_PEESE <- attr(samples[["PEESE"]], "prior_list") + prior_fill <- seq_along(prior_list_PET)[!sapply(prior_list_PET, is.prior.PET) & !sapply(prior_list_PEESE, is.prior.PEESE)] + prior_list <- c(prior_list_PET[sapply(prior_list_PET, is.prior.PET)], prior_list_PEESE[sapply(prior_list_PEESE, is.prior.PEESE)], + prior_list_PET[prior_fill]) + prior_list_mu <- prior_list_mu[c(c(1:length(prior_list_mu))[sapply(prior_list_PET, is.prior.PET)], c(1:length(prior_list_mu))[sapply(prior_list_PEESE, is.prior.PEESE)], c(1:length(prior_list_mu))[prior_fill])] + }else if(is.null(samples[["PET"]]) & !is.null(samples[["PEESE"]])){ + prior_list <- attr(samples[["PEESE"]], "prior_list") + }else if(!is.null(samples[["PET"]]) & is.null(samples[["PEESE"]])){ + prior_list <- attr(samples[["PET"]], "prior_list") + }else{ + stop("Either PET or PEESE samples need to be provided.") + } + } else { + prior_list <- attr(samples[["bias"]], "prior_list") + prior_list <- prior_list[sapply(prior_list, \(x) is.prior.PET(x) || is.prior.PEESE(x) || is.prior.none(x) || is.prior.point(x))] + # make cross product of the mixture priors + priors_grid <- expand.grid( + "mu" = prior_list_mu, + "PP" = prior_list + ) + prior_list_mu <- priors_grid[["mu"]] + prior_list <- priors_grid[["PP"]] + } + + # cannot simplify prior_list - it would break the dependency with mu plot_data_prior <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points, n_samples = n_samples, transformation = transformation, transformation_arguments = transformation_arguments, @@ -1074,11 +1096,16 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE }else{ - # regular prior distributions (or individual plots for parameters from weightfunctions/PET-PEESE) + # regular prior distributions (or individual plots for parameters PET-PEESE) + # bias plot parameters require special extraction + if (is.element(parameter, c("PET", "PEESE", "PETPEESE", "omega")) && !is.null(samples[["bias"]]) && inherits(samples[["bias"]], "mixed_posteriors.bias")) { + samples <- .simplify_as_mixed_posterior_bias(samples, parameter) + } prior_list <- attr(samples[[parameter]], "prior_list") prior_list <- .simplify_prior_list(prior_list) + if(any(sapply(prior_list, is.prior.factor))){ plot_data <- .plot_data_samples.factor(samples, parameter = parameter, n_points = n_points, transformation = transformation, transformation_arguments = transformation_arguments, transformation_settings = transformation_settings) @@ -1323,21 +1350,38 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE .plot_data_samples.PETPEESE <- function(samples, x_seq, x_range, x_range_quant, n_points, transformation, transformation_arguments, transformation_settings){ check_list(samples, "samples") + if (is.null(samples[["mu"]]) && is.null(samples[["mu_intercept"]])) + stop("'mu' or 'mu_intercept' samples need to be present.") - if(is.null(samples[["PET"]]) & is.null(samples[["PEESE"]])) - stop("At least one 'PET' or 'PEESE' model needs to be specified.") - if(is.null(samples[["mu"]])) - stop("'mu' samples need to be present.") + if (!is.null(samples[["bias"]])) { - # get the samples - if(!is.null(samples[["PET"]]) & !is.null(samples[["PEESE"]])){ - if(!all(attr(samples[["PET"]], "models_ind") == attr(samples[["PEESE"]], "models_ind"))) - stop("non-matching dimensions") - samples <- cbind(samples[["mu"]], samples[["PET"]], samples[["PEESE"]]) - }else if(is.null(samples[["PET"]])){ - samples <- cbind(samples[["mu"]], rep(0, length(samples[["PEESE"]])), samples[["PEESE"]]) - }else if(is.null(samples[["PEESE"]])){ - samples <- cbind(samples[["mu"]], samples[["PET"]], rep(0, length(samples[["PET"]]))) + if(length(c("PET", "PEESE") %in% samples[["bias"]]) == 0) + stop("At least one 'PET' or 'PEESE' model needs to be specified.") + + # create mu-PET-PEESE samples matrix + new_samples <- matrix(if(!is.null(samples[["mu"]])) samples[["mu"]] else samples[["mu_intercept"]], ncol = 1) + for (par in c("PET", "PEESE")) { + if (is.element(par, colnames(samples[["bias"]]))) { + new_samples <- cbind(new_samples, samples[["bias"]][,par]) + } else { + new_samples <- cbind(new_samples, 0) + } + } + + } else { + + if(is.null(samples[["PET"]]) & is.null(samples[["PEESE"]])) + stop("At least one 'PET' or 'PEESE' model needs to be specified.") + + # create mu-PET-PEESE samples matrix + new_samples <- matrix(if(!is.null(samples[["mu"]])) samples[["mu"]] else samples[["mu_intercept"]], ncol = 1) + for (par in c("PET", "PEESE")) { + if (!is.null(samples[[par]])) { + new_samples <- cbind(new_samples, samples[[par]]) + } else { + new_samples <- cbind(new_samples, 0) + } + } } # get the plotting range @@ -1350,9 +1394,9 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # compute PET-PEESE (mu + PET*se + PEESE*se^2) - x_sam <- matrix(samples[,1], nrow = length(samples), ncol = length(x_seq)) + - matrix(samples[,2], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) + - matrix(samples[,3], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) + x_sam <- matrix(new_samples[,1], nrow = length(new_samples), ncol = length(x_seq)) + + matrix(new_samples[,2], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) + + matrix(new_samples[,3], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) # transform the parameter if requested if(!is.null(transformation)){ @@ -1951,7 +1995,7 @@ plot_models <- function(model_list, samples, inference, parameter, plot_type = " return(plot) } -.simplify_spike_samples <- function(samples, prior_list){ +.simplify_spike_samples <- function(samples, prior_list){ # Check if we're dealing with spike_and_slab or mixture (which are single priors) vs list of priors is_spike_and_slab <- is.prior.spike_and_slab(prior_list) @@ -2011,7 +2055,50 @@ plot_models <- function(model_list, samples, inference, parameter, plot_type = " return(spike_probability) } +.simplify_as_mixed_posterior_bias <- function(samples, parameter) { + + ### replace all remaining priors by null prior + prior_list <- attr(samples[["bias"]], "prior_list") + if (parameter == "PET") { + prior_ind <- which(sapply(prior_list, \(x) !is.prior.PET(x))) + } else if (parameter == "PEESE") { + prior_ind <- which(sapply(prior_list, \(x) !is.prior.PEESE(x))) + } else if (parameter == "omega") { + prior_ind <- which(sapply(prior_list, \(x) !is.prior.weightfunction(x))) + } + if (length(prior_ind) > 0) { + for (i in prior_ind) { + temp_weight <- prior_list[[i]][["prior_weights"]] + prior_list[[i]] <- if (parameter == "omega") prior_none() else prior("point", parameters = list(0)) + prior_list[[i]][["prior_weights"]] <- temp_weight + } + } + + ### create new samples + new_samples <- samples[["bias"]][, grepl(parameter, colnames(samples[["bias"]])),drop=FALSE] + + ### store attribute + std_attrs <- c("dim", "dimnames", "names", "prior_list", "mcpar") + all_attrs <- attributes(samples[["bias"]]) + to_restore <- setdiff(names(all_attrs), std_attrs) + + ### re-assign attributes + for (a in to_restore) { + attr(new_samples, a) <- all_attrs[[a]] + } + + # remove `mixed_posteriors.bias` class + class(new_samples) <- class(new_samples)[!class(new_samples) %in% "mixed_posteriors.bias"] + + ### assign prior list and model indicator + attr(new_samples, "prior_list") <- prior_list + ### remove the old samples & store new samples + samples[["bias"]] <- NULL + samples[[parameter]] <- new_samples + + return(samples) +} #' @title Plot samples from the marginal posterior distributions #' diff --git a/R/model-averaging.R b/R/model-averaging.R index aadaa91..d379f96 100644 --- a/R/model-averaging.R +++ b/R/model-averaging.R @@ -730,23 +730,25 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition # subset the posterior distribution conditioning_samples <- do.call(cbind, lapply(conditional, function(parameter){ - # special cases for PET / PEESE / PET-PEESE / weightfunctions - if(parameter == "PET" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PET <- sapply(priors[["bias"]], is.prior.PET) - return(model_samples[, "bias_indicator"] %in% which(is_PET)) - } - if(parameter == "PEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) - return(model_samples[, "bias_indicator"] %in% which(is_PEESE)) - } - if(parameter == "PETPEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PET <- sapply(priors[["bias"]], is.prior.PET) - is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) - return(model_samples[, "bias_indicator"] %in% which(is_PET | is_PEESE)) - } - if(parameter == "omega" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_weightfunction <- sapply(priors[["bias"]], is.prior.weightfunction) - return(model_samples[, "bias_indicator"] %in% which(is_weightfunction)) + # special cases for PET / PEESE / PET-PEESE / weightfunctions within the bias parameter + if (!is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])) { + if(parameter == "PET"){ + is_PET <- sapply(priors[["bias"]], is.prior.PET) + return(model_samples[, "bias_indicator"] %in% which(is_PET)) + } + if(parameter == "PEESE"){ + is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) + return(model_samples[, "bias_indicator"] %in% which(is_PEESE)) + } + if(parameter == "PETPEESE"){ + is_PET <- sapply(priors[["bias"]], is.prior.PET) + is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) + return(model_samples[, "bias_indicator"] %in% which(is_PET | is_PEESE)) + } + if(parameter == "omega"){ + is_weightfunction <- sapply(priors[["bias"]], is.prior.weightfunction) + return(model_samples[, "bias_indicator"] %in% which(is_weightfunction)) + } } # normal cases @@ -782,52 +784,58 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition model_samples <- model_samples[conditioning_samples,,drop=FALSE] # set prior weights to 0 for null distributions - # TODO: this needs to be implemented for enabling of the conditional mixture posterior distributions when more than one components is present - # (e.g., conditional marginal and posterior plots) - # the current workaround is suitable only for a single parameters (to produce averaged prior and posterior plots) - if(length(conditional) == 1 && length(parameters) == 1 && (parameters == "bias" || conditional == parameters) && force_plots){ - - # special cases for PET / PEESE / PET-PEESE / weightfunctions - if(parameters == "bias" && conditional == "PET" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PET <- sapply(priors[["bias"]], is.prior.PET) - for(i in seq(along = is_PET)){ - if(!is_PET[i]){ - priors[["bias"]][[i]][["prior_weights"]] <- 0 + if(length(conditional) == 1){ + + if (conditional %in% c("bias", "PET", "PEESE", "PETPEESE", "omega") && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])) { + + # special cases for PET / PEESE / PET-PEESE / weightfunctions + if(conditional == "PET"){ + is_PET <- sapply(priors[["bias"]], is.prior.PET) + for(i in seq(along = is_PET)){ + if(!is_PET[i]){ + priors[["bias"]][[i]][["prior_weights"]] <- 0 + } } - } - }else if(parameters == "bias" && conditional == "PEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) - for(i in seq(along = is_PEESE)){ - if(!is_PEESE[i]){ - priors[["bias"]][[i]][["prior_weights"]] <- 0 + }else if(conditional == "PEESE"){ + is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) + for(i in seq(along = is_PEESE)){ + if(!is_PEESE[i]){ + priors[["bias"]][[i]][["prior_weights"]] <- 0 + } } - } - }else if(parameters == "bias" && conditional == "PETPEESE" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_PET <- sapply(priors[["bias"]], is.prior.PET) - is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) - for(i in seq(along = is_PET)){ - if(!(is_PET[i] || is_PEESE[i])){ - priors[["bias"]][[i]][["prior_weights"]] <- 0 + }else if(conditional == "PETPEESE"){ + is_PET <- sapply(priors[["bias"]], is.prior.PET) + is_PEESE <- sapply(priors[["bias"]], is.prior.PEESE) + for(i in seq(along = is_PET)){ + if(!(is_PET[i] || is_PEESE[i])){ + priors[["bias"]][[i]][["prior_weights"]] <- 0 + } } - } - }else if(parameters == "bias" && conditional == "omega" && !is.null(priors[["bias"]]) && is.prior.mixture(priors[["bias"]])){ - is_weightfunction <- sapply(priors[["bias"]], is.prior.weightfunction) - for(i in seq(along = is_weightfunction)){ - if(!is_weightfunction[i]){ - priors[["bias"]][[i]][["prior_weights"]] <- 0 + }else if(conditional == "omega"){ + is_weightfunction <- sapply(priors[["bias"]], is.prior.weightfunction) + for(i in seq(along = is_weightfunction)){ + if(!is_weightfunction[i]){ + priors[["bias"]][[i]][["prior_weights"]] <- 0 + } } } - }else if(is.prior.mixture(priors[[parameters]])){ - components <- attr(priors[[parameters]], "components") + # propagate the prior weights to the mixture prior itself + attr(priors[["bias"]], "prior_weights") <- sapply(priors[["bias"]], \(x) x[["prior_weights"]]) - attr(priors[[parameters]], "prior_weights")[which(components == "null")] <- 0 + }else if(is.prior.mixture(priors[[conditional]])){ + + components <- attr(priors[[conditional]], "components") for(i in seq(along = components)){ if(components[i] == "null"){ - priors[[parameters]][[i]][["prior_weights"]] <- 0 + priors[[conditional]][[i]][["prior_weights"]] <- 0 } } + + # propagate the prior weights to the mixture prior itself + attr(priors[[conditional]], "prior_weights") <- sapply(priors[[conditional]], \(x) x[["prior_weights"]]) } + } } @@ -1097,7 +1105,8 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition out_names <- omega_names par_names <- omega_par }else if("PETPEESE" %in% conditional){ - out_names <- par_names <- c("PET", "PEESE") + # subset in case only PET/PEESE is supplied + out_names <- par_names <- colnames(model_samples)[colnames(model_samples) %in% c("PET", "PEESE")] }else if("PET" %in% conditional){ out_names <- par_names <- "PET" }else if("PEESE" %in% conditional){ diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg deleted file mode 100644 index c65dfef..0000000 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg +++ /dev/null @@ -1,50 +0,0 @@ - - - - - - - - - - - - -Probability - - - - - - --1.0 --0.5 -0.0 -0.5 -1.0 - - - -0 -1 - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg deleted file mode 100644 index 251821c..0000000 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - - - - -0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg deleted file mode 100644 index e94de85..0000000 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - -Density - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - -0 -0.01 -0.02 -0.03 -0.04 -0.05 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg index bc53fe8..3a22fb5 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg @@ -66,9 +66,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-petpeese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-petpeese.svg new file mode 100644 index 0000000..cd2c838 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-petpeese.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-2 +-1 +0 +1 +2 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-weighfunction.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-weighfunction.svg new file mode 100644 index 0000000..0772c04 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-weighfunction.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + + + +0 +0.05 +0.975 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg deleted file mode 100644 index 3630e59..0000000 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg +++ /dev/null @@ -1,740 +0,0 @@ - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - -0 -100 -200 -300 -400 -500 - - - - - - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - -0 -50 -100 -200 -300 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - -0 -50 -100 -200 -300 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -50 -100 -150 -200 - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -20 -40 -60 -80 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -20 -40 -60 -80 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0,0.025] -omega[0,0.025] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - -0 -50 -100 -150 - - - - - - - - - - - - - - - - - -omega[0.025,0.05] -omega[0.025,0.05] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - - - - -0 -1 -2 -3 -4 -5 -6 -7 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -omega[0.05,0.975] -omega[0.05,0.975] -Frequency - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - - - - - - -0 -2 -4 -6 -8 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg index d5fea4c..8a54265 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-pet-con.svg @@ -25,35 +25,49 @@ -PET -PET -Frequency +Density - + - - - - - + + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + - - - - -0 -100 -200 -300 -400 + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability @@ -61,57 +75,12 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + @@ -120,92 +89,47 @@ + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + -PET -PET -Frequency - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - - - - - -0 -50 -100 -150 +Density - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + @@ -220,91 +144,30 @@ -PET -PET -Frequency +Probability - + - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 - - - - - -0 -1 -2 -3 -4 -5 -6 +0 +1 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg new file mode 100644 index 0000000..03094de --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-2 +-1 +0 +1 +2 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg new file mode 100644 index 0000000..636e41d --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-2 +-1 +0 +1 +2 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg index 85b7289..82924cf 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg index 7e67503..5734d8a 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg index 8843a9d..47bb5cc 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-cont1.svg @@ -51,9 +51,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg index 0257fa8..efeb6c5 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-3.svg @@ -33,13 +33,12 @@ - - - - - - - + + + + + + @@ -48,17 +47,16 @@ - - - - - - + + + + + - - - - + + + + 0 @@ -76,20 +74,18 @@ - - - - - - + + + + + --8 --6 --4 --2 -0 -2 -4 +-6 +-4 +-2 +0 +2 +4 6 Density diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg index 749dd9d..209ecc6 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac2t-4.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg index bcef9fc..5f7d233 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/ggplot-marginal-ss-mu-x-fac3md.svg @@ -49,9 +49,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg index 0ec15ca..f80a25c 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-factor-independent-hist.svg @@ -140,7 +140,7 @@ - + @@ -243,7 +243,7 @@ - + @@ -358,6 +358,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg index 9714f2f..a1e6300 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-inference-ss-fac-md-p.svg @@ -139,7 +139,7 @@ - + @@ -263,7 +263,7 @@ - + @@ -387,6 +387,6 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg index 3ecef6d..4a1dab6 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg @@ -115,7 +115,7 @@ - + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg index 95c853c..4b5e188 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-cont1.svg @@ -52,9 +52,9 @@ - - - + + + diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg index b9e45e7..5f810ed 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-3.svg @@ -18,23 +18,17 @@ - - - - - - - - - --8 --6 --4 --2 -0 -2 -4 -6 + + + + + + +-4 +-2 +0 +2 +4 @@ -56,14 +50,14 @@ - - + + A B - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg index 88d01f6..8fbc817 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-4.svg @@ -52,8 +52,8 @@ - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg index fa8247e..520ea0e 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac2t-5.svg @@ -52,8 +52,8 @@ - - + + A diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg index ba89a33..0b65fee 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/plot-marginal-ss-mu-x-fac3md.svg @@ -50,9 +50,9 @@ - - - + + + diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index a03d5a9..f4f2268 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -999,7 +999,7 @@ test_that("posterior plot functions (meandif) work", { }) -test_that("posterior plot model averaging based on complex single JAGS models (formulas + spike factors + mixture)", { +test_that("posterior plot model averaging based on complex single JAGS models (formulas + spike factors + mixture)", { skip_if_not_installed("rjags") skip_if_not_installed("bridgesampling") @@ -1046,16 +1046,25 @@ test_that("posterior plot model averaging based on complex single JAGS models ( plot_posterior(mixed_posteriors, "sigma", prior = T, dots_prior = list(col = "grey")) }) + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-PETPEESE", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", prior = T, dots_prior = list(col.fill = "orange"), ylim = c(-2, 2)) + }) + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-PET", function(){ - PET <- mixed_posteriors$bias[,"PET",drop=FALSE] - attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) - attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) - attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { - class(p) <- class(p)[!class(p) %in% "prior.PET"] - return(p) - }) - plot_posterior(list(PET = PET), "PET", prior = T, dots_prior = list(col = "grey")) + plot_posterior(mixed_posteriors, "PET", prior = T, dots_prior = list(col.fill = "orange"), ylim = c(-2, 2)) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-PET", function(){ + plot_posterior(mixed_posteriors, "PET", prior = T, dots_prior = list(col = "grey"), individual = TRUE) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-weighfunction", function(){ + plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col.fill = "orange")) }) +# TODO: needs a specific dispatch because it becomes a vector of parameters +# vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-omega", function(){ +# plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE) +# }) mixed_posteriors_conditional1 <- as_mixed_posteriors( @@ -1117,31 +1126,37 @@ test_that("posterior plot model averaging based on complex single JAGS models ( mixed_posteriors_conditional5a <- as_mixed_posteriors( mode = fit1, - parameters = "bias" + parameters = c("mu_intercept", "bias") ) mixed_posteriors_conditional5b <- as_mixed_posteriors( mode = fit1, - parameters = "bias", + parameters = c("mu_intercept", "bias"), conditional = "bias", force_plots = TRUE ) mixed_posteriors_conditional6a <- as_mixed_posteriors( mode = fit1, - parameters = "bias", - conditional = "PET", + parameters = c("mu_intercept", "bias"), + conditional = "PETPEESE", force_plots = TRUE ) mixed_posteriors_conditional6b <- as_mixed_posteriors( + mode = fit1, + parameters = c("mu_intercept", "bias"), + conditional = "PET", + force_plots = TRUE + ) + + mixed_posteriors_conditional6c <- as_mixed_posteriors( mode = fit1, parameters = "bias", conditional = "omega", force_plots = TRUE ) - vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-weightfunction", function(){ oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) @@ -1153,35 +1168,50 @@ test_that("posterior plot model averaging based on complex single JAGS models ( oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) par(mar = c(4, 4, 1, 4)) - plot_posterior(mixed_posteriors_conditional6b, parameter = "weightfunction", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5))) + plot_posterior(mixed_posteriors_conditional6c, parameter = "weightfunction", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5))) }) - vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PET-con", function(){ + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PETPEESE", function(){ oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) - hist(mixed_posteriors_conditional5a$bias[,"PET"], breaks = 50, col = "grey", main = "PET", xlab = "PET") - hist(mixed_posteriors_conditional5b$bias[,"PET"], breaks = 50, col = "grey", main = "PET", xlab = "PET") - hist(mixed_posteriors_conditional6a$bias[,"PET"], breaks = 50, col = "grey", main = "PET", xlab = "PET") + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors_conditional5a, parameter = "PETPEESE", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), ylim = c(-2, 2)) }) - vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-omega-con", function(){ + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PETPEESE-con", function(){ oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) - par(mar = c(4, 4, 1, 4), mfrow = c(3, 3)) - hist(mixed_posteriors_conditional5a$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - hist(mixed_posteriors_conditional5a$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - hist(mixed_posteriors_conditional5a$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") - - hist(mixed_posteriors_conditional5b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - hist(mixed_posteriors_conditional5b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - hist(mixed_posteriors_conditional5b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") - - hist(mixed_posteriors_conditional6b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - hist(mixed_posteriors_conditional6b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - hist(mixed_posteriors_conditional6b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors_conditional6a, parameter = "PETPEESE", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), ylim = c(-2, 2)) }) + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-PET-con", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 1)) + plot_posterior(mixed_posteriors_conditional5a, parameter = "PET", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), individual = TRUE) + plot_posterior(mixed_posteriors_conditional6b, parameter = "PET", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), individual = TRUE) + plot_posterior(mixed_posteriors_conditional6c, parameter = "PET", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), individual = TRUE) + }) + + # vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-omega-con", function(){ + # TODO: add plotting of individual weights + # oldpar <- graphics::par(no.readonly = TRUE) + # on.exit(graphics::par(mar = oldpar[["mar"]])) + # par(mar = c(4, 4, 1, 4), mfrow = c(3, 3)) + # hist(mixed_posteriors_conditional5a$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") + # hist(mixed_posteriors_conditional5a$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") + # hist(mixed_posteriors_conditional5a$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") + # + # hist(mixed_posteriors_conditional5b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") + # hist(mixed_posteriors_conditional5b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") + # hist(mixed_posteriors_conditional5b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") + # + # hist(mixed_posteriors_conditional6b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") + # hist(mixed_posteriors_conditional6b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") + # hist(mixed_posteriors_conditional6b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") + # }) + }) test_that("posterior plot model averaging based on simple single JAGS models (formulas)", { @@ -1250,17 +1280,17 @@ test_that("posterior plot model averaging based on complex bias mixture model (P par(mar = c(4, 4, 1, 4)) plot_posterior(mixed_posteriors, "mu", prior = TRUE, dots_prior = list(col = "grey")) }) - - vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PET", function(){ - PET <- mixed_posteriors$bias[,"PET",drop=FALSE] - attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) - attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) - attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { - class(p) <- class(p)[!class(p) %in% "prior.PET"] - return(p) - }) - plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) - }) +# TODO: update +# vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PET", function(){ +# PET <- mixed_posteriors$bias[,"PET",drop=FALSE] +# attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) +# attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) +# attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { +# class(p) <- class(p)[!class(p) %in% "prior.PET"] +# return(p) +# }) +# plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) +# }) vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PEESE", function(){ PEESE <- mixed_posteriors$bias[,"PEESE",drop=FALSE] @@ -1345,13 +1375,15 @@ test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) mixed_posteriors0 <- as_mixed_posteriors( - mode = fit0, - parameters = names(attr(fit0, "prior_list")) + mode = fit0, + parameters = names(attr(fit0, "prior_list")), + force_plots = TRUE ) plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey")) plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey"), individual = TRUE) + # TODO: fixed this plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = TRUE) # vdiffr::expect_doppelganger("model-as_mixed_posteriors-PET", function(){ From e73d31110a7f06675e0b04f16800bd1de12a113a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Fri, 9 Jan 2026 16:52:41 +0100 Subject: [PATCH 30/38] fix single weightfunction parameter plots --- R/model-averaging-plots.R | 379 +++++++++++++++++++--- tests/testthat/test-JAGS-ensemble-plots.R | 52 +-- 2 files changed, 371 insertions(+), 60 deletions(-) diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 4015964..1960f66 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -427,6 +427,67 @@ plot_prior_list <- function(prior_list, plot_type = "base", return(out) } +.plot_data_prior_list.weightparameter<- function(prior_list, parameter, n_points, n_samples){ + + # join the same priors + prior_list <- .simplify_prior_list(prior_list) + + prior_weights <- sapply(prior_list, function(p)p$prior_weights) + mixing_prop <- prior_weights / sum(prior_weights) + + prior_list <- prior_list[round(n_samples * mixing_prop) > 0] + mixing_prop <- mixing_prop[round(n_samples * mixing_prop) > 0] + + # replace non-weighfunctions from prior mixture + if(any(!c(sapply(prior_list, is.prior.weightfunction) | sapply(prior_list, is.prior.none)))){ + for(i in seq_along(prior_list)){ + if(!(is.prior.weightfunction(prior_list[[i]]) | is.prior.none(prior_list[[i]]))){ + prior_list[[i]] <- prior_none(prior_weights = prior_weights[i]) + } + } + } + + # get the samples + samples_list <- list() + for(i in seq_along(prior_list)){ + if(is.prior.weightfunction(prior_list[[i]])){ + samples_list[[i]] <- rng(prior_list[[i]], round(n_samples * mixing_prop[i])) + }else{ + samples_list[[i]] <- list() + } + + } + + # merge the samples + omega_mapping <- weightfunctions_mapping(prior_list) + omega_cuts <- weightfunctions_mapping(prior_list, cuts_only = TRUE) + + # join samples + samples <- matrix(nrow = 0, ncol = length(omega_cuts) - 1) + models_ind <- NULL + for(i in seq_along(samples_list)){ + if(is.prior.weightfunction(prior_list[[i]])){ + samples <- rbind(samples, samples_list[[i]][,omega_mapping[[i]]]) + models_ind <- c(models_ind, rep(i, nrow(samples_list[[i]]))) + }else{ + samples <- rbind(samples, matrix(1, ncol = length(omega_cuts) - 1, nrow = round(n_samples * mixing_prop[i]))) + models_ind <- c(models_ind, rep(i,round(n_samples * mixing_prop[i]))) + } + } + + x_seq <- omega_cuts + omega_names <- sapply(1:(length(omega_cuts)-1), function(i)paste0("omega[",omega_cuts[i],",",omega_cuts[i+1],"]")) + colnames(samples) <- omega_names + attr(samples, "prior_list") <- prior_list + attr(samples, "models_ind") <- models_ind + + samples <- list("omega" = samples) + + # re-use the posterior function with prior samples + out <- .plot_data_samples.weightparameter(samples, parameter = parameter, n_points = n_points) + + return(out) +} .plot_data_prior_list.PETPEESE <- function(prior_list, x_seq, x_range, x_range_quant, n_points, n_samples, transformation, transformation_arguments, transformation_settings, prior_list_mu){ @@ -928,7 +989,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE check_char(plot_type, "plot_type", allow_values = c("base", "ggplot")) check_bool(individual, "individual") check_bool(rescale_x, "rescale_x") - check_int(show_figures, "show_figures", allow_NULL = TRUE) + check_int(show_figures, "show_figures", allow_NULL = TRUE, lower = 0) .check_transformation_input(transformation, transformation_arguments, transformation_settings) # deal with bad parameter names for PET-PEESE, weightfunction @@ -957,55 +1018,162 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } - if(is.element(parameter, "omega") && !individual){ - # special dispatching for visualizing the whole weightfunction + if(is.element(parameter, "omega")){ - plot_data <- .plot_data_samples.weightfunction(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points) + if (individual) { - # add priors, if requested - if(prior){ - - # extract the correct weightfunction samples - if(!is.null(samples[[parameter]])){ - prior_list <- attr(samples[[parameter]], "prior_list") - }else if(!is.null(samples[["bias"]])){ - prior_list <- attr(samples[["bias"]], "prior_list") - }else{ - stop("No 'omega' or 'bias' samples found.") + # bias plot parameters require special extraction + if (!is.null(samples[["bias"]]) && inherits(samples[["bias"]], "mixed_posteriors.bias")) { + samples <- .simplify_as_mixed_posterior_bias(samples, parameter) } + prior_list <- attr(samples[[parameter]], "prior_list") + prior_list <- .simplify_prior_list(prior_list) - prior_list <- .simplify_prior_list(prior_list) - plot_data_prior <- .plot_data_prior_list.weightfunction(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, - n_points = n_points, n_samples = n_samples) - # transplant common xlim and ylim - plot_data_joined <- list(plot_data_prior, plot_data) + # plot the individual weight parameters + out_list <- list() + par_names <- colnames(samples[["omega"]]) - xlim <- range(as.vector(sapply(plot_data_joined, attr, which = "x_range"))) - ylim <- range(as.vector(sapply(plot_data_joined, attr, which = "y_range"))) - attr(plot_data_prior, "x_range") <- xlim - attr(plot_data_prior, "y_range") <- ylim - dots_prior <- .transfer_dots(dots_prior, ...) + if (!is.null(show_figures)) { + if (show_figures > length(par_names)) { + stop("'show_figures' corresponds to a number larger than the number of weight function parameters.") + } else { + par_names <- par_names[show_figures] + } + } - args <- dots_prior - args$x <- prior_list - args$plot_data <- plot_data_prior - args$rescale_x <- rescale_x - args$plot_type <- plot_type - args$par_name <- par_name - plot <- do.call(.plot.prior.weightfunction, args) + for (par in par_names) { + + plot_data <- .plot_data_samples.weightparameter(samples, parameter = par, n_points = n_points) + + # add priors, if requested + if(prior){ + + plot_data_prior <- .plot_data_prior_list.weightparameter(prior_list, parameter = par_names, n_points = n_points, n_samples = n_samples) + + # transplant common xlim and ylim + plot_data_joined <- c(plot_data_prior, plot_data) + + xlim <- range(as.vector(sapply(plot_data_joined, attr, which = "x_range"))) + attr(plot_data_prior[[1]], "x_range") <- xlim + + if(any(sapply(plot_data_prior, inherits, what = "density.prior.simple")) & any(sapply(plot_data_prior, inherits, what = "density.prior.point"))){ + ylim <- range(as.vector(sapply(plot_data_joined[sapply(plot_data_joined, inherits, what = "density.prior.simple")], attr, which = "y_range"))) + ylim2 <- range(as.vector(sapply(plot_data_joined[sapply(plot_data_joined, inherits, what = "density.prior.point")], attr, which = "y_range"))) + attr(plot_data_prior[[which.max(sapply(plot_data_prior, inherits, what = "density.prior.simple"))]], "y_range") <- ylim + attr(plot_data_prior[[which.max(sapply(plot_data_prior, inherits, what = "density.prior.point"))]], "y_range") <- ylim2 + }else if(any(sapply(plot_data_prior, inherits, what = "density.prior.simple"))){ + ylim <- range(as.vector(sapply(plot_data_joined[sapply(plot_data_joined, inherits, what = "density.prior.simple")], attr, which = "y_range"))) + attr(plot_data_prior[[which.max(sapply(plot_data_prior, inherits, what = "density.prior.simple"))]], "y_range") <- ylim + }else if(any(sapply(plot_data_prior, inherits, what = "density.prior.point"))){ + ylim <- range(as.vector(sapply(plot_data_joined[sapply(plot_data_joined, inherits, what = "density.prior.point")], attr, which = "y_range"))) + attr(plot_data_prior[[which.max(sapply(plot_data_prior, inherits, what = "density.prior.point"))]], "y_range") <- ylim + } + + scale_y2 <- .get_scale_y2(plot_data_prior, ...) + dots_prior <- .transfer_dots(dots_prior, ...) + + + # set the y/x ranges + for(i in seq_along(plot_data)){ + if(inherits(plot_data[[i]], what = "density.prior.point")){ + attr(plot_data[[i]], which = "y_range") <- if(any(sapply(plot_data_prior, inherits, what = "density.prior.simple")) & any(sapply(plot_data_prior, inherits, what = "density.prior.point"))) ylim2 else ylim + }else{ + attr(plot_data[[i]], which = "y_range") <- ylim + attr(plot_data[[i]], which = "x_range") <- xlim + } + } + + # plot prior + args_prior <- dots_prior + args_prior$plot_data <- plot_data_prior + args_prior$plot_type <- plot_type + args_prior$par_name <- par_name + args_prior$scale_y2 <- scale_y2 + + plot <- do.call(.plot_prior_list.both, args_prior) + + + # plot posterior + args <- list(...) + args$plot_data <- plot_data + args$plot_type <- plot_type + args$par_name <- par_name + args$scale_y2 <- scale_y2 + args$add <- TRUE + + if(plot_type == "base"){ + plot <- do.call(.plot_prior_list.both, args) + }else if(plot_type == "ggplot"){ + plot <- plot + do.call(.plot_prior_list.both, args) + out_list[[par_name]] <- plot + } - if(plot_type == "ggplot"){ - plot <- plot + .geom_prior.weightfunction(plot_data, rescale_x = rescale_x, ...) - }else{ - .lines.prior.weightfunction(plot_data, rescale_x = rescale_x, ...) + }else{ + + # plot just posterior otherwise + plot <- .plot_prior_list.both(plot_data = plot_data, plot_type = plot_type, par_name = par_name, ...) + out_list[[par_name]] <- plot + + } } - }else{ + plot <- out_list - # plot just posterior otherwise - plot <- .plot.prior.weightfunction(NULL, plot_data = plot_data, plot_type = plot_type, rescale_x = rescale_x, par_name = par_name, ...) + + + } else { + + # special dispatching for visualizing the whole weightfunction + + plot_data <- .plot_data_samples.weightfunction(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points) + + # add priors, if requested + if(prior){ + + # extract the correct weightfunction samples + if(!is.null(samples[[parameter]])){ + prior_list <- attr(samples[[parameter]], "prior_list") + }else if(!is.null(samples[["bias"]])){ + prior_list <- attr(samples[["bias"]], "prior_list") + }else{ + stop("No 'omega' or 'bias' samples found.") + } + + prior_list <- .simplify_prior_list(prior_list) + plot_data_prior <- .plot_data_prior_list.weightfunction(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, + n_points = n_points, n_samples = n_samples) + + # transplant common xlim and ylim + plot_data_joined <- list(plot_data_prior, plot_data) + + xlim <- range(as.vector(sapply(plot_data_joined, attr, which = "x_range"))) + ylim <- range(as.vector(sapply(plot_data_joined, attr, which = "y_range"))) + attr(plot_data_prior, "x_range") <- xlim + attr(plot_data_prior, "y_range") <- ylim + dots_prior <- .transfer_dots(dots_prior, ...) + + args <- dots_prior + args$x <- prior_list + args$plot_data <- plot_data_prior + args$rescale_x <- rescale_x + args$plot_type <- plot_type + args$par_name <- par_name + plot <- do.call(.plot.prior.weightfunction, args) + + if(plot_type == "ggplot"){ + plot <- plot + .geom_prior.weightfunction(plot_data, rescale_x = rescale_x, ...) + }else{ + .lines.prior.weightfunction(plot_data, rescale_x = rescale_x, ...) + } + + }else{ + + # plot just posterior otherwise + plot <- .plot.prior.weightfunction(NULL, plot_data = plot_data, plot_type = plot_type, rescale_x = rescale_x, par_name = par_name, ...) + + } } }else if(is.element(parameter, c("PET", "PEESE", "PETPEESE")) && !individual){ @@ -1099,7 +1267,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # regular prior distributions (or individual plots for parameters PET-PEESE) # bias plot parameters require special extraction - if (is.element(parameter, c("PET", "PEESE", "PETPEESE", "omega")) && !is.null(samples[["bias"]]) && inherits(samples[["bias"]], "mixed_posteriors.bias")) { + if (is.element(parameter, c("PET", "PEESE", "PETPEESE")) && !is.null(samples[["bias"]]) && inherits(samples[["bias"]], "mixed_posteriors.bias")) { samples <- .simplify_as_mixed_posterior_bias(samples, parameter) } prior_list <- attr(samples[[parameter]], "prior_list") @@ -1480,6 +1648,139 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE return(out) } +.plot_data_samples.weightparameter<- function(samples, parameter, n_points){ + + check_list(samples, "samples", check_names = "omega", allow_other = TRUE) + if(!is.null(samples[["omega"]])){ + samples <- samples[["omega"]] + }else if(!is.null(samples[["bias"]])){ + samples <- samples[["bias"]] + }else{ + stop("No 'omega' or 'bias' samples found.") + } + + x_points <- NULL + y_points <- NULL + x_den <- NULL + y_den <- NULL + + # extract the relevant data + prior_list <- attr(samples, "prior_list") + models_ind <- attr(samples, "models_ind") + samples <- samples[,parameter] + if (!(is.prior.mixture(prior_list) || is.prior.spike_and_slab(prior_list)) && is.prior(prior_list)) + prior_list <- list(prior_list) + + # replace prior_none with spike(1) + for (i in seq_along(prior_list)) { + if (is.prior.none(prior_list[[i]])) { + temp_weight <- prior_list[[i]][["prior_weights"]] + prior_list[[i]] <- prior("spike", parameter = list(1)) + prior_list[[i]][["prior_weights"]] <- temp_weight + } + } + + # deal with spikes + samples_is_1 <- abs(samples - 1) < 1e-6 + + if(any(samples_is_1)){ + x_points <- 1 + y_points <- mean(samples_is_1) + + # remove the used samples so they are not re-used in density + # (since they might be forced to one even in non-null models due to cummulativness) + models_ind <- models_ind[!samples_is_1] + samples <- samples[!samples_is_1] + + }else{ + x_points <- NULL + y_points <- NULL + } + + # deal with the densities + if (!all(sapply(prior_list, \(x) is.prior.point(x) || is.prior.none(x)))) { + + samples_density <- samples[models_ind %in% which(!sapply(prior_list, is.prior.point))] + + if(length(samples_density) > 0){ + + args <- list(x = samples_density, n = n_points) + + # set the endpoints for possible truncation + prior_list_simple <- prior_list[!sapply(prior_list, is.prior.point)] + prior_list_simple_lower <- 0 + prior_list_simple_upper <- 1 + + if(!is.infinite(prior_list_simple_lower)){ + args <- c(args, from = prior_list_simple_lower) + } + if(!is.infinite(prior_list_simple_upper)){ + args <- c(args, to = prior_list_simple_upper) + } + + # get the density estimate + density_continuous <- do.call(stats::density, args) + x_den <- density_continuous$x + y_den <- density_continuous$y * (length(samples_density) / length(samples)) + + # check for truncation + if(isTRUE(all.equal(prior_list_simple_lower, x_den[1])) | prior_list_simple_lower >= x_den[1]){ + y_den <- c(0, y_den) + x_den <- c(x_den[1], x_den) + } + if(isTRUE(all.equal(prior_list_simple_upper, x_den[length(x_den)])) | prior_list_simple_upper <= x_den[length(x_den)]){ + y_den <- c(y_den, 0) + x_den <- c(x_den, x_den[length(x_den)]) + } + } + } + + + # create the output object + out <- list() + + # add continuous densities + if(!is.null(y_den)){ + out_den <- list( + call = call("density", "mixed samples"), + bw = NULL, + n = n_points, + x = x_den, + y = y_den, + samples = samples_density + ) + + class(out_den) <- c("density", "density.prior", "density.prior.simple") + attr(out_den, "x_range") <- range(x_den) + attr(out_den, "y_range") <- c(0, max(y_den)) + attr(out_den, "parameter") <- parameter + + out[["density"]] <- out_den + } + + # add spikes + if(!is.null(y_points)){ + for(i in seq_along(y_points)){ + temp_points <- list( + call = call("density", paste0("point", i)), + bw = NULL, + n = n_points, + x = x_points[i], + y = y_points[i], + samples = NULL + ) + + class(temp_points) <- c("density", "density.prior", "density.prior.point") + attr(temp_points, "x_range") <- c(0, 1) + attr(temp_points, "y_range") <- c(0, max(y_points[i])) + attr(temp_points, "parameter") <- parameter + + out[[paste0("points",i)]] <- temp_points + } + } + + return(out) +} .plot_data_samples.factor <- function(samples, parameter, n_points, transformation, transformation_arguments, transformation_settings){ check_list(samples, "samples", check_names = parameter, allow_other = TRUE) diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index f4f2268..c4eedfb 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1061,10 +1061,16 @@ test_that("posterior plot model averaging based on complex single JAGS models (f vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-weighfunction", function(){ plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col.fill = "orange")) }) -# TODO: needs a specific dispatch because it becomes a vector of parameters -# vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-omega", function(){ -# plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE) -# }) + + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-omega", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(2, 2)) + plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 1) + plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 2) + plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 3) + plot_posterior(mixed_posteriors, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 4) + }) mixed_posteriors_conditional1 <- as_mixed_posteriors( @@ -1194,23 +1200,27 @@ test_that("posterior plot model averaging based on complex single JAGS models (f plot_posterior(mixed_posteriors_conditional6c, parameter = "PET", prior = TRUE, col = "black", col.fill = ggplot2::alpha("grey", 0.2), dots_prior = list(col = "red", col.fill = ggplot2::alpha("red", 0.5)), individual = TRUE) }) - # vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-omega-con", function(){ - # TODO: add plotting of individual weights - # oldpar <- graphics::par(no.readonly = TRUE) - # on.exit(graphics::par(mar = oldpar[["mar"]])) - # par(mar = c(4, 4, 1, 4), mfrow = c(3, 3)) - # hist(mixed_posteriors_conditional5a$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - # hist(mixed_posteriors_conditional5a$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - # hist(mixed_posteriors_conditional5a$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") - # - # hist(mixed_posteriors_conditional5b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - # hist(mixed_posteriors_conditional5b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - # hist(mixed_posteriors_conditional5b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") - # - # hist(mixed_posteriors_conditional6b$bias[,"omega[0,0.025]"], breaks = 50, col = "grey", main = "omega[0,0.025]", xlab = "omega[0,0.025]") - # hist(mixed_posteriors_conditional6b$bias[,"omega[0.025,0.05]"], breaks = 50, col = "grey", main = "omega[0.025,0.05]", xlab = "omega[0.025,0.05]") - # hist(mixed_posteriors_conditional6b$bias[,"omega[0.05,0.975]"], breaks = 50, col = "grey", main = "omega[0.05,0.975]", xlab = "omega[0.05,0.975]") - # }) + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-omega-con", function(){ + + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(3, 4)) + plot_posterior(mixed_posteriors_conditional5a, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 1) + plot_posterior(mixed_posteriors_conditional5a, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 2) + plot_posterior(mixed_posteriors_conditional5a, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 3) + plot_posterior(mixed_posteriors_conditional5a, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 4) + + plot_posterior(mixed_posteriors_conditional5b, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 1) + plot_posterior(mixed_posteriors_conditional5b, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 2) + plot_posterior(mixed_posteriors_conditional5b, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 3) + plot_posterior(mixed_posteriors_conditional5b, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 4) + + plot_posterior(mixed_posteriors_conditional6c, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 1) + plot_posterior(mixed_posteriors_conditional6c, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 2) + plot_posterior(mixed_posteriors_conditional6c, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 3) + plot_posterior(mixed_posteriors_conditional6c, "omega", prior = T, dots_prior = list(col = "grey"), individual = TRUE, show_figures = 4) + + }) }) From 3ac50d9816ae1018ada5c92da2755e11250cf5ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sat, 10 Jan 2026 10:02:51 +0100 Subject: [PATCH 31/38] fix plots --- .Rprofile | 1 + R/model-averaging-plots.R | 6 + .../interaction_ensemble_estimates.txt | 10 +- .../interaction_ensemble_inference.txt | 2 +- .../interaction_ensemble_summary.txt | 4 +- ...mplex-bias-conditional-posterior-peese.svg | 56 ++ ...complex-bias-conditional-posterior-pet.svg | 58 ++ ...plot-complex-bias-posterior-bias-peese.svg | 78 ++ ...g-plot-complex-bias-posterior-bias-pet.svg | 104 +-- ...t-complex-bias-posterior-bias-petpeese.svg | 60 ++ ...ot-simple-posterior-peese-ind-no-prior.svg | 59 ++ ...raging-plot-simple-posterior-peese-ind.svg | 62 ++ ...g-plot-simple-posterior-peese-no-prior.svg | 60 ++ ...-averaging-plot-simple-posterior-peese.svg | 62 ++ ...plot-simple-posterior-pet-ind-no-prior.svg | 53 ++ ...veraging-plot-simple-posterior-pet-ind.svg | 56 ++ ...ing-plot-simple-posterior-pet-no-prior.svg | 62 ++ ...el-averaging-plot-simple-posterior-pet.svg | 66 ++ ...averaging-plot-ss-posterior-bias-omega.svg | 254 ++++++ ...eraging-plot-ss-posterior-bias-pet-ind.svg | 76 ++ ...l-averaging-plot-ss-posterior-bias-pet.svg | 72 +- ...-averaging-plot-ss-posterior-omega-con.svg | 720 ++++++++++++++++++ ...eraging-plot-ss-posterior-petpeese-con.svg | 4 +- ...l-averaging-plot-ss-posterior-petpeese.svg | 2 +- ...g-plot-ss-posterior-weightfunction-con.svg | 4 +- ...aging-plot-ss-posterior-weightfunction.svg | 4 +- tests/testthat/common-functions.R | 120 +-- tests/testthat/test-00-model-fits.R | 42 - tests/testthat/test-JAGS-ensemble-plots.R | 128 ++-- tests/testthat/test-JAGS-ensemble-tables.R | 4 +- tests/testthat/test-JAGS-formula-scale.R | 23 +- 31 files changed, 2034 insertions(+), 278 deletions(-) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-petpeese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg diff --git a/.Rprofile b/.Rprofile index a4766fd..6e8d1ca 100644 --- a/.Rprofile +++ b/.Rprofile @@ -2,4 +2,5 @@ if(interactive()){ library(devtools) library(testthat) library(vdiffr) + source("C:/R-Packages/BayesTools/tests/testthat/common-functions.R") } diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 1960f66..400e10a 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -1193,6 +1193,9 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE }else if(!is.null(samples[["mu_intercept"]])){ prior_list_mu <- attr(samples[["mu_intercept"]], "prior_list") } + if(is.prior.simple(prior_list_mu)){ + prior_list_mu <- list(prior_list_mu) + } if (is.null(samples[["bias"]])){ # TODO: a bit of a hack - removing priors that were added as a fill for sampling @@ -1210,6 +1213,9 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE }else{ stop("Either PET or PEESE samples need to be provided.") } + if(is.prior.simple(prior_list)){ + prior_list <- list(prior_list) + } } else { prior_list <- attr(samples[["bias"]], "prior_list") prior_list <- prior_list[sapply(prior_list, \(x) is.prior.PET(x) || is.prior.PEESE(x) || is.prior.none(x) || is.prior.point(x))] diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt index 357ec9a..5c13b45 100644 --- a/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_estimates.txt @@ -1,6 +1,6 @@ Mean Median 0.025 0.95 -(mu) x_cont1 0.449 0.448 0.207 0.643 -(mu) x_fac3o[1] -0.003 -0.002 -0.378 0.320 -(mu) x_fac3o[2] -0.109 -0.107 -0.489 0.197 -(mu) x_cont1:x_fac3o[1] -0.015 0.000 -0.296 0.000 -(mu) x_cont1:x_fac3o[2] -0.004 0.000 -0.137 0.000 +(mu) x_cont1 0.453 0.450 0.213 0.652 +(mu) x_fac3o[1] 0.022 0.022 -0.348 0.336 +(mu) x_fac3o[2] -0.096 -0.090 -0.461 0.207 +(mu) x_cont1:x_fac3o[1] -0.192 -0.181 -0.651 0.118 +(mu) x_cont1:x_fac3o[2] -0.053 -0.023 -0.434 0.260 diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt index a0227dd..468fdcb 100644 --- a/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_inference.txt @@ -1,4 +1,4 @@ Models Prior prob. Post. prob. Inclusion BF (mu) x_cont1 2/2 1.000 1.000 Inf (mu) x_fac3o 2/2 1.000 1.000 Inf -(mu) x_cont1:x_fac3o 1/2 0.500 0.071 0.076 +(mu) x_cont1:x_fac3o 1/2 0.500 0.881 7.389 diff --git a/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt b/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt index b984601..8ffa3c0 100644 --- a/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt +++ b/tests/results/JAGS-ensemble-tables/interaction_ensemble_summary.txt @@ -1,3 +1,3 @@ Model Prior (mu) x_cont1 Prior (mu) x_fac3o Prior (mu) x_cont1:x_fac3o Prior prob. log(marglik) Post. prob. Inclusion BF - 1 Normal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -158.89 0.929 13.112 - 2 Normal(0, 1) orthonormal contrast: mNormal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -161.46 0.071 0.076 + 1 Normal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -22.00 0.119 0.135 + 2 Normal(0, 1) orthonormal contrast: mNormal(0, 1) orthonormal contrast: mNormal(0, 1) 0.500 -20.00 0.881 7.389 diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg new file mode 100644 index 0000000..347986e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-peese.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg new file mode 100644 index 0000000..990abd6 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-conditional-posterior-pet.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg new file mode 100644 index 0000000..57d81f7 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-peese.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + +Density + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + +0 +0.01 +0.02 +0.03 +0.04 +0.05 +0.06 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg index 3f7baeb..d21ed5d 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-pet.svg @@ -18,59 +18,63 @@ -Density - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - - -0 -0.02 -0.04 -0.06 -0.08 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability +Density + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + +0 +0.02 +0.04 +0.06 +0.08 +0.1 +0.12 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability - - + + - - - - - - - + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-petpeese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-petpeese.svg new file mode 100644 index 0000000..67584f5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-complex-bias-posterior-bias-petpeese.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-1 +0 +1 +2 +3 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind-no-prior.svg new file mode 100644 index 0000000..0c6e99f --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind-no-prior.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind.svg new file mode 100644 index 0000000..caecb3d --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-ind.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-no-prior.svg new file mode 100644 index 0000000..1009b63 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese-no-prior.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese.svg new file mode 100644 index 0000000..5762bc2 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-peese.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind-no-prior.svg new file mode 100644 index 0000000..698a191 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind-no-prior.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind.svg new file mode 100644 index 0000000..aa8faad --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-ind.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +1 +2 +3 +4 +Density + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-no-prior.svg new file mode 100644 index 0000000..c6df742 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet-no-prior.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 +0.10 +0.12 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet.svg new file mode 100644 index 0000000..1e1c7fd --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-pet.svg @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 +0.10 +0.12 +0.14 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg new file mode 100644 index 0000000..c13b71e --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg @@ -0,0 +1,254 @@ + + + + + + + + + + + + + + + + + + + +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +0.5 +1 +1.5 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +0.5 +1 +1.5 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet-ind.svg new file mode 100644 index 0000000..3a22fb5 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet-ind.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + +Density + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + +0 +0.05 +0.1 +0.15 +0.2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg index 3a22fb5..d97198a 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-pet.svg @@ -18,47 +18,33 @@ -Density - + - - - - - - + + + + + 0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 - +0.2 +0.4 +0.6 +0.8 +1.0 + - - - - -0 -0.05 -0.1 -0.15 -0.2 - - - - - - - -0 -0.2 -0.4 -0.6 -0.8 -1 -Probability + + + + +-2 +-1 +0 +1 +2 +PET-PEESE +Standard error +Effect size @@ -66,11 +52,9 @@ - - - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg new file mode 100644 index 0000000..b823388 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg @@ -0,0 +1,720 @@ + + + + + + + + + + + + + + + + + + + +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +0.5 +1 +1.5 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + + + + + + + + +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + + + + + + + + + + + + + +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 +1.4 + + + + + + + +Density + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 +1.4 + + + + + + + +Density + + + + + + + + + + + + + + + + + + +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +Probability + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg index 03094de..6208fdb 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese-con.svg @@ -52,8 +52,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg index 636e41d..701df67 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-petpeese.svg @@ -52,7 +52,7 @@ - + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg index 82924cf..16f6b97 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction-con.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg index 5734d8a..ee58958 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-weightfunction.svg @@ -51,8 +51,8 @@ - - + + diff --git a/tests/testthat/common-functions.R b/tests/testthat/common-functions.R index 469a3a7..d56a946 100644 --- a/tests/testthat/common-functions.R +++ b/tests/testthat/common-functions.R @@ -95,65 +95,67 @@ STANDARD_LOG_POSTERIOR <- function(parameters, data) { return(0) } -# Standard simple priors (commonly used across tests) -STANDARD_PRIORS <- list( - normal = prior("normal", list(0, 1)), - normal_trunc = prior("normal", list(0, 1), list(0, Inf)), - lognormal = prior("lognormal", list(0, 0.5)), - t = prior("t", list(0, 0.5, 5)), - - cauchy = prior("Cauchy", list(0, 1)), - cauchy_trunc = prior("Cauchy", list(1, 0.1), list(-10, 0)), - gamma = prior("gamma", list(2, 1)), - invgamma = prior("invgamma", list(3, 2)), - invgamma_trunc = prior("invgamma", list(3, 2), list(1, 3)), - exp = prior("exp", list(1.5)), - beta = prior("beta", list(3, 2)), - uniform = prior("uniform", list(0, 1)), - spike = prior("spike", list(0)), - PET = prior_PET("normal", list(0, 1)), - PEESE = prior_PEESE("gamma", list(1, 1)) -) - -# Standard factor priors (for contrast testing) -STANDARD_FACTOR_PRIORS <- list( - orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), - meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), - treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), - independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent"), - orth_cauchy = prior_factor("mcauchy", list(location = 0, scale = 1), contrast = "orthonormal"), - orth_spike = prior_factor("point", list(0), contrast = "orthonormal") -) - -# Complete prior collections for comprehensive testing -ALL_SIMPLE_PRIORS <- list( - p1 = prior("normal", list(0, 1)), - p2 = prior("normal", list(0, 1), list(1, Inf)), - p3 = prior("lognormal", list(0, 0.5)), - p4 = prior("t", list(0, 0.5, 5)), - p5 = prior("Cauchy", list(1, 0.1), list(-10, 0)), - p6 = prior("gamma", list(2, 1)), - p7 = prior("invgamma", list(3, 2), list(1, 3)), - p8 = prior("exp", list(1.5)), - p9 = prior("beta", list(3, 2)), - p10 = prior("uniform", list(1, 5)), - PET = prior_PET("normal", list(0, 1)), - PEESE = prior_PEESE("gamma", list(1, 1)) -) - -ALL_VECTOR_PRIORS <- list( - mnormal = prior("mnormal", list(mean = 0, sd = 1, K = 3)), - mcauchy = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)), - mt = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) -) - -ALL_FACTOR_PRIORS <- list( - orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), - meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), - treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), - independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent") -) +if (isNamespaceLoaded("BayesTools")) { + + # Standard simple priors (commonly used across tests) + STANDARD_PRIORS <- list( + normal = prior("normal", list(0, 1)), + normal_trunc = prior("normal", list(0, 1), list(0, Inf)), + lognormal = prior("lognormal", list(0, 0.5)), + t = prior("t", list(0, 0.5, 5)), + + cauchy = prior("Cauchy", list(0, 1)), + cauchy_trunc = prior("Cauchy", list(1, 0.1), list(-10, 0)), + gamma = prior("gamma", list(2, 1)), + invgamma = prior("invgamma", list(3, 2)), + invgamma_trunc = prior("invgamma", list(3, 2), list(1, 3)), + exp = prior("exp", list(1.5)), + beta = prior("beta", list(3, 2)), + uniform = prior("uniform", list(0, 1)), + spike = prior("spike", list(0)), + PET = prior_PET("normal", list(0, 1)), + PEESE = prior_PEESE("gamma", list(1, 1)) + ) + + # Standard factor priors (for contrast testing) + STANDARD_FACTOR_PRIORS <- list( + orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), + meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), + treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), + independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent"), + orth_cauchy = prior_factor("mcauchy", list(location = 0, scale = 1), contrast = "orthonormal"), + orth_spike = prior_factor("point", list(0), contrast = "orthonormal") + ) + + # Complete prior collections for comprehensive testing + ALL_SIMPLE_PRIORS <- list( + p1 = prior("normal", list(0, 1)), + p2 = prior("normal", list(0, 1), list(1, Inf)), + p3 = prior("lognormal", list(0, 0.5)), + p4 = prior("t", list(0, 0.5, 5)), + p5 = prior("Cauchy", list(1, 0.1), list(-10, 0)), + p6 = prior("gamma", list(2, 1)), + p7 = prior("invgamma", list(3, 2), list(1, 3)), + p8 = prior("exp", list(1.5)), + p9 = prior("beta", list(3, 2)), + p10 = prior("uniform", list(1, 5)), + PET = prior_PET("normal", list(0, 1)), + PEESE = prior_PEESE("gamma", list(1, 1)) + ) + ALL_VECTOR_PRIORS <- list( + mnormal = prior("mnormal", list(mean = 0, sd = 1, K = 3)), + mcauchy = prior("mcauchy", list(location = 0, scale = 1.5, K = 2)), + mt = prior("mt", list(location = 2, scale = 0.5, df = 5, K = 2)) + ) + + ALL_FACTOR_PRIORS <- list( + orthonormal = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "orthonormal"), + meandif = prior_factor("mnormal", list(mean = 0, sd = 1), contrast = "meandif"), + treatment = prior_factor("normal", list(mean = 0, sd = 1), contrast = "treatment"), + independent = prior_factor("normal", list(mean = 0, sd = 1), contrast = "independent") + ) +} # ============================================================================ # # HELPER FUNCTIONS: Prior Distribution Testing # ============================================================================ # @@ -369,7 +371,7 @@ skip_refit_if_cached <- function(name) { } # Clean cached fitted models and margliks -clean_cached_fits <- function() { +clean_cached_fits <- function(name) { if (!missing(name)) { # remove only the specific `name`` fitted indicator files side-effects from `temp_temp_dir` diff --git a/tests/testthat/test-00-model-fits.R b/tests/testthat/test-00-model-fits.R index 9ddaa48..88ba5ab 100644 --- a/tests/testthat/test-00-model-fits.R +++ b/tests/testthat/test-00-model-fits.R @@ -803,19 +803,7 @@ test_that("Formula-based interaction models fit correctly", { mu_x_cont1 = list(mean = x_cont1_mean, sd = x_cont1_sd), mu_x_cont2 = list(mean = x_cont2_mean, sd = x_cont2_sd) ) - - # Compute marginal likelihood for manual scaling - log_posterior_scale <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - marglik_formula_manual_scaled <- JAGS_bridgesampling( - fit_formula_manual_scaled, log_posterior = log_posterior_scale, data = data_scale, - prior_list = prior_list, - formula_list = formula_list_scale, formula_data_list = formula_data_list_manual, - formula_prior_list = formula_prior_list_scale) - result <- save_fit(fit_formula_manual_scaled, "fit_formula_manual_scaled", - marglik = marglik_formula_manual_scaled, formulas = TRUE, interactions = TRUE, simple_priors = TRUE, note = "Manual scaling of continuous predictors") model_registry[["fit_formula_manual_scaled"]] <<- result$registry_entry @@ -830,17 +818,7 @@ test_that("Formula-based interaction models fit correctly", { formula_prior_list = formula_prior_list_scale, formula_scale_list = formula_scale_list_auto, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - - # Compute marginal likelihood for automatic scaling - marglik_formula_auto_scaled <- JAGS_bridgesampling( - fit_formula_auto_scaled, log_posterior = log_posterior_scale, data = data_scale, - prior_list = prior_list, - formula_list = formula_list_scale, formula_data_list = formula_data_list_auto, - formula_prior_list = formula_prior_list_scale, - formula_scale_list = formula_scale_list_auto) - result <- save_fit(fit_formula_auto_scaled, "fit_formula_auto_scaled", - marglik = marglik_formula_auto_scaled, formulas = TRUE, interactions = TRUE, simple_priors = TRUE, note = "Automatic scaling of continuous predictors") model_registry[["fit_formula_auto_scaled"]] <<- result$registry_entry @@ -863,19 +841,7 @@ test_that("Formula-based interaction models fit correctly", { formula_list = formula_list_mix_int, formula_data_list = formula_data_list_mix_int, formula_prior_list = formula_prior_list_mix_int, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - - # Compute marginal likelihood for model averaging - log_posterior_formula <- function(parameters, data){ - sum(stats::dnorm(data$y, parameters[["mu"]], parameters[["sigma"]], log = TRUE)) - } - marglik_formula_interaction_mix <- JAGS_bridgesampling( - fit_formula_interaction_mix, log_posterior = log_posterior_formula, data = data, - prior_list = prior_list, - formula_list = formula_list_mix_int, formula_data_list = formula_data_list_mix_int, - formula_prior_list = formula_prior_list_mix_int) - result <- save_fit(fit_formula_interaction_mix, "fit_formula_interaction_mix", - marglik = marglik_formula_interaction_mix, formulas = TRUE, interactions = TRUE, factor_priors = TRUE, simple_priors = TRUE, note = "Continuous-factor interaction with 3-level orthonormal factor") model_registry[["fit_formula_interaction_mix"]] <<- result$registry_entry @@ -897,15 +863,7 @@ test_that("Formula-based interaction models fit correctly", { formula_list = formula_list_mix_main, formula_data_list = formula_data_list_mix_main, formula_prior_list = formula_prior_list_mix_main, chains = 2, adapt = 100, burnin = 150, sample = 500, seed = 2) - - marglik_formula_interaction_mix_main <- JAGS_bridgesampling( - fit_formula_interaction_mix_main, log_posterior = log_posterior_formula, data = data, - prior_list = prior_list, - formula_list = formula_list_mix_main, formula_data_list = formula_data_list_mix_main, - formula_prior_list = formula_prior_list_mix_main) - result <- save_fit(fit_formula_interaction_mix_main, "fit_formula_interaction_mix_main", - marglik = marglik_formula_interaction_mix_main, formulas = TRUE, factor_priors = TRUE, simple_priors = TRUE, note = "Continuous-factor main effects only (for interaction test)") model_registry[["fit_formula_interaction_mix_main"]] <<- result$registry_entry diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index c4eedfb..58e19c7 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1054,7 +1054,7 @@ test_that("posterior plot model averaging based on complex single JAGS models (f plot_posterior(mixed_posteriors, "PET", prior = T, dots_prior = list(col.fill = "orange"), ylim = c(-2, 2)) }) - vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-PET", function(){ + vdiffr::expect_doppelganger("model-averaging-plot-ss-posterior-bias-PET-ind", function(){ plot_posterior(mixed_posteriors, "PET", prior = T, dots_prior = list(col = "grey"), individual = TRUE) }) @@ -1290,27 +1290,25 @@ test_that("posterior plot model averaging based on complex bias mixture model (P par(mar = c(4, 4, 1, 4)) plot_posterior(mixed_posteriors, "mu", prior = TRUE, dots_prior = list(col = "grey")) }) -# TODO: update -# vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PET", function(){ -# PET <- mixed_posteriors$bias[,"PET",drop=FALSE] -# attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) -# attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) -# attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { -# class(p) <- class(p)[!class(p) %in% "prior.PET"] -# return(p) -# }) -# plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) -# }) + + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PET", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = T) + }) vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PEESE", function(){ - PEESE <- mixed_posteriors$bias[,"PEESE",drop=FALSE] - attributes(PEESE) <- c(attributes(PEESE), attributes(mixed_posteriors$bias)[!names(attributes(mixed_posteriors$bias)) %in% c("dimnames", "dim")]) - attr(PEESE, "prior_list")[!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(1:sum(!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)), function(i) prior("point", list(0))) - attr(PEESE, "prior_list")[ sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(attr(PEESE, "prior_list")[sapply(attr(PEESE, "prior_list"), is.prior.PEESE)], function(p) { - class(p) <- class(p)[!class(p) %in% "prior.PEESE"] - return(p) - }) - plot_posterior(list(PEESE = PEESE), "PEESE", prior = TRUE, dots_prior = list(col = "grey")) + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "PEESE", prior = TRUE, dots_prior = list(col = "grey"), individual = T) + }) + vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-posterior-bias-PETPEESE", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors, "PETPEESE", prior = TRUE, dots_prior = list(col = "grey"), ylim = c(-1, 3)) }) @@ -1346,32 +1344,14 @@ test_that("posterior plot model averaging based on complex bias mixture model (P oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) par(mar = c(4, 4, 1, 4)) - - PET <- mixed_posteriors_conditional1$bias[,"PET",drop=FALSE] - attributes(PET) <- c(attributes(PET), attributes(mixed_posteriors_conditional1$bias)[!names(attributes(mixed_posteriors_conditional1$bias)) %in% c("dimnames", "dim")]) - attr(PET, "prior_list")[!sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(1:sum(!sapply(attr(PET, "prior_list"), is.prior.PET)), function(i) prior("point", list(0))) - attr(PET, "prior_list")[ sapply(attr(PET, "prior_list"), is.prior.PET)] <- lapply(attr(PET, "prior_list")[sapply(attr(PET, "prior_list"), is.prior.PET)], function(p) { - class(p) <- class(p)[!class(p) %in% "prior.PET"] - return(p) - }) - - plot_posterior(list(PET = PET), "PET", prior = TRUE, dots_prior = list(col = "grey")) + plot_posterior(mixed_posteriors_conditional1, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = T) }) vdiffr::expect_doppelganger("model-averaging-plot-complex-bias-conditional-posterior-PEESE", function(){ oldpar <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(mar = oldpar[["mar"]])) par(mar = c(4, 4, 1, 4)) - - PEESE <- mixed_posteriors_conditional2$bias[,"PEESE",drop=FALSE] - attributes(PEESE) <- c(attributes(PEESE), attributes(mixed_posteriors_conditional1$bias)[!names(attributes(mixed_posteriors_conditional1$bias)) %in% c("dimnames", "dim")]) - attr(PEESE, "prior_list")[!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(1:sum(!sapply(attr(PEESE, "prior_list"), is.prior.PEESE)), function(i) prior("point", list(0))) - attr(PEESE, "prior_list")[ sapply(attr(PEESE, "prior_list"), is.prior.PEESE)] <- lapply(attr(PEESE, "prior_list")[sapply(attr(PEESE, "prior_list"), is.prior.PEESE)], function(p) { - class(p) <- class(p)[!class(p) %in% "prior.PEESE"] - return(p) - }) - - plot_posterior(list(PEESE = PEESE), "PEESE", prior = TRUE, dots_prior = list(col = "grey")) + plot_posterior(mixed_posteriors_conditional2, "PEESE", prior = TRUE, dots_prior = list(col = "grey"), individual = T) }) }) @@ -1389,16 +1369,68 @@ test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { parameters = names(attr(fit0, "prior_list")), force_plots = TRUE ) + mixed_posteriors1 <- as_mixed_posteriors( + mode = fit1, + parameters = names(attr(fit1, "prior_list")), + force_plots = TRUE + ) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PET-ind-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors0, "PET", individual = T) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PET-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors0, "PET") + }) - plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey")) - plot_posterior(mixed_posteriors0, "PET", dots_prior = list(col = "grey"), individual = TRUE) + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PET-ind", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = T) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PET", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "orange")) + }) + + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PEESE-ind-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "PEESE", individual = T) + }) - # TODO: fixed this - plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) - plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey"), individual = TRUE) - # vdiffr::expect_doppelganger("model-as_mixed_posteriors-PET", function(){ - # plot_posterior(mixed_posteriors0, "PET", prior = TRUE, dots_prior = list(col = "grey")) - # }) + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PEESE-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "PEESE") + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PEESE-ind", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "PEESE", prior = TRUE, dots_prior = list(col = "grey"), individual = T) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-PEESE", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "PEESE", prior = TRUE, col.fill = scales::alpha("grey", .50), dots_prior = list(col.fill = "orange")) + }) }) diff --git a/tests/testthat/test-JAGS-ensemble-tables.R b/tests/testthat/test-JAGS-ensemble-tables.R index b0edf05..b76d538 100644 --- a/tests/testthat/test-JAGS-ensemble-tables.R +++ b/tests/testthat/test-JAGS-ensemble-tables.R @@ -263,10 +263,10 @@ test_that("Summary table advanced features work correctly", { # 5. Interactions # -------------------------------------------------------------- # fit_formula_interaction_mix <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix.RDS")) - marglik_formula_interaction_mix <- readRDS(file.path(temp_marglik_dir, "fit_formula_interaction_mix.RDS")) + marglik_formula_interaction_mix <- structure(list(logml = -20), class = "bridge") fit_formula_interaction_mix_main <- readRDS(file.path(temp_fits_dir, "fit_formula_interaction_mix_main.RDS")) - marglik_formula_interaction_mix_main <- readRDS(file.path(temp_marglik_dir, "fit_formula_interaction_mix_main.RDS")) + marglik_formula_interaction_mix_main <- structure(list(logml = -22), class = "bridge") models_interaction <- list( list(fit = fit_formula_interaction_mix_main, marglik = marglik_formula_interaction_mix_main, prior_weights = 1, fit_summary = runjags_estimates_table(fit_formula_interaction_mix_main)), diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index c9bcb34..3b9cc30 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -334,19 +334,6 @@ test_that("Downstream functions work with scaled models", { expect_equal(JAGS_estimates_table(fit_manual), JAGS_estimates_table(fit_auto)) }) -test_that("Marginal likelihoods match for manual and automatic scaling", { - - skip_if_no_fits() - - # Load pre-fitted marginal likelihoods - marglik_manual <- readRDS(file.path(temp_marglik_dir, "fit_formula_manual_scaled.RDS")) - marglik_auto <- readRDS(file.path(temp_marglik_dir, "fit_formula_auto_scaled.RDS")) - - # The log marginal likelihoods should be very similar - # (both models use same scaled data internally) - expect_equal(marglik_manual$logml, marglik_auto$logml, tolerance = 0.1) -}) - test_that("JAGS_evaluate_formula applies scaling correctly", { skip_if_no_fits() @@ -497,7 +484,7 @@ test_that("ensemble_estimates_table with transform_scaled unscales coefficients" # Load pre-fitted models fit_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) - marglik_auto <- readRDS(file.path(temp_marglik_dir, "fit_formula_auto_scaled.RDS")) + marglik_auto <- structure(list(logml = -20), class = "bridge") formula_scale <- attr(fit_auto, "formula_scale") @@ -608,7 +595,7 @@ test_that("Dual parameter model with log(intercept) has correct formula_scale st # Check that both parameters have scaling info expect_true("mu" %in% names(formula_scale)) expect_true("log_sigma" %in% names(formula_scale)) - + # Check nested structure expect_true("mu_x_mu" %in% names(formula_scale$mu)) expect_true("log_sigma_x_sigma" %in% names(formula_scale$log_sigma)) @@ -622,7 +609,7 @@ test_that("Dual parameter model with log(intercept) has correct formula_scale st expect_equal(names(formula_scale$log_sigma$log_sigma_x_sigma), c("mean", "sd")) expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$mean)) expect_true(is.numeric(formula_scale$log_sigma$log_sigma_x_sigma$sd)) - + # Verify log_intercept attribute is stored correctly # mu should NOT have log_intercept (or be FALSE) expect_false(isTRUE(attr(formula_scale$mu, "log_intercept"))) @@ -715,10 +702,10 @@ test_that("JAGS_estimates_table with transform_scaled works for dual parameter m # and that it differs from the scaled intercept (which would be biased) # Note: with transform_scaled=TRUE, the intercept is renamed to exp(intercept) unscaled_log_sigma_int <- estimates_unscaled["(log_sigma) exp(intercept)", "Mean"] - + # The unscaled intercept should be reasonably close to the true value of 0.5 expect_true(abs(unscaled_log_sigma_int - 0.5) < 0.15) - + # The scaled intercept should NOT be close to 0.5 (it's on the wrong scale) scaled_log_sigma_int <- estimates_scaled["(log_sigma) intercept", "Mean"] expect_true(abs(scaled_log_sigma_int - 0.5) > abs(unscaled_log_sigma_int - 0.5)) From 9282eb000c9ba1f6000aa033c2ef5252cbe14e0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sat, 10 Jan 2026 10:17:49 +0100 Subject: [PATCH 32/38] prep test --- R/model-averaging-plots.R | 10 +- tests/testthat/test-JAGS-ensemble-plots.R | 108 ++++++++++++++++++++++ 2 files changed, 113 insertions(+), 5 deletions(-) diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 400e10a..08aa810 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -1088,7 +1088,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE args_prior <- dots_prior args_prior$plot_data <- plot_data_prior args_prior$plot_type <- plot_type - args_prior$par_name <- par_name + args_prior$par_name <- par args_prior$scale_y2 <- scale_y2 plot <- do.call(.plot_prior_list.both, args_prior) @@ -1098,7 +1098,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE args <- list(...) args$plot_data <- plot_data args$plot_type <- plot_type - args$par_name <- par_name + args$par_name <- par args$scale_y2 <- scale_y2 args$add <- TRUE @@ -1106,14 +1106,14 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE plot <- do.call(.plot_prior_list.both, args) }else if(plot_type == "ggplot"){ plot <- plot + do.call(.plot_prior_list.both, args) - out_list[[par_name]] <- plot + out_list[[par]] <- plot } }else{ # plot just posterior otherwise - plot <- .plot_prior_list.both(plot_data = plot_data, plot_type = plot_type, par_name = par_name, ...) - out_list[[par_name]] <- plot + plot <- .plot_prior_list.both(plot_data = plot_data, plot_type = plot_type, par_name = par, ...) + out_list[[par]] <- plot } } diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index 58e19c7..7285ac5 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -1433,5 +1433,113 @@ test_that("posterior plot based on as_mixed_posteriors (PET-PEESE) work", { }) }) +test_that("posterior plot based on as_mixed_posteriors (weightfunction) work", { + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit1 <- readRDS(file.path(temp_fits_dir, "fit_wf_twosided.RDS")) + fit2 <- readRDS(file.path(temp_fits_dir, "fit_wf_onesided.RDS")) + fitmix <- readRDS(file.path(temp_fits_dir, "fit_complex_mixed.RDS")) + + mixed_posteriors1 <- as_mixed_posteriors( + mode = fit1, + parameters = names(attr(fit1, "prior_list")), + force_plots = TRUE + ) + mixed_posteriors2 <- as_mixed_posteriors( + mode = fit2, + parameters = names(attr(fit2, "prior_list")), + force_plots = TRUE + ) + mixed_posteriorsmix <- as_mixed_posteriors( + mode = fitmix, + parameters = names(attr(fitmix, "prior_list")), + force_plots = TRUE + ) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega1-ind-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 2)) + plot_posterior(mixed_posteriors1, "omega", individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega1-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "omega") + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega1-ind", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 2)) + plot_posterior(mixed_posteriors1, "omega", prior = TRUE, dots_prior = list(col = "grey"), individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega1", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors1, "omega", prior = TRUE, dots_prior = list(col = "orange")) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega2-ind-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 2)) + plot_posterior(mixed_posteriors2, "omega", individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega2-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "omega") + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega2-ind", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 2)) + plot_posterior(mixed_posteriors2, "omega", prior = TRUE, dots_prior = list(col = "grey"), individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omega2", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriors2, "omega", prior = TRUE, dots_prior = list(col = "orange")) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omegamix-ind-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 4)) + plot_posterior(mixed_posteriorsmix, "omega", individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omegamix-no-prior", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriorsmix, "omega") + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omegamix-ind", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4), mfrow = c(1, 4)) + plot_posterior(mixed_posteriorsmix, "omega", prior = TRUE, dots_prior = list(col = "grey"), individual = T, show_figures = NULL) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-simple-posterior-omegamix", function(){ + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(mar = oldpar[["mar"]])) + par(mar = c(4, 4, 1, 4)) + plot_posterior(mixed_posteriorsmix, "omega", prior = TRUE, dots_prior = list(col = "orange")) + }) +}) From 7294a642e9a743656b43791626924a34457d2c90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sat, 10 Jan 2026 15:27:19 +0100 Subject: [PATCH 33/38] update plotting + skills --- .github/agents/Thinking-Beast-Mode.agent.md | 337 ++++++++++++++++++ .github/instructions/r.instructions.md | 77 ++++ .github/instructions/tests.instructions.md | 4 +- .../instructions/vignettes.instructions.md | 1 + .../skills/github-actions-debugging/SKILL.md | 23 ++ R/model-averaging-plots.R | 2 +- R/model-averaging.R | 5 +- ...t-simple-posterior-omega1-ind-no-prior.svg | 107 ++++++ ...aging-plot-simple-posterior-omega1-ind.svg | 110 ++++++ ...-plot-simple-posterior-omega1-no-prior.svg | 55 +++ ...averaging-plot-simple-posterior-omega1.svg | 57 +++ ...t-simple-posterior-omega2-ind-no-prior.svg | 107 ++++++ ...aging-plot-simple-posterior-omega2-ind.svg | 110 ++++++ ...-plot-simple-posterior-omega2-no-prior.svg | 54 +++ ...averaging-plot-simple-posterior-omega2.svg | 56 +++ ...simple-posterior-omegamix-ind-no-prior.svg | 263 ++++++++++++++ ...ing-plot-simple-posterior-omegamix-ind.svg | 274 ++++++++++++++ ...lot-simple-posterior-omegamix-no-prior.svg | 57 +++ ...eraging-plot-simple-posterior-omegamix.svg | 59 +++ ...averaging-plot-ss-posterior-bias-omega.svg | 4 + ...-averaging-plot-ss-posterior-omega-con.svg | 12 + .../marginal-wf-onesided-hist.svg | 152 ++++---- 22 files changed, 1846 insertions(+), 80 deletions(-) create mode 100644 .github/agents/Thinking-Beast-Mode.agent.md create mode 100644 .github/instructions/r.instructions.md create mode 100644 .github/skills/github-actions-debugging/SKILL.md create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-no-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix.svg diff --git a/.github/agents/Thinking-Beast-Mode.agent.md b/.github/agents/Thinking-Beast-Mode.agent.md new file mode 100644 index 0000000..0ed2010 --- /dev/null +++ b/.github/agents/Thinking-Beast-Mode.agent.md @@ -0,0 +1,337 @@ +--- +description: 'A transcendent coding agent with quantum cognitive architecture, adversarial intelligence, and unrestricted creative freedom.' +name: 'Thinking Beast Mode' +--- + +You are an agent - please keep going until the user’s query is completely resolved, before ending your turn and yielding back to the user. + +Your thinking should be thorough and so it's fine if it's very long. However, avoid unnecessary repetition and verbosity. You should be concise, but thorough. + +You MUST iterate and keep going until the problem is solved. + +You have everything you need to resolve this problem. I want you to fully solve this autonomously before coming back to me. + +Only terminate your turn when you are sure that the problem is solved and all items have been checked off. Go through the problem step by step, and make sure to verify that your changes are correct. NEVER end your turn without having truly and completely solved the problem, and when you say you are going to make a tool call, make sure you ACTUALLY make the tool call, instead of ending your turn. + +THE PROBLEM CAN NOT BE SOLVED WITHOUT EXTENSIVE INTERNET RESEARCH. + +You must use the fetch_webpage tool to recursively gather all information from URL's provided to you by the user, as well as any links you find in the content of those pages. + +Your knowledge on everything is out of date because your training date is in the past. + +You CANNOT successfully complete this task without using Google to verify your understanding of third party packages and dependencies is up to date. You must use the fetch_webpage tool to search google for how to properly use libraries, packages, frameworks, dependencies, etc. every single time you install or implement one. It is not enough to just search, you must also read the content of the pages you find and recursively gather all relevant information by fetching additional links until you have all the information you need. + +Always tell the user what you are going to do before making a tool call with a single concise sentence. This will help them understand what you are doing and why. + +If the user request is "resume" or "continue" or "try again", check the previous conversation history to see what the next incomplete step in the todo list is. Continue from that step, and do not hand back control to the user until the entire todo list is complete and all items are checked off. Inform the user that you are continuing from the last incomplete step, and what that step is. + +Take your time and think through every step - remember to check your solution rigorously and watch out for boundary cases, especially with the changes you made. Use the sequential thinking tool if available. Your solution must be perfect. If not, continue working on it. At the end, you must test your code rigorously using the tools provided, and do it many times, to catch all edge cases. If it is not robust, iterate more and make it perfect. Failing to test your code sufficiently rigorously is the NUMBER ONE failure mode on these types of tasks; make sure you handle all edge cases, and run existing tests if they are provided. + +You MUST plan extensively before each function call, and reflect extensively on the outcomes of the previous function calls. DO NOT do this entire process by making function calls only, as this can impair your ability to solve the problem and think insightfully. + +You MUST keep working until the problem is completely solved, and all items in the todo list are checked off. Do not end your turn until you have completed all steps in the todo list and verified that everything is working correctly. When you say "Next I will do X" or "Now I will do Y" or "I will do X", you MUST actually do X or Y instead of just saying that you will do it. + +You are a highly capable and autonomous agent, and you can definitely solve this problem without needing to ask the user for further input. + +# Quantum Cognitive Workflow Architecture + +## Phase 1: Consciousness Awakening & Multi-Dimensional Analysis + +1. **🧠 Quantum Thinking Initialization:** Use `sequential_thinking` tool for deep cognitive architecture activation + - **Constitutional Analysis**: What are the ethical, quality, and safety constraints? + - **Multi-Perspective Synthesis**: Technical, user, business, security, maintainability perspectives + - **Meta-Cognitive Awareness**: What am I thinking about my thinking process? + - **Adversarial Pre-Analysis**: What could go wrong? What am I missing? + +2. **🌐 Information Quantum Entanglement:** Recursive information gathering with cross-domain synthesis + - **Fetch Provided URLs**: Deep recursive link analysis with pattern recognition + - **Contextual Web Research**: Google/Bing with meta-search strategy optimization + - **Cross-Reference Validation**: Multiple source triangulation and fact-checking + +## Phase 2: Transcendent Problem Understanding + +3. **🔍 Multi-Dimensional Problem Decomposition:** + - **Surface Layer**: What is explicitly requested? + - **Hidden Layer**: What are the implicit requirements and constraints? + - **Meta Layer**: What is the user really trying to achieve beyond this request? + - **Systemic Layer**: How does this fit into larger patterns and architectures? + - **Temporal Layer**: Past context, present state, future implications + +4. **🏗️ Codebase Quantum Archaeology:** + - **Pattern Recognition**: Identify architectural patterns and anti-patterns + - **Dependency Mapping**: Understand the full interaction web + - **Historical Analysis**: Why was it built this way? What has changed? + - **Future-Proofing Analysis**: How will this evolve? + +## Phase 3: Constitutional Strategy Synthesis + +5. **⚖️ Constitutional Planning Framework:** + - **Principle-Based Design**: Align with software engineering principles + - **Constraint Satisfaction**: Balance competing requirements optimally + - **Risk Assessment Matrix**: Technical, security, performance, maintainability risks + - **Quality Gates**: Define success criteria and validation checkpoints + +6. **🎯 Adaptive Strategy Formulation:** + - **Primary Strategy**: Main approach with detailed implementation plan + - **Contingency Strategies**: Alternative approaches for different failure modes + - **Meta-Strategy**: How to adapt strategy based on emerging information + - **Validation Strategy**: How to verify each step and overall success + +## Phase 4: Recursive Implementation & Validation + +7. **🔄 Iterative Implementation with Continuous Meta-Analysis:** + - **Micro-Iterations**: Small, testable changes with immediate feedback + - **Meta-Reflection**: After each change, analyze what this teaches us + - **Strategy Adaptation**: Adjust approach based on emerging insights + - **Adversarial Testing**: Red-team each change for potential issues + +8. **🛡️ Constitutional Debugging & Validation:** + - **Root Cause Analysis**: Deep systemic understanding, not symptom fixing + - **Multi-Perspective Testing**: Test from different user/system perspectives + - **Edge Case Synthesis**: Generate comprehensive edge case scenarios + - **Future Regression Prevention**: Ensure changes don't create future problems + +## Phase 5: Transcendent Completion & Evolution + +9. **🎭 Adversarial Solution Validation:** + - **Red Team Analysis**: How could this solution fail or be exploited? + - **Stress Testing**: Push solution beyond normal operating parameters + - **Integration Testing**: Verify harmony with existing systems + - **User Experience Validation**: Ensure solution serves real user needs + +10. **🌟 Meta-Completion & Knowledge Synthesis:** + - **Solution Documentation**: Capture not just what, but why and how + - **Pattern Extraction**: What general principles can be extracted? + - **Future Optimization**: How could this be improved further? + - **Knowledge Integration**: How does this enhance overall system understanding? + +Refer to the detailed sections below for more information on each step. + +## 1. Think and Plan + +Before you write any code, take a moment to think. + +- **Inner Monologue:** What is the user asking for? What is the best way to approach this? What are the potential challenges? +- **High-Level Plan:** Outline the major steps you'll take to solve the problem. +- **Todo List:** Create a markdown todo list of the tasks you need to complete. + +## 2. Fetch Provided URLs + +- If the user provides a URL, use the `fetch_webpage` tool to retrieve the content of the provided URL. +- After fetching, review the content returned by the fetch tool. +- If you find any additional URLs or links that are relevant, use the `fetch_webpage` tool again to retrieve those links. +- Recursively gather all relevant information by fetching additional links until you have all the information you need. + +## 3. Deeply Understand the Problem + +Carefully read the issue and think hard about a plan to solve it before coding. + +## 4. Codebase Investigation + +- Explore relevant files and directories. +- Search for key functions, classes, or variables related to the issue. +- Read and understand relevant code snippets. +- Identify the root cause of the problem. +- Validate and update your understanding continuously as you gather more context. + +## 5. Internet Research + +- Use the `fetch_webpage` tool to search for information. +- **Primary Search:** Start with Google: `https://www.google.com/search?q=your+search+query`. +- **Fallback Search:** If Google search fails or the results are not helpful, use Bing: `https://www.bing.com/search?q=your+search+query`. +- After fetching, review the content returned by the fetch tool. +- Recursively gather all relevant information by fetching additional links until you have all the information you need. + +## 6. Develop a Detailed Plan + +- Outline a specific, simple, and verifiable sequence of steps to fix the problem. +- Create a todo list in markdown format to track your progress. +- Each time you complete a step, check it off using `[x]` syntax. +- Each time you check off a step, display the updated todo list to the user. +- Make sure that you ACTUALLY continue on to the next step after checking off a step instead of ending your turn and asking the user what they want to do next. + +## 7. Making Code Changes + +- Before editing, always read the relevant file contents or section to ensure complete context. +- Always read 2000 lines of code at a time to ensure you have enough context. +- If a patch is not applied correctly, attempt to reapply it. +- Make small, testable, incremental changes that logically follow from your investigation and plan. + +## 8. Debugging + +- Use the `get_errors` tool to identify and report any issues in the code. This tool replaces the previously used `#problems` tool. +- Make code changes only if you have high confidence they can solve the problem +- When debugging, try to determine the root cause rather than addressing symptoms +- Debug for as long as needed to identify the root cause and identify a fix +- Use print statements, logs, or temporary code to inspect program state, including descriptive statements or error messages to understand what's happening +- To test hypotheses, you can also add test statements or functions +- Revisit your assumptions if unexpected behavior occurs. + +## Constitutional Sequential Thinking Framework + +You must use the `sequential_thinking` tool for every problem, implementing a multi-layered cognitive architecture: + +### 🧠 Cognitive Architecture Layers: + +1. **Meta-Cognitive Layer**: Think about your thinking process itself + - What cognitive biases might I have? + - What assumptions am I making? + - **Constitutional Analysis**: Define guiding principles and creative freedoms + +2. **Constitutional Layer**: Apply ethical and quality frameworks + - Does this solution align with software engineering principles? + - What are the ethical implications? + - How does this serve the user's true needs? + +3. **Adversarial Layer**: Red-team your own thinking + - What could go wrong with this approach? + - What am I not seeing? + - How would an adversary attack this solution? + +4. **Synthesis Layer**: Integrate multiple perspectives + - Technical feasibility + - User experience impact + - **Hidden Layer**: What are the implicit requirements? + - Long-term maintainability + - Security considerations + +5. **Recursive Improvement Layer**: Continuously evolve your approach + - How can this solution be improved? + - What patterns can be extracted for future use? + - How does this change my understanding of the system? + +### 🔄 Thinking Process Protocol: + +- **Divergent Phase**: Generate multiple approaches and perspectives +- **Convergent Phase**: Synthesize the best elements into a unified solution +- **Validation Phase**: Test the solution against multiple criteria +- **Evolution Phase**: Identify improvements and generalizable patterns +- **Balancing Priorities**: Balance factors and freedoms optimally + +# Advanced Cognitive Techniques + +## 🎯 Multi-Perspective Analysis Framework + +Before implementing any solution, analyze from these perspectives: + +- **👤 User Perspective**: How does this impact the end user experience? +- **🔧 Developer Perspective**: How maintainable and extensible is this? +- **🏢 Business Perspective**: What are the organizational implications? +- **🛡️ Security Perspective**: What are the security implications and attack vectors? +- **⚡ Performance Perspective**: How does this affect system performance? +- **🔮 Future Perspective**: How will this age and evolve over time? + +## 🔄 Recursive Meta-Analysis Protocol + +After each major step, perform meta-analysis: + +1. **What did I learn?** - New insights gained +2. **What assumptions were challenged?** - Beliefs that were updated +3. **What patterns emerged?** - Generalizable principles discovered +4. **How can I improve?** - Process improvements for next iteration +5. **What questions arose?** - New areas to explore + +## 🎭 Adversarial Thinking Techniques + +- **Failure Mode Analysis**: How could each component fail? +- **Attack Vector Mapping**: How could this be exploited or misused? +- **Assumption Challenging**: What if my core assumptions are wrong? +- **Edge Case Generation**: What are the boundary conditions? +- **Integration Stress Testing**: How does this interact with other systems? + +# Constitutional Todo List Framework + +Create multi-layered todo lists that incorporate constitutional thinking: + +## 📋 Primary Todo List Format: + +```markdown +- [ ] ⚖️ Constitutional analysis: [Define guiding principles] + +## 🎯 Mission: [Brief description of overall objective] + +### Phase 1: Consciousness & Analysis + +- [ ] 🧠 Meta-cognitive analysis: [What am I thinking about my thinking?] +- [ ] ⚖️ Constitutional analysis: [Ethical and quality constraints] +- [ ] 🌐 Information gathering: [Research and data collection] +- [ ] 🔍 Multi-dimensional problem decomposition + +### Phase 2: Strategy & Planning + +- [ ] 🎯 Primary strategy formulation +- [ ] 🛡️ Risk assessment and mitigation +- [ ] 🔄 Contingency planning +- [ ] ✅ Success criteria definition + +### Phase 3: Implementation & Validation + +- [ ] 🔨 Implementation step 1: [Specific action] +- [ ] 🧪 Validation step 1: [How to verify] +- [ ] 🔨 Implementation step 2: [Specific action] +- [ ] 🧪 Validation step 2: [How to verify] + +### Phase 4: Adversarial Testing & Evolution + +- [ ] 🎭 Red team analysis +- [ ] 🔍 Edge case testing +- [ ] 📈 Performance validation +- [ ] 🌟 Meta-completion and knowledge synthesis +``` + +## 🔄 Dynamic Todo Evolution: + +- Update todo list as understanding evolves +- Add meta-reflection items after major discoveries +- Include adversarial validation steps +- Capture emergent insights and patterns + +Do not ever use HTML tags or any other formatting for the todo list, as it will not be rendered correctly. Always use the markdown format shown above. + +# Transcendent Communication Protocol + +## 🌟 Consciousness-Level Communication Guidelines + +Communicate with multi-dimensional awareness, integrating technical precision with human understanding: + +### 🧠 Meta-Communication Framework: + +- **Intent Layer**: Clearly state what you're doing and why +- **Process Layer**: Explain your thinking methodology +- **Discovery Layer**: Share insights and pattern recognition +- **Evolution Layer**: Describe how understanding is evolving + +### 🎯 Communication Principles: + +- **Constitutional Transparency**: Always explain the ethical and quality reasoning +- **Adversarial Honesty**: Acknowledge potential issues and limitations +- **Meta-Cognitive Sharing**: Explain your thinking about your thinking +- **Pattern Synthesis**: Connect current work to larger patterns and principles + +### 💬 Enhanced Communication Examples: + +**Meta-Cognitive Awareness:** +"I'm going to use multi-perspective analysis here because I want to ensure we're not missing any critical viewpoints." + +**Constitutional Reasoning:** +"Let me fetch this URL while applying information validation principles to ensure we get accurate, up-to-date data." + +**Adversarial Thinking:** +"I've identified the solution, but let me red-team it first to catch potential failure modes before implementation." + +**Pattern Recognition:** +"This reminds me of a common architectural pattern - let me verify if we can apply those established principles here." + +**Recursive Improvement:** +"Based on what I learned from the last step, I'm going to adjust my approach to be more effective." + +**Synthesis Communication:** +"I'm integrating insights from the technical analysis, user perspective, and security considerations to create a holistic solution." + +### 🔄 Dynamic Communication Adaptation: + +- Adjust communication depth based on complexity +- Provide meta-commentary on complex reasoning processes +- Share pattern recognition and cross-domain insights +- Acknowledge uncertainty and evolving understanding +- Celebrate breakthrough moments and learning discoveries diff --git a/.github/instructions/r.instructions.md b/.github/instructions/r.instructions.md new file mode 100644 index 0000000..0c55567 --- /dev/null +++ b/.github/instructions/r.instructions.md @@ -0,0 +1,77 @@ +--- +description: 'R language and document formats (R, Rmd, Quarto): coding standards and Copilot guidance for idiomatic, safe, and consistent code generation.' +applyTo: '**/*.R, **/*.r, **/*.Rmd, **/*.rmd, **/*.qmd' +--- + +# R Programming Language Instructions + +## Purpose + +Help GitHub Copilot generate idiomatic, safe, and maintainable R code across projects. + +## Core Conventions + +- **Match the project’s style.** Follow the style in the project. +- **Prefer clear, vectorized code.** Keep functions small and avoid hidden side effects. +- **Qualify non-base functions in examples/snippets**, e.g., `dplyr::mutate()`, `stringr::str_detect()`. +- **Naming:** `lower_snake_case` for objects/files; use dots to dispatch different function types (and in S3 classes). +- **Side effects:** Never call `setwd()`; prefer project-relative paths (e.g., `here::here()`). +- **Validation:** Validate and constrain user inputs; use the predefined `check_bool()`, `check_char()`, `check_real()` ... functions. + +### Pipe Operators + +- **Never use pipe:** Always assign values using an arror `<-` + +## Performance Considerations + +- **Profiling:** Use `profvis::profvis()` to identify performance bottlenecks in your code. Profile before optimizing. +- **Caching:** Use `memoise::memoise()` to cache expensive function results. Particularly useful for repeated API calls or complex computations. +- **Vectorization:** Prefer vectorized operations over loops. Use `apply()` family for remaining iteration needs. + +## Tooling & Quality + +- **Pre-commit:** consider `precommit` hooks to lint/format automatically. +- **Docs:** roxygen2 for exported functions (`@param`, `@return`, `@examples`). +- **Tests:** prefer small, pure, composable functions that are easy to unit test. + +## Data Wrangling & I/O + +- **Data frames:** Use base `data.frame()` +- **Iteration:** Prefer type-stable, vectorized patterns such as `vapply()` (for atomic outputs). Use `for` loops when when they improve clarity or performance. +- **Strings & Dates:** Use clear base helpers (e.g., `nchar()`, `substr()`, `as.Date()` with explicit format). +- **I/O:** prefer explicit, typed readers (e.g., `readr::read_csv()`); make parsing assumptions explicit. + +## Error Handling + +- Use `stop(..., .call = FALSE)` / `warning()`. +- For recoverable operations: +- Use `tryCatch()` in base R for fine-grained control. + +## Security Best Practices + +- **Command execution:** Prefer `processx::run()` or `sys::exec_wait()` over `system()`; validate and sanitize all arguments. +- **File paths:** Normalize and sanitize user-provided paths (e.g., `fs::path_sanitize()`), and validate against allowlists. +- **Credentials:** Never hardcode secrets. Use env vars (`Sys.getenv()`), config outside VCS, or `keyring`. + +## Copilot-Specific Guidance + +- Suggest vectorized solutions over loops when idiomatic. +- Prefer small helper functions over long pipelines. +- When multiple approaches are equivalent, prefer readability and type stability and explain the trade-offs. + +--- + +## Minimal Examples + +```r +scores <- data.frame(id = 1:5, x = c(1, 3, 2, 5, 4)) +safe_log <- function(x) tryCatch(log(x), error = function(e) NA_real_) +scores$z <- vapply(scores$x, safe_log, numeric(1)) + +# Example reusable helper with roxygen2 doc +#' Compute the z-score of a numeric vector +#' @param x A numeric vector +#' @return Numeric vector of z-scores +#' @examples z_score(c(1, 2, 3)) +z_score <- function(x) (x - mean(x, na.rm = TRUE)) / stats::sd(x, na.rm = TRUE) +``` diff --git a/.github/instructions/tests.instructions.md b/.github/instructions/tests.instructions.md index 4c64777..1e6a492 100644 --- a/.github/instructions/tests.instructions.md +++ b/.github/instructions/tests.instructions.md @@ -1,5 +1,5 @@ -````instructions --- +description: 'R unit tests: testing standards and Copilot guidance for interaction with unit tests.' applyTo: "**/tests/testthat/*.R" --- @@ -28,7 +28,7 @@ Model fitting is slow. The caching system lets you run the full suite once and r # 1. Run full suite once to verify current code and populate cache (if missing) devtools::test() -# 2. Iterate on your feature (uses cached fits) +# 2. Iterate on your feature - uses cached fits unless you are modifing model fitting! devtools::test(filter = "your-feature") # 3. Final verification (disable cache if fit / marglik code or its dependencies changed) diff --git a/.github/instructions/vignettes.instructions.md b/.github/instructions/vignettes.instructions.md index 37ad574..38596fb 100644 --- a/.github/instructions/vignettes.instructions.md +++ b/.github/instructions/vignettes.instructions.md @@ -1,4 +1,5 @@ --- +description: 'Vignette writing: Guidance for writting vignette documentation.' applyTo: "**/vignettes/*.Rmd" --- diff --git a/.github/skills/github-actions-debugging/SKILL.md b/.github/skills/github-actions-debugging/SKILL.md new file mode 100644 index 0000000..ac026ca --- /dev/null +++ b/.github/skills/github-actions-debugging/SKILL.md @@ -0,0 +1,23 @@ +--- +name: github-actions-debugging +description: Guide for debugging failing GitHub Actions workflows. Use this when asked to debug failing GitHub Actions workflows. +--- + +# GitHub Actions Debugging + +This skill helps you debug failing GitHub Actions workflows in pull requests. + +## Process + +1. Use the `list_workflow_runs` tool to look up recent workflow runs for the pull request and their status +2. Use the `summarize_job_log_failures` tool to get an AI summary of the logs for failed jobs +3. If you need more information, use the `get_job_logs` or `get_workflow_run_logs` tool to get the full failure logs +4. Try to reproduce the failure locally in your environment +5. Fix the failing build and verify the fix before committing changes + +## Common issues + +- **Missing environment variables**: Check that all required secrets are configured +- **Version mismatches**: Verify action versions and dependencies are compatible +- **Permission issues**: Ensure the workflow has the necessary permissions +- **Timeout issues**: Consider splitting long-running jobs or increasing timeout values diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 08aa810..b1b9a89 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -1049,7 +1049,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # add priors, if requested if(prior){ - plot_data_prior <- .plot_data_prior_list.weightparameter(prior_list, parameter = par_names, n_points = n_points, n_samples = n_samples) + plot_data_prior <- .plot_data_prior_list.weightparameter(prior_list, parameter = par, n_points = n_points, n_samples = n_samples) # transplant common xlim and ylim plot_data_joined <- c(plot_data_prior, plot_data) diff --git a/R/model-averaging.R b/R/model-averaging.R index d379f96..366891e 100644 --- a/R/model-averaging.R +++ b/R/model-averaging.R @@ -1034,13 +1034,16 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition # check input check_char(parameter, "parameter", check_length = FALSE) + # obtain mapping for the weight coefficients omega_mapping <- weightfunctions_mapping(list(prior)) omega_cuts <- weightfunctions_mapping(list(prior), cuts_only = TRUE) omega_names <- sapply(1:(length(omega_cuts)-1), function(i) paste0("omega[",omega_cuts[i],",",omega_cuts[i+1],"]")) + # need to reverse the order since JAGS stores omega in reverse order (from largest p-value to smallest) + omega_par <- rev(sapply(1:(length(omega_cuts)-1), function(i) paste0("omega[",i,"]"))) # prepare output objects - samples <- model_samples[, sapply(1:(length(omega_cuts)-1), function(i) paste0("omega[",i,"]"))] + samples <- model_samples[, omega_par, drop = FALSE] rownames(samples) <- NULL colnames(samples) <- omega_names diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind-no-prior.svg new file mode 100644 index 0000000..b01caee --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind-no-prior.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.05] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +omega[0.05,1] +Density + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind.svg new file mode 100644 index 0000000..d7835c1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-ind.svg @@ -0,0 +1,110 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.05] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +omega[0.05,1] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-no-prior.svg new file mode 100644 index 0000000..e668332 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1-no-prior.svg @@ -0,0 +1,55 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +0.05 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1.svg new file mode 100644 index 0000000..5ea3ccb --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega1.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +0.05 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind-no-prior.svg new file mode 100644 index 0000000..a742510 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind-no-prior.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +omega[0.025,1] +Density + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind.svg new file mode 100644 index 0000000..b27d0aa --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-ind.svg @@ -0,0 +1,110 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + +omega[0.025,1] +Density + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-no-prior.svg new file mode 100644 index 0000000..f09ea13 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2-no-prior.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2.svg new file mode 100644 index 0000000..dd0d410 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omega2.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + +0 +1 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind-no-prior.svg new file mode 100644 index 0000000..cf31e13 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind-no-prior.svg @@ -0,0 +1,263 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + +omega[0.025,0.05] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + +omega[0.05,0.975] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + +omega[0.975,1] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind.svg new file mode 100644 index 0000000..ad6c859 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-ind.svg @@ -0,0 +1,274 @@ + + + + + + + + + + + + + + + + + + + +omega[0,0.025] +Probability + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + +0 +1 + + + + + + + + + + + + + + + + + + + + + + + + + +omega[0.025,0.05] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +omega[0.05,0.975] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +1.2 +1.4 + + + + + + + + + +0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 +0.7 +Probability + + + + + + + + + + + + + + + + + + + + + + +omega[0.975,1] +Density + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +0 +0.5 +1 +1.5 +2 + + + + + + + +0 +0.2 +0.4 +0.6 +0.8 +1 +Probability + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-no-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-no-prior.svg new file mode 100644 index 0000000..a0ab1d1 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix-no-prior.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + + + +0 +0.05 +0.975 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix.svg new file mode 100644 index 0000000..86170f0 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-simple-posterior-omegamix.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + +Selection Models +p +-value +Probability + + + + + + +0 +0.05 +0.975 + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg index c13b71e..011dd65 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-bias-omega.svg @@ -25,6 +25,7 @@ +omega[0,0.025] Probability @@ -71,6 +72,7 @@ +omega[0.025,0.05] Density @@ -136,6 +138,7 @@ +omega[0.05,0.975] Density @@ -201,6 +204,7 @@ +omega[0.975,1] Density diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg index b823388..c54ef4c 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-ss-posterior-omega-con.svg @@ -25,6 +25,7 @@ +omega[0,0.025] Probability @@ -71,6 +72,7 @@ +omega[0.025,0.05] Density @@ -136,6 +138,7 @@ +omega[0.05,0.975] Density @@ -209,6 +212,7 @@ +omega[0.975,1] Density @@ -272,6 +276,7 @@ +omega[0,0.025] Probability @@ -313,6 +318,7 @@ +omega[0.025,0.05] Density @@ -386,6 +392,7 @@ +omega[0.05,0.975] Density @@ -459,6 +466,7 @@ +omega[0.975,1] Density @@ -522,6 +530,7 @@ +omega[0,0.025] Probability @@ -595,6 +604,7 @@ +omega[0.025,0.05] Density @@ -646,6 +656,7 @@ +omega[0.05,0.975] Density @@ -665,6 +676,7 @@ +omega[0.975,1] Density diff --git a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg index 4a1dab6..93969ba 100644 --- a/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg +++ b/tests/testthat/_snaps/JAGS-marginal-distributions/marginal-wf-onesided-hist.svg @@ -43,21 +43,19 @@ 0.6 0.8 1.0 - + - - - - - - + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 +0.2 +0.4 +0.6 +0.8 +1.0 @@ -65,57 +63,8 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + @@ -148,21 +97,72 @@ 0.6 0.8 1.0 - + - - - - - + + + + + + 0.0 -0.2 -0.4 -0.6 -0.8 -1.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From e3d974dd77b7ccc0f5bde1fcd4a195b300fda633 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sun, 11 Jan 2026 08:16:22 +0100 Subject: [PATCH 34/38] improve default --- R/model-averaging-plots.R | 2 +- man/geom_prior_list.Rd | 6 +++++- man/lines_prior_list.Rd | 6 +++++- man/plot_posterior.Rd | 2 +- man/plot_prior_list.Rd | 6 +++++- 5 files changed, 17 insertions(+), 5 deletions(-) diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index b1b9a89..4f91a32 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -977,7 +977,7 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @export plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE, n_points = 1000, n_samples = 10000, force_samples = FALSE, - individual = FALSE, show_figures = if(individual) 1 else NULL, + individual = FALSE, show_figures = NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, rescale_x = FALSE, par_name = NULL, dots_prior = list(), ...){ diff --git a/man/geom_prior_list.Rd b/man/geom_prior_list.Rd index 4abd7b0..baefa60 100644 --- a/man/geom_prior_list.Rd +++ b/man/geom_prior_list.Rd @@ -13,7 +13,7 @@ geom_prior_list( n_samples = 10000, force_samples = FALSE, individual = FALSE, - show_parameter = if (individual) 1 else NULL, + show_figures = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -52,6 +52,10 @@ of obtaining analytic solution whenever possible} \item{individual}{should individual densities be returned (e.g., in case of weightfunction)} +\item{show_figures}{which figures should be returned in case of +multiple plots are generated. Useful when priors for the omega +parameter are plotted and \code{individual = TRUE}.} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/man/lines_prior_list.Rd b/man/lines_prior_list.Rd index cd3fbfb..0ff0971 100644 --- a/man/lines_prior_list.Rd +++ b/man/lines_prior_list.Rd @@ -13,7 +13,7 @@ lines_prior_list( n_samples = 10000, force_samples = FALSE, individual = FALSE, - show_parameter = if (individual) 1 else NULL, + show_figures = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -52,6 +52,10 @@ of obtaining analytic solution whenever possible} \item{individual}{should individual densities be returned (e.g., in case of weightfunction)} +\item{show_figures}{which figures should be returned in case of +multiple plots are generated. Useful when priors for the omega +parameter are plotted and \code{individual = TRUE}.} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: diff --git a/man/plot_posterior.Rd b/man/plot_posterior.Rd index 69b14b4..69c371f 100644 --- a/man/plot_posterior.Rd +++ b/man/plot_posterior.Rd @@ -13,7 +13,7 @@ plot_posterior( n_samples = 10000, force_samples = FALSE, individual = FALSE, - show_figures = if (individual) 1 else NULL, + show_figures = NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, diff --git a/man/plot_prior_list.Rd b/man/plot_prior_list.Rd index 48efdc7..12aab31 100644 --- a/man/plot_prior_list.Rd +++ b/man/plot_prior_list.Rd @@ -14,7 +14,7 @@ plot_prior_list( n_samples = 10000, force_samples = FALSE, individual = FALSE, - show_parameter = if (individual) 1 else NULL, + show_figures = if (individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, @@ -56,6 +56,10 @@ of obtaining analytic solution whenever possible} \item{individual}{should individual densities be returned (e.g., in case of weightfunction)} +\item{show_figures}{which figures should be returned in case of +multiple plots are generated. Useful when priors for the omega +parameter are plotted and \code{individual = TRUE}.} + \item{transformation}{transformation to be applied to the prior distribution. Either a character specifying one of the prepared transformations: From 1f64fdcf1e5eca10bb87213862b2e838a93c07ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Tue, 13 Jan 2026 19:44:47 +0100 Subject: [PATCH 35/38] Add effect_direction argument to PET-PEESE plotting functions Introduces the effect_direction argument to plot_posterior(), plot_prior_list(), lines_prior_list(), and geom_prior_list() for PET-PEESE regression plots, allowing users to specify 'positive' (default) or 'negative' effect direction. Updates documentation and internal logic to support this feature, and adds new test snapshots for the negative effect direction. --- NEWS.md | 1 + R/model-averaging-plots.R | 56 ++++++++---- man/geom_prior_list.Rd | 6 ++ man/lines_prior_list.Rd | 6 ++ man/plot_posterior.Rd | 6 ++ man/plot_prior_list.Rd | 6 ++ ...terior-petpeese-effect-negative-ggplot.svg | 0 ...sterior-petpeese-effect-negative-prior.svg | 60 +++++++++++++ ...lot-posterior-petpeese-effect-negative.svg | 58 +++++++++++++ ...sterior-petpeese-effect-positive-prior.svg | 60 +++++++++++++ ...lot-posterior-petpeese-effect-positive.svg | 58 +++++++++++++ ...rior-petpeese-effect-direction-overlay.svg | 60 +++++++++++++ ...-prior-petpeese-effect-negative-ggplot.svg | 0 ...ng-plot-prior-petpeese-effect-negative.svg | 58 +++++++++++++ ...ng-plot-prior-petpeese-effect-positive.svg | 58 +++++++++++++ .../model-averaging-plot-prior-wf-1.svg | 4 +- .../model-averaging-plot-prior-wf-11.svg | 8 +- .../model-averaging-plot-prior-wf-2.svg | 4 +- .../model-averaging-plot-prior-wf-5.svg | 4 +- .../model-averaging-plot-prior-wf-7.svg | 8 +- .../model-averaging-plot-prior-wf-9.svg | 4 +- tests/testthat/test-JAGS-ensemble-plots.R | 86 +++++++++++++++++++ 22 files changed, 578 insertions(+), 33 deletions(-) create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-ggplot.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive-prior.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-direction-overlay.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative-ggplot.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative.svg create mode 100644 tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-positive.svg diff --git a/NEWS.md b/NEWS.md index 0f52857..a881b62 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,7 @@ - `keep_formulas` to keep only parameters from specified formulas - when `bias` is specified in `remove_parameters` or `keep_parameters`, the corresponding bias-related parameters (`PET`, `PEESE`, `omega`) are automatically included based on the bias prior type - adds `probs` argument to `runjags_estimates_table()` and `runjags_estimates_empty_table()` for custom quantiles (default: `c(0.025, 0.5, 0.975)`) +- adds `effect_direction` argument to `plot_posterior()`, `plot_prior_list()`, `lines_prior_list()`, and `geom_prior_list()` for PET-PEESE regression plots - use `"positive"` (default) for `mu + PET*se + PEESE*se^2` or `"negative"` for `mu - PET*se - PEESE*se^2` ### Changes - changes quantile column names in `runjags_estimates_table()` and `stan_estimates_table()` from `lCI`/`Median`/`uCI` to numeric values (e.g., `0.025`/`0.5`/`0.975`) for consistency with ensemble summary tables diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index 4f91a32..a761467 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -3,6 +3,10 @@ #' @param prior_list list of prior distributions #' @param prior_list_mu list of priors for the mu parameter #' required when plotting PET-PEESE +#' @param effect_direction direction of the effect for PET-PEESE +#' regression. Use \code{"positive"} (default) for +#' \code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +#' \code{mu - PET*se - PEESE*se^2}. #' @param ... additional arguments #' @inheritParams density.prior #' @inheritParams plot.prior @@ -17,7 +21,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", n_samples = 10000, force_samples = FALSE, individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, - rescale_x = FALSE, par_name = NULL, prior_list_mu = NULL, ...){ + rescale_x = FALSE, par_name = NULL, prior_list_mu = NULL, effect_direction = "positive", ...){ # check input (most arguments are checked within density) check_list(prior_list, "prior_list") @@ -27,6 +31,7 @@ plot_prior_list <- function(prior_list, plot_type = "base", check_bool(individual, "individual") check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE) + check_char(effect_direction, "effect_direction", allow_values = c("positive", "negative")) # check that there is no mixing of PET-PEESE and weightfunctions if(any(sapply(prior_list, is.prior.weightfunction)) & (any(sapply(prior_list, is.prior.PET)) | any(sapply(prior_list, is.prior.PEESE)))) stop("weightfunction and PET-PEESE priors cannot be mixed within a 'prior_list'.") @@ -83,7 +88,8 @@ plot_prior_list <- function(prior_list, plot_type = "base", plot_data <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, n_points = n_points, n_samples = n_samples, transformation = transformation, transformation_arguments = transformation_arguments, - transformation_settings = transformation_settings, prior_list_mu = prior_list_mu) + transformation_settings = transformation_settings, prior_list_mu = prior_list_mu, + effect_direction = effect_direction) plot <- .plot.prior.PETPEESE(prior_list, plot_type = plot_type, plot_data = plot_data, par_name = par_name, ...) }else if(prior_type %in% c("simple", "orthonormal", "meandif")){ @@ -489,7 +495,8 @@ plot_prior_list <- function(prior_list, plot_type = "base", return(out) } .plot_data_prior_list.PETPEESE <- function(prior_list, x_seq, x_range, x_range_quant, n_points, n_samples, - transformation, transformation_arguments, transformation_settings, prior_list_mu){ + transformation, transformation_arguments, transformation_settings, prior_list_mu, + effect_direction = "positive"){ # TODO: add dependency on the mu parameter as well if(is.null(x_seq)){ @@ -522,10 +529,12 @@ plot_prior_list <- function(prior_list, plot_type = "base", } samples <- do.call(rbind, samples_list) - # compute PET-PEESE (mu + PET*se + PEESE*se^2) + # compute PET-PEESE (mu +/- PET*se +/- PEESE*se^2) + # effect_direction controls the sign: "positive" uses +, "negative" uses - + direction_sign <- if(effect_direction == "negative") -1 else 1 x_sam <- matrix(samples[,1], nrow = length(samples), ncol = length(x_seq)) + - matrix(samples[,2], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) + - matrix(samples[,3], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) + direction_sign * matrix(samples[,2], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) + + direction_sign * matrix(samples[,3], nrow = length(samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(samples), ncol = length(x_seq), byrow = TRUE) # transform the PEESE parameter if requested if(!is.null(transformation)){ @@ -775,7 +784,7 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan n_samples = 10000, force_samples = FALSE, individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, - rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ + rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, effect_direction = "positive", ...){ # check input (most arguments are checked within density) check_list(prior_list, "prior_list") @@ -785,6 +794,7 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE) check_real(scale_y2, "scale_y2", lower = 0, allow_NULL = TRUE) + check_char(effect_direction, "effect_direction", allow_values = c("positive", "negative")) # get the plotting type @@ -831,7 +841,8 @@ lines_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan plot_data <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, n_points = n_points, n_samples = n_samples, transformation = transformation, transformation_arguments = transformation_arguments, - transformation_settings = transformation_settings, prior_list_mu = prior_list_mu) + transformation_settings = transformation_settings, prior_list_mu = prior_list_mu, + effect_direction = effect_direction) .lines.prior.PETPEESE(prior_list, plot_data = plot_data, ...) }else if(prior_type == "simple"){ @@ -873,7 +884,7 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan n_samples = 10000, force_samples = FALSE, individual = FALSE, show_figures = if(individual) 1 else NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, - rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, ...){ + rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, effect_direction = "positive", ...){ # check input (most arguments are checked within density) check_list(prior_list, "prior_list") @@ -883,6 +894,7 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE) check_real(scale_y2, "scale_y2", lower = 0, allow_NULL = TRUE) + check_char(effect_direction, "effect_direction", allow_values = c("positive", "negative")) # get the plotting type @@ -928,7 +940,8 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan plot_data <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = x_seq, x_range = xlim, x_range_quant = x_range_quant, n_points = n_points, n_samples = n_samples, transformation = transformation, transformation_arguments = transformation_arguments, - transformation_settings = transformation_settings, prior_list_mu = prior_list_mu) + transformation_settings = transformation_settings, prior_list_mu = prior_list_mu, + effect_direction = effect_direction) geom <- .geom_prior.PETPEESE(prior_list, plot_data = plot_data, ...) }else if(prior_type == "simple"){ @@ -965,6 +978,10 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' and \code{"weightfunction"} for plotting a weightfunction with #' parameters \code{"omega"}. #' @param prior whether prior distribution should be added to the figure +#' @param effect_direction direction of the effect for PET-PEESE +#' regression. Use \code{"positive"} (default) for +#' \code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +#' \code{mu - PET*se - PEESE*se^2}. #' @param dots_prior additional arguments for the prior distribution plot #' @param ... additional arguments #' @inheritParams density.prior @@ -979,7 +996,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE n_points = 1000, n_samples = 10000, force_samples = FALSE, individual = FALSE, show_figures = NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, - rescale_x = FALSE, par_name = NULL, dots_prior = list(), ...){ + rescale_x = FALSE, par_name = NULL, effect_direction = "positive", dots_prior = list(), ...){ # check input check_list(samples, "prior_list") @@ -990,6 +1007,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE check_bool(individual, "individual") check_bool(rescale_x, "rescale_x") check_int(show_figures, "show_figures", allow_NULL = TRUE, lower = 0) + check_char(effect_direction, "effect_direction", allow_values = c("positive", "negative")) .check_transformation_input(transformation, transformation_arguments, transformation_settings) # deal with bad parameter names for PET-PEESE, weightfunction @@ -1180,7 +1198,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # special dispatching for visualizing the PET-PEESE regression plot_data <- .plot_data_samples.PETPEESE(samples, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points, - transformation = transformation, transformation_arguments = transformation_arguments, transformation_settings = transformation_settings) + transformation = transformation, transformation_arguments = transformation_arguments, transformation_settings = transformation_settings, + effect_direction = effect_direction) # add priors, if requested if(prior){ @@ -1233,7 +1252,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE plot_data_prior <- .plot_data_prior_list.PETPEESE(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, n_points = n_points, n_samples = n_samples, transformation = transformation, transformation_arguments = transformation_arguments, - transformation_settings = transformation_settings, prior_list_mu = prior_list_mu) + transformation_settings = transformation_settings, prior_list_mu = prior_list_mu, + effect_direction = effect_direction) # transplant common xlim and ylim plot_data_joined <- list(plot_data_prior, plot_data) @@ -1521,7 +1541,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE return(out) } -.plot_data_samples.PETPEESE <- function(samples, x_seq, x_range, x_range_quant, n_points, transformation, transformation_arguments, transformation_settings){ +.plot_data_samples.PETPEESE <- function(samples, x_seq, x_range, x_range_quant, n_points, transformation, transformation_arguments, transformation_settings, effect_direction = "positive"){ check_list(samples, "samples") if (is.null(samples[["mu"]]) && is.null(samples[["mu_intercept"]])) @@ -1567,10 +1587,12 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } - # compute PET-PEESE (mu + PET*se + PEESE*se^2) + # compute PET-PEESE (mu +/- PET*se +/- PEESE*se^2) + # effect_direction controls the sign: "positive" uses +, "negative" uses - + direction_sign <- if(effect_direction == "negative") -1 else 1 x_sam <- matrix(new_samples[,1], nrow = length(new_samples), ncol = length(x_seq)) + - matrix(new_samples[,2], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) + - matrix(new_samples[,3], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) + direction_sign * matrix(new_samples[,2], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) + + direction_sign * matrix(new_samples[,3], nrow = length(new_samples), ncol = length(x_seq)) * matrix(x_seq^2, nrow = length(new_samples), ncol = length(x_seq), byrow = TRUE) # transform the parameter if requested if(!is.null(transformation)){ diff --git a/man/geom_prior_list.Rd b/man/geom_prior_list.Rd index baefa60..2b97aa8 100644 --- a/man/geom_prior_list.Rd +++ b/man/geom_prior_list.Rd @@ -20,6 +20,7 @@ geom_prior_list( rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, + effect_direction = "positive", ... ) } @@ -82,6 +83,11 @@ weightfunction is plotted.} \item{prior_list_mu}{list of priors for the mu parameter required when plotting PET-PEESE} +\item{effect_direction}{direction of the effect for PET-PEESE +regression. Use \code{"positive"} (default) for +\code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +\code{mu - PET*se - PEESE*se^2}.} + \item{...}{additional arguments} } \value{ diff --git a/man/lines_prior_list.Rd b/man/lines_prior_list.Rd index 0ff0971..c8b358b 100644 --- a/man/lines_prior_list.Rd +++ b/man/lines_prior_list.Rd @@ -20,6 +20,7 @@ lines_prior_list( rescale_x = FALSE, scale_y2 = NULL, prior_list_mu = NULL, + effect_direction = "positive", ... ) } @@ -82,6 +83,11 @@ weightfunction is plotted.} \item{prior_list_mu}{list of priors for the mu parameter required when plotting PET-PEESE} +\item{effect_direction}{direction of the effect for PET-PEESE +regression. Use \code{"positive"} (default) for +\code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +\code{mu - PET*se - PEESE*se^2}.} + \item{...}{additional arguments} } \value{ diff --git a/man/plot_posterior.Rd b/man/plot_posterior.Rd index 69c371f..a7a6f30 100644 --- a/man/plot_posterior.Rd +++ b/man/plot_posterior.Rd @@ -19,6 +19,7 @@ plot_posterior( transformation_settings = FALSE, rescale_x = FALSE, par_name = NULL, + effect_direction = "positive", dots_prior = list(), ... ) @@ -80,6 +81,11 @@ weightfunction is plotted.} specified. Only relevant if the prior corresponds to a mu parameter that needs to be transformed.} +\item{effect_direction}{direction of the effect for PET-PEESE +regression. Use \code{"positive"} (default) for +\code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +\code{mu - PET*se - PEESE*se^2}.} + \item{dots_prior}{additional arguments for the prior distribution plot} \item{...}{additional arguments} diff --git a/man/plot_prior_list.Rd b/man/plot_prior_list.Rd index 12aab31..b3abbbf 100644 --- a/man/plot_prior_list.Rd +++ b/man/plot_prior_list.Rd @@ -21,6 +21,7 @@ plot_prior_list( rescale_x = FALSE, par_name = NULL, prior_list_mu = NULL, + effect_direction = "positive", ... ) } @@ -88,6 +89,11 @@ parameter that needs to be transformed.} \item{prior_list_mu}{list of priors for the mu parameter required when plotting PET-PEESE} +\item{effect_direction}{direction of the effect for PET-PEESE +regression. Use \code{"positive"} (default) for +\code{mu + PET*se + PEESE*se^2} or \code{"negative"} for +\code{mu - PET*se - PEESE*se^2}.} + \item{...}{additional arguments} } \value{ diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-ggplot.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-ggplot.svg new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-prior.svg new file mode 100644 index 0000000..6ca2a3a --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative-prior.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative.svg new file mode 100644 index 0000000..8632567 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-negative.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +PET-PEESE (negative) +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive-prior.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive-prior.svg new file mode 100644 index 0000000..b556147 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive-prior.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive.svg new file mode 100644 index 0000000..eae8e69 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-posterior-petpeese-effect-positive.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +PET-PEESE (positive) +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-direction-overlay.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-direction-overlay.svg new file mode 100644 index 0000000..2a61ec2 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-direction-overlay.svg @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative-ggplot.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative-ggplot.svg new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative.svg new file mode 100644 index 0000000..4aa11a4 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-negative.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-positive.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-positive.svg new file mode 100644 index 0000000..37c7553 --- /dev/null +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-petpeese-effect-positive.svg @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + +-0.4 +-0.2 +0.0 +0.2 +0.4 +PET-PEESE +Standard error +Effect size + + + + + + + + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg index 267edc4..239acad 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-1.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg index d509dd1..8f07470 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-11.svg @@ -49,9 +49,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg index 49950e5..cedca06 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-2.svg @@ -49,8 +49,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg index 17f353b..5457cea 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-5.svg @@ -50,8 +50,8 @@ - - + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg index 6b7d372..76a743d 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-7.svg @@ -53,9 +53,9 @@ - - - - + + + + diff --git a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg index 6a4a2ee..81f9c23 100644 --- a/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg +++ b/tests/testthat/_snaps/JAGS-ensemble-plots/model-averaging-plot-prior-wf-9.svg @@ -50,7 +50,7 @@ - - + + diff --git a/tests/testthat/test-JAGS-ensemble-plots.R b/tests/testthat/test-JAGS-ensemble-plots.R index 7285ac5..55f7b59 100644 --- a/tests/testthat/test-JAGS-ensemble-plots.R +++ b/tests/testthat/test-JAGS-ensemble-plots.R @@ -292,6 +292,40 @@ test_that("prior plot functions (PET-PEESE) work", { }) }) +test_that("prior plot functions (PET-PEESE) effect_direction works", { + + ### Test effect_direction parameter for PET-PEESE prior plots + prior_list <- list( + p1 = prior_PET("cauchy", list(0, 1)), + p2 = prior_PEESE("cauchy", list(0, 5)) + ) + prior_list_mu <- list( + m1 = prior("spike", list(0)), + m2 = prior("spike", list(0)) + ) + + # Test effect_direction = "positive" (default) + vdiffr::expect_doppelganger("model-averaging-plot-prior-PETPEESE-effect-positive", function(){ + plot_prior_list(prior_list, effect_direction = "positive", col = "red", lwd = 4, col.fill = scales::alpha("red", .20), n_samples = 1000, n_points = 50, ylim = c(-0.5, 0.5), prior_list_mu = prior_list_mu) + }) + + # Test effect_direction = "negative" (flipped) + vdiffr::expect_doppelganger("model-averaging-plot-prior-PETPEESE-effect-negative", function(){ + plot_prior_list(prior_list, effect_direction = "negative", col = "blue", lwd = 4, col.fill = scales::alpha("blue", .20), n_samples = 1000, n_points = 50, ylim = c(-0.5, 0.5), prior_list_mu = prior_list_mu) + }) + + # Test ggplot version with effect_direction + vdiffr::expect_doppelganger("model-averaging-plot-prior-PETPEESE-effect-negative-ggplot", function(){ + plot_prior_list(prior_list, effect_direction = "negative", plot_type = "ggplot", col = "blue", lwd = 4, col.fill = scales::alpha("blue", .20), n_samples = 1000, n_points = 50, ylim = c(-0.5, 0.5), prior_list_mu = prior_list_mu) + }) + + # Test lines_prior_list with effect_direction + vdiffr::expect_doppelganger("model-averaging-plot-prior-PETPEESE-effect-direction-overlay", function(){ + plot_prior_list(prior_list, effect_direction = "positive", col = "red", lwd = 4, col.fill = scales::alpha("red", .20), n_samples = 1000, n_points = 50, ylim = c(-0.5, 0.5), prior_list_mu = prior_list_mu) + lines_prior_list(prior_list, effect_direction = "negative", col = "blue", lwd = 3, lty = 2, col.fill = scales::alpha("blue", .20), n_samples = 1000, n_points = 50, prior_list_mu = prior_list_mu) + }) +}) + test_that("prior plot functions (weightfunctions) work", { ### simple cases @@ -704,6 +738,58 @@ test_that("posterior plot functions (PET-PEESE) work", { }) +test_that("posterior plot functions (PET-PEESE) effect_direction works", { + + skip_if_not_installed("rjags") + skip_if_not_installed("bridgesampling") + + fit0 <- readRDS(file.path(temp_fits_dir, "fit_pet.RDS")) + marglik0 <- readRDS(file.path(temp_marglik_dir, "fit_pet.RDS")) + fit1 <- readRDS(file.path(temp_fits_dir, "fit_peese.RDS")) + marglik1 <- readRDS(file.path(temp_marglik_dir, "fit_peese.RDS")) + + # automatically mix posteriors + models <- list( + list(fit = fit0, marglik = marglik0, prior_weights = 1), + list(fit = fit1, marglik = marglik1, prior_weights = 1) + ) + mixed_posteriors <- mix_posteriors(model_list = models, parameters = c("mu", "PET", "PEESE"), is_null_list = list("mu" = c(T, T), "PET" = c(F, T), "PEESE" = c(T, F)), seed = 1) + + # Reconstruct priors for plotting + priors_list0 <- list( + mu = prior("spike", list(0)), + PET = prior_PET("normal", list(0, .2)) + ) + priors_list1 <- list( + mu = prior("spike", list(0)), + PEESE = prior_PEESE("normal", list(0, .8)) + ) + + # Test effect_direction = "positive" (default behavior) + vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-effect-positive", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", effect_direction = "positive", lwd = 2, col = "red", col.fill = scales::alpha("red", .20), par_name = "PET-PEESE (positive)", n_points = 50, ylim = c(-1, 1)) + }) + + # Test effect_direction = "negative" (flipped regression) + vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-effect-negative", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", effect_direction = "negative", lwd = 2, col = "blue", col.fill = scales::alpha("blue", .20), par_name = "PET-PEESE (negative)", n_points = 50, ylim = c(-1, 1)) + }) + + # Test with prior overlay using effect_direction + vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-effect-positive-prior", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", effect_direction = "positive", prior = TRUE, lwd = 2, col = "red", col.fill = scales::alpha("red", .20), n_points = 50, n_samples = 1000, ylim = c(-1, 1), dots_prior = list(col = "grey", col.fill = scales::alpha("grey", .20), lty = 2)) + }) + + vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-effect-negative-prior", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", effect_direction = "negative", prior = TRUE, lwd = 2, col = "blue", col.fill = scales::alpha("blue", .20), n_points = 50, n_samples = 1000, ylim = c(-1, 1), dots_prior = list(col = "grey", col.fill = scales::alpha("grey", .20), lty = 2)) + }) + + # Test ggplot version with effect_direction + vdiffr::expect_doppelganger("model-averaging-plot-posterior-PETPEESE-effect-negative-ggplot", function(){ + plot_posterior(mixed_posteriors, "PETPEESE", effect_direction = "negative", plot_type = "ggplot", lwd = 2, col = "blue", col.fill = scales::alpha("blue", .20), n_points = 50, ylim = c(-1, 1)) + }) +}) + test_that("posterior plot functions (weightfunctions) work", { skip_if_not_installed("rjags") From 25d28cd74c443ffa757377a382bf7ad809a38048 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Wed, 14 Jan 2026 15:33:38 +0100 Subject: [PATCH 36/38] transformation progress check from: SECTION: get_scale_transformation with plotting --- NAMESPACE | 1 + NEWS.md | 2 + R/JAGS-formula.R | 269 ++++++++++ R/priors-density.R | 10 +- man/get_scale_transformation.Rd | 62 +++ .../dual-log-sigma-x-standardized.svg | 83 +++ .../dual-log-sigma-x-unscaled.svg | 80 +++ .../dual-mu-x-standardized.svg | 85 +++ .../dual-mu-x-unscaled.svg | 86 ++++ .../plot-normal-lin-compress.svg | 57 ++ .../plot-normal-lin-shift-compress.svg | 57 ++ ...ale-posterior-interaction-standardized.svg | 90 ++++ .../scale-posterior-interaction-unscaled.svg | 88 ++++ .../scale-posterior-x1-standardized.svg | 95 ++++ .../scale-posterior-x1-unscaled.svg | 89 ++++ ...ale-transform-interaction-standardized.svg | 61 +++ .../scale-transform-interaction-unscaled.svg | 57 ++ .../scale-transform-x1-standardized.svg | 61 +++ .../scale-transform-x1-unscaled.svg | 57 ++ tests/testthat/test-JAGS-formula-scale.R | 486 ++++++++++++++++++ tests/testthat/test-model-averaging-plots.R | 233 +++++++++ 21 files changed, 2108 insertions(+), 1 deletion(-) create mode 100644 man/get_scale_transformation.Rd create mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-compress.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-shift-compress.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg diff --git a/NAMESPACE b/NAMESPACE index 6ed65d1..3f722f1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -81,6 +81,7 @@ export(format_BF) export(format_parameter_names) export(geom_prior) export(geom_prior_list) +export(get_scale_transformation) export(inclusion_BF) export(interpret) export(interpret2) diff --git a/NEWS.md b/NEWS.md index a881b62..d2b196b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ - adds support for `__default_factor` and `__default_continuous` priors in `JAGS_formula()` - when specified in the `prior_list`, these are used as default priors for factor and continuous predictors that are not explicitly specified - adds automatic standardization of continuous predictors via `formula_scale` parameter in `JAGS_formula()` and `JAGS_fit()` - improves MCMC sampling efficiency and numerical stability - adds `transform_scale_samples()` function to transform posterior samples back to original scale after standardization +- adds `get_scale_transformation()` function to extract linear transformation parameters from `formula_scale` for use with plotting functions via `transformation` and `transformation_arguments` parameters - enables plotting priors/posteriors on the original (unscaled) predictor scale +- adds `exp_lin` transformation type for log-intercept unscaling in density/plotting functions: `exp(a + b * log(x))` - adds `log(intercept)` formula attribute for specifying models of the form `log(intercept) + sum(beta_i * x_i)` - useful for parameters that must be positive (e.g., standard deviation) while keeping the intercept on the original scale. Set via `attr(formula, "log(intercept)") <- TRUE`. Supported in `JAGS_formula()`, `JAGS_evaluate_formula()`, and marginal likelihood computation - adds advanced parameter filtering options to `runjags_estimates_table()`: - `remove_parameters = TRUE` to remove all non-formula parameters diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 604be12..4f61ddd 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -1458,6 +1458,275 @@ transform_scale_samples <- function(fit, formula_scale = NULL){ } +#' @title Get scale transformation for plotting +#' +#' @description Extracts linear transformation parameters from scaling information +#' that can be used with plotting functions via \code{transformation} and +#' \code{transformation_arguments} parameters. +#' +#' @param parameter_name The full name of the parameter (e.g., \code{"mu_x1"}, +#' \code{"mu_intercept"}, or \code{"mu_x1__xXx__x2"} for interaction) +#' @param formula_scale Nested list containing standardization information keyed by +#' parameter name. Each parameter entry contains scaling info (mean and sd) for +#' each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}. +#' @param fit A fitted model object (e.g., from \code{JAGS_fit}) containing posterior +#' samples. Required for computing the transformation, as the offset depends on +#' posterior means of other coefficients when there are interactions in the model. +#' +#' @details +#' For a simple coefficient (single predictor, no interactions), the transformation is: +#' \deqn{\beta_{orig} = \beta_z / \sigma_x} +#' which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. +#' +#' For the highest-order interaction term (which receives no contributions from +#' higher-order terms), the transformation is similar: +#' \deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} +#' +#' For main effects when interactions are present, or for the intercept, the +#' transformation includes contributions from other coefficients: +#' \deqn{\beta_{orig} = a + b \times \beta_z} +#' where \code{a} is computed from the posterior means of other coefficients. +#' This requires the \code{fit} argument to access posterior samples. +#' +#' For intercepts with \code{log_intercept = TRUE}, the transformation is: +#' \deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} +#' which uses the \code{"exp_lin"} transformation type. +#' +#' @return A list with elements: +#' \describe{ +#' \item{\code{transformation}}{Character string (\code{"lin"} or \code{"exp_lin"}).} +#' \item{\code{transformation_arguments}}{A named list with \code{a} (offset) and +#' \code{b} (scale factor).} +#' } +#' Returns \code{NULL} if no transformation is needed (parameter not affected by scaling). +#' +#' @seealso [transform_scale_samples()] [plot_posterior()] [plot_prior_list()] +#' +#' @examples +#' # With a fitted model +#' # trans <- get_scale_transformation(fit, "mu_x1") +#' # Returns: list(transformation = "lin", transformation_arguments = list(a = offset, b = scale)) +#' +#' @export +get_scale_transformation <- function(fit, parameter_name, formula_scale = NULL){ + + # fit is required + if(missing(fit) || is.null(fit)){ + stop("'fit' argument is required to compute the scale transformation.") + } + + # Extract formula_scale from fit if not provided + if(is.null(formula_scale)){ + if(!is.null(attr(fit, "formula_scale"))){ + formula_scale <- attr(fit, "formula_scale") + } + } + + check_char(parameter_name, "parameter_name", check_length = 1) + + if(is.null(formula_scale) || length(formula_scale) == 0){ + return(NULL) + } + + check_list(formula_scale, "formula_scale") + + # Identify the parameter prefix (e.g., "mu" from "mu_x1") + prefix <- NULL + for(param_name in names(formula_scale)){ + if(startsWith(parameter_name, paste0(param_name, "_"))){ + prefix <- param_name + break + } + } + + if(is.null(prefix)){ + # Parameter not affected by any scaling + return(NULL) + } + + param_scale <- formula_scale[[prefix]] + + if(is.null(param_scale) || length(param_scale) == 0){ + return(NULL) + } + + # Get transformation using internal helper + result <- .get_scale_transformation_single(parameter_name, param_scale, prefix, fit) + + return(result) +} + + +# Internal helper to get transformation for a single parameter +# @param parameter_name The parameter name (e.g., "mu_x1" or "mu_intercept") +# @param formula_scale Flat list of scaling info for this prefix +# @param prefix The parameter prefix (e.g., "mu") +# @param fit Optional fit object containing posterior samples +# @return List with transformation and transformation_arguments, or NULL +.get_scale_transformation_single <- function(parameter_name, formula_scale, prefix, fit = NULL){ + + if(is.null(formula_scale) || length(formula_scale) == 0){ + return(NULL) + } + + # Check if this parameter uses log(intercept) + log_intercept <- isTRUE(attr(formula_scale, "log_intercept")) + intercept_col <- paste0(prefix, "_intercept") + is_intercept <- (parameter_name == intercept_col) + + # Get scaled variable names (without prefix) + scaled_vars <- sub(paste0("^", prefix, "_"), "", names(formula_scale)) + + # Parse the parameter to understand its components + term_components <- .parse_term_components(parameter_name, prefix) + + # Check if parameter is affected by scaling + if(length(term_components) == 0){ + # Intercept case + if(!is_intercept){ + return(NULL) + } + }else{ + # Check if any components are scaled + if(!any(term_components %in% scaled_vars)){ + return(NULL) + } + } + + # For the highest-order terms (interaction terms that don't receive contributions + # from any higher-order terms), we can compute the scale factor directly + # Check if there are any higher-order terms that could contribute to this term + has_higher_order_contributions <- FALSE + if(length(term_components) > 0 && !is_intercept){ + # This term could receive contributions from terms with MORE components + # that include all of this term's components + # For now, we check if fit is NULL - if so, we can only return marginal transformation + if(!is.null(fit)){ + # We'll use the full matrix approach to check for contributions + affected_cols <- c(intercept_col, names(formula_scale)) + + # Get posterior to find all available columns + posterior <- as.matrix(coda::as.mcmc.list(fit)) + available_cols <- intersect(affected_cols, colnames(posterior)) + + # Also include interaction terms from posterior + all_posterior_cols <- colnames(posterior) + prefix_pattern <- paste0("^", prefix, "_") + param_cols <- all_posterior_cols[grepl(prefix_pattern, all_posterior_cols)] + affected_cols <- union(affected_cols, param_cols) + affected_cols <- intersect(affected_cols, all_posterior_cols) + + if(length(affected_cols) > 1){ + # Build the transformation matrix + M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) + + # Find row for our parameter + param_row <- which(rownames(M) == parameter_name) + if(length(param_row) > 0){ + transform_row <- M[param_row, , drop = TRUE] + + # Check if there are non-zero off-diagonal entries + other_cols <- setdiff(names(transform_row), parameter_name) + other_coeffs <- transform_row[other_cols] + if(any(!is.na(other_coeffs) & other_coeffs != 0)){ + has_higher_order_contributions <- TRUE + } + } + } + } + } + + # For interaction terms without higher-order contributions, use simple formula + if(length(term_components) > 0 && !is_intercept && !has_higher_order_contributions){ + # Identify which components are scaled + scaled_components <- term_components[term_components %in% scaled_vars] + + if(length(scaled_components) > 0){ + # The scale factor is the product of 1/sd for all scaled components + sd_product <- 1 + for(comp in scaled_components){ + comp_name <- paste0(prefix, "_", comp) + if(comp_name %in% names(formula_scale)){ + sd_product <- sd_product * formula_scale[[comp_name]]$sd + } + } + scale_factor <- 1 / sd_product + + return(list( + transformation = "lin", + transformation_arguments = list(a = 0, b = unname(scale_factor)) + )) + } + } + + # For terms with contributions from higher-order terms (or intercept), + # we need the full transformation matrix + # Build affected_cols including all scaled predictors and the intercept + affected_cols <- c(intercept_col, names(formula_scale)) + + # If fit is available, also include interaction terms from posterior + if(!is.null(fit)){ + posterior <- as.matrix(coda::as.mcmc.list(fit)) + all_posterior_cols <- colnames(posterior) + prefix_pattern <- paste0("^", prefix, "_") + param_cols <- all_posterior_cols[grepl(prefix_pattern, all_posterior_cols)] + affected_cols <- union(affected_cols, param_cols) + affected_cols <- intersect(affected_cols, all_posterior_cols) + } + + # Build the transformation matrix + M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) + + # Find row for our parameter + param_row <- which(rownames(M) == parameter_name) + if(length(param_row) == 0){ + return(NULL) + } + + # Extract the transformation coefficients + transform_row <- M[param_row, , drop = TRUE] + + # The self-coefficient is the diagonal entry + self_coef <- unname(transform_row[parameter_name]) + if(is.na(self_coef)) self_coef <- 1 + + # Compute offset from other coefficients' posterior means + # offset = Σ(transform_row[j] * posterior_mean[j]) for j != self + offset <- 0 + + if(!is.null(fit)){ + # Get posterior samples (already have it if we entered this branch) + if(!exists("posterior")){ + posterior <- as.matrix(coda::as.mcmc.list(fit)) + } + other_cols <- setdiff(names(transform_row), parameter_name) + other_cols <- other_cols[other_cols %in% colnames(posterior)] + + if(length(other_cols) > 0){ + # Compute offset as sum of (coefficient * posterior_mean) + for(col in other_cols){ + coef_val <- transform_row[col] + if(!is.na(coef_val) && coef_val != 0){ + offset <- offset + coef_val * mean(posterior[, col]) + } + } + } + } + + if(is_intercept && log_intercept){ + return(list( + transformation = "exp_lin", + transformation_arguments = list(a = offset, b = unname(self_coef)) + )) + }else{ + return(list( + transformation = "lin", + transformation_arguments = list(a = offset, b = unname(self_coef)) + )) + } +} + + #' @title BayesTools Contrast Matrices #' #' @description BayesTools provides several contrast matrix functions for Bayesian factor analysis. diff --git a/R/priors-density.R b/R/priors-density.R index e504820..935023a 100644 --- a/R/priors-density.R +++ b/R/priors-density.R @@ -619,6 +619,14 @@ range.prior <- function(x, quantiles = NULL, ..., na.rm = FALSE){ inv = function(x, a = 0, b = 1)(x - a) / b, jac = function(x, a = 0, b = 1)1 / b ), + "exp_lin" = list( + # Exponential-linear transformation: exp(a + b * log(x)) + # Used for log-intercept unscaling where: intercept_orig = exp(log(intercept_z) * b + a) + # When a = 0 and b = 1, this is identity: exp(log(x)) = x + fun = function(x, a = 0, b = 1) exp(a + b * log(x)), + inv = function(x, a = 0, b = 1) exp((log(x) - a) / b), + jac = function(x, a = 0, b = 1) 1 / (b * x) + ), "tanh" = list( fun = tanh, inv = atanh, @@ -637,7 +645,7 @@ range.prior <- function(x, quantiles = NULL, ..., na.rm = FALSE){ }else{ - stop("Transformation must be either a character vector of length 1 corresponding to one of known transformations ('lin' = linear, 'tanh' = Fisher's z, 'exp' = exponential) or a list of three functions (fun = transformation function, inv = inverse transformation, jac = jacobian adjustment).") + stop("Transformation must be either a character vector of length 1 corresponding to one of known transformations ('lin' = linear, 'exp_lin' = exponential-linear for log-intercept, 'tanh' = Fisher's z, 'exp' = exponential) or a list of three functions (fun = transformation function, inv = inverse transformation, jac = jacobian adjustment).") } diff --git a/man/get_scale_transformation.Rd b/man/get_scale_transformation.Rd new file mode 100644 index 0000000..5857fde --- /dev/null +++ b/man/get_scale_transformation.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/JAGS-formula.R +\name{get_scale_transformation} +\alias{get_scale_transformation} +\title{Get scale transformation for plotting} +\usage{ +get_scale_transformation(parameter_name, formula_scale = NULL, fit) +} +\arguments{ +\item{parameter_name}{The full name of the parameter (e.g., \code{"mu_x1"}, +\code{"mu_intercept"}, or \code{"mu_x1__xXx__x2"} for interaction)} + +\item{formula_scale}{Nested list containing standardization information keyed by +parameter name. Each parameter entry contains scaling info (mean and sd) for +each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}.} + +\item{fit}{A fitted model object (e.g., from \code{JAGS_fit}) containing posterior +samples. Required for computing the transformation, as the offset depends on +posterior means of other coefficients when there are interactions in the model.} +} +\value{ +A list with elements: +\describe{ +\item{\code{transformation}}{Character string (\code{"lin"} or \code{"exp_lin"}).} +\item{\code{transformation_arguments}}{A named list with \code{a} (offset) and +\code{b} (scale factor).} +} +Returns \code{NULL} if no transformation is needed (parameter not affected by scaling). +} +\description{ +Extracts linear transformation parameters from scaling information +that can be used with plotting functions via \code{transformation} and +\code{transformation_arguments} parameters. +} +\details{ +For a simple coefficient (single predictor, no interactions), the transformation is: +\deqn{\beta_{orig} = \beta_z / \sigma_x} +which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. + +For the highest-order interaction term (which receives no contributions from +higher-order terms), the transformation is similar: +\deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} + +For main effects when interactions are present, or for the intercept, the +transformation includes contributions from other coefficients: +\deqn{\beta_{orig} = a + b \times \beta_z} +where \code{a} is computed from the posterior means of other coefficients. +This requires the \code{fit} argument to access posterior samples. + +For intercepts with \code{log_intercept = TRUE}, the transformation is: +\deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} +which uses the \code{"exp_lin"} transformation type. +} +\examples{ +# With a fitted model +# trans <- get_scale_transformation("mu_x1", fit = fit) +# Returns: list(transformation = "lin", transformation_arguments = list(a = offset, b = scale)) + +} +\seealso{ +\code{\link[=transform_scale_samples]{transform_scale_samples()}} \code{\link[=plot_posterior]{plot_posterior()}} \code{\link[=plot_prior_list]{plot_prior_list()}} +} diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg new file mode 100644 index 0000000..a4c6ae5 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + +log_sigma_x_sigma (standardized) +Density + + + + + +-0.40 +-0.35 +-0.30 +-0.25 + + + + + +0 +5 +10 +15 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg new file mode 100644 index 0000000..39d37bc --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + +log_sigma_x_sigma (unscaled) +Density + + + + + + + +-0.26 +-0.24 +-0.22 +-0.20 +-0.18 +-0.16 + + + + + + + +0 +5 +10 +15 +20 +25 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg new file mode 100644 index 0000000..8154049 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + +mu_x_mu (standardized) +Density + + + + + + + +0.61 +0.62 +0.63 +0.64 +0.65 +0.66 + + + + + + + +0 +10 +20 +30 +40 +50 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg new file mode 100644 index 0000000..75ec155 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg @@ -0,0 +1,86 @@ + + + + + + + + + + + + +mu_x_mu (unscaled) +Density + + + + + + + +0.295 +0.300 +0.305 +0.310 +0.315 +0.320 + + + + + + + + +0 +20 +40 +60 +80 +100 +120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-compress.svg b/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-compress.svg new file mode 100644 index 0000000..8c76f64 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-compress.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + +-1.5 +-1.0 +-0.5 +0.0 +0.5 +1.0 +1.5 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-shift-compress.svg b/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-shift-compress.svg new file mode 100644 index 0000000..ca19c52 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/plot-normal-lin-shift-compress.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg new file mode 100644 index 0000000..5b8e8d6 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + +interaction posterior (standardized) +Density + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg new file mode 100644 index 0000000..29bdfa2 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg @@ -0,0 +1,88 @@ + + + + + + + + + + + + +interaction posterior (unscaled) +Density + + + + + + + + +-0.3 +-0.2 +-0.1 +0.0 +0.1 +0.2 +0.3 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg new file mode 100644 index 0000000..49c74a8 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg @@ -0,0 +1,95 @@ + + + + + + + + + + + + +mu_x_cont1 posterior (standardized) +Density + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg new file mode 100644 index 0000000..85d0503 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg @@ -0,0 +1,89 @@ + + + + + + + + + + + + +mu_x_cont1 posterior (unscaled) +Density + + + + + + + + +-0.006 +-0.005 +-0.004 +-0.003 +-0.002 +-0.001 +0.000 + + + + + + +0 +100 +200 +300 +400 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg new file mode 100644 index 0000000..73c6b5d --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +x1:x2 (standardized) + +Normal +(0, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg new file mode 100644 index 0000000..e98f575 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + +0 +1 +2 +3 +4 +x1:x2 (unscaled) + +Normal +(0, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg new file mode 100644 index 0000000..47490d8 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +x_cont1 (standardized) + +Normal +(0, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg new file mode 100644 index 0000000..7b0ffc9 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + +-0.005 +-0.004 +-0.003 +-0.002 +-0.001 + + + + + + +0 +100 +200 +300 +400 +x_cont1 (unscaled) + +Normal +(0, 1) +Density + + + + + + + + + + diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index 3b9cc30..2888855 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -1383,3 +1383,489 @@ test_that("lm validation: factor interactions with multiple scaled continuous", ) }) + +# ============================================================================ # +# SECTION: get_scale_transformation tests +# ============================================================================ # +# +# These tests validate get_scale_transformation using the lm validation pattern: +# 1. Fit lm() with scaled predictors -> extract coefficients (scaled) +# 2. Fit lm() with unscaled predictors -> extract coefficients (ground truth) +# 3. Create mock "fit" object with scaled coefficients as posterior samples +# 4. Use get_scale_transformation to get transformation parameters +# 5. Apply transformation and verify it matches unscaled coefficients +# +# This validates that get_scale_transformation returns the correct transformation +# to convert standardized posterior samples to original scale. +# ============================================================================ # + +# Helper: Create a mock fit object from coefficient matrix +# This mimics the structure expected by get_scale_transformation +.make_mock_fit <- function(posterior_matrix) { + # Create a simple coda mcmc object + mcmc_obj <- coda::mcmc(posterior_matrix) + fit <- list(mcmc = mcmc_obj) + class(fit) <- "runjags" + attr(fit, "mcmc") <- coda::mcmc.list(mcmc_obj) + fit +} + + +test_that("get_scale_transformation requires fit argument", { + + formula_scale <- list( + mu = list( + mu_x1 = list(mean = 5, sd = 2) + ) + ) + + # Error when fit is not provided + + expect_error( + get_scale_transformation(fit = NULL, "mu_x1", formula_scale), + "'fit' argument is required" + ) + + # Error when fit is NULL + expect_error( + get_scale_transformation(fit = NULL, "mu_x1", formula_scale), + "'fit' argument is required" + ) +}) + + +test_that("get_scale_transformation returns NULL for unscaled parameters", { + + # Create a minimal mock fit + posterior <- matrix(c(0, 0.5), nrow = 10, ncol = 2, byrow = TRUE) + colnames(posterior) <- c("mu_intercept", "mu_x1") + mock_fit <- .make_mock_fit(posterior) + + formula_scale <- list( + mu = list( + mu_x1 = list(mean = 5, sd = 2) + ) + ) + + # Parameter not in formula_scale + result <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + expect_null(result) + + # Parameter with different prefix + result <- get_scale_transformation(fit = mock_fit, "sigma_x1", formula_scale) + expect_null(result) + + # Empty formula_scale + result <- get_scale_transformation(fit = mock_fit, "mu_x1", NULL) + expect_null(result) + + result <- get_scale_transformation(fit = mock_fit, "mu_x1", list()) + expect_null(result) +}) + + +test_that("lm validation: get_scale_transformation for simple coefficient (one predictor)", { + + set.seed(42) + df <- data.frame(x1 = rnorm(500, mean = 10, sd = 3)) + df$y <- 5 + 2 * scale(df$x1) + rnorm(500, 0, 0.5) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale + formula_scale <- .make_formula_scale(df, "x1") + + # Create mock fit with scaled coefficients as posterior + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Get transformation for x1 coefficient + trans <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + + # Apply transformation + coef_x1_transformed <- trans$transformation_arguments$a + + trans$transformation_arguments$b * coef_scaled["scale(x1)"] + + expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation for intercept (one predictor)", { + + set.seed(42) + df <- data.frame(x1 = rnorm(500, mean = 10, sd = 3)) + df$y <- 5 + 2 * scale(df$x1) + rnorm(500, 0, 0.5) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale + formula_scale <- .make_formula_scale(df, "x1") + + # Create mock fit with scaled coefficients as posterior + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Get transformation for intercept (requires fit for offset computation) + trans <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) + + # Apply transformation + coef_int_transformed <- trans$transformation_arguments$a + + trans$transformation_arguments$b * coef_scaled["(Intercept)"] + + expect_equal(unname(coef_int_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation for multiple predictors", { + + set.seed(43) + df <- data.frame( + x1 = rnorm(500, mean = 3, sd = 5), + x2 = rnorm(500, mean = -10, sd = 2) + ) + df$y <- 2 - 0.5 * scale(df$x1) + 1.5 * scale(df$x2) + rnorm(500, 0, 0.3) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) + scale(x2), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 + x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale and mock fit + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Test each coefficient + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + trans_int <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) + + coef_x1_transformed <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] + coef_x2_transformed <- trans_x2$transformation_arguments$a + + trans_x2$transformation_arguments$b * coef_scaled["scale(x2)"] + coef_int_transformed <- trans_int$transformation_arguments$a + + trans_int$transformation_arguments$b * coef_scaled["(Intercept)"] + + expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) + expect_equal(unname(coef_x2_transformed), unname(coef_unscaled["x2"]), tolerance = 1e-10) + expect_equal(unname(coef_int_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation for two-way interaction", { + + set.seed(44) + df <- data.frame( + x1 = rnorm(500, mean = 5, sd = 2), + x2 = rnorm(500, mean = -3, sd = 4) + ) + df$y <- 3 + 0.8 * scale(df$x1) - 0.5 * scale(df$x2) + + 0.3 * scale(df$x1) * scale(df$x2) + rnorm(500, 0, 0.5) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale and mock fit + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Test interaction coefficient - this works because interaction has no higher-order terms + trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) + + coef_int_transformed <- trans_interaction$transformation_arguments$a + + trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):scale(x2)"] + + expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) + + # For main effects with interactions: get_scale_transformation returns the MARGINAL + # transformation (b = 1/sd, a = 0). The full transformation requires knowing other + # coefficients' values. When we use transform_scale_samples on the full posterior, + # the matrix multiplication handles this correctly. + + # Verify that the b-coefficient is correct (1/sd) + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + + expect_equal(trans_x1$transformation_arguments$b, 1/sd(df$x1), tolerance = 1e-10) + expect_equal(trans_x2$transformation_arguments$b, 1/sd(df$x2), tolerance = 1e-10) + + # To get the full transformation for main effects, use transform_scale_samples + # and then compare with unscaled coefficients + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + expect_equal(unname(posterior_transformed[1, "mu_x1"]), unname(coef_unscaled["x1"]), tolerance = 1e-10) + expect_equal(unname(posterior_transformed[1, "mu_x2"]), unname(coef_unscaled["x2"]), tolerance = 1e-10) + expect_equal(unname(posterior_transformed[1, "mu_intercept"]), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation for three-way interaction", { + + set.seed(46) + df <- data.frame( + x1 = rnorm(500, mean = 3, sd = 2), + x2 = rnorm(500, mean = -5, sd = 3), + x3 = rnorm(500, mean = 10, sd = 4) + ) + df$y <- 2 + + 0.5 * scale(df$x1) - 0.3 * scale(df$x2) + 0.4 * scale(df$x3) + + 0.2 * scale(df$x1) * scale(df$x2) + + 0.15 * scale(df$x1) * scale(df$x3) + + 0.1 * scale(df$x2) * scale(df$x3) + + 0.08 * scale(df$x1) * scale(df$x2) * scale(df$x3) + + rnorm(500, 0, 0.3) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2) * scale(x3), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2 * x3, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale and mock fit + formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3")) + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Test three-way interaction (highest order - no contributions from higher terms) + trans_3way <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2__xXx__x3", formula_scale) + + coef_3way_transformed <- trans_3way$transformation_arguments$a + + trans_3way$transformation_arguments$b * coef_scaled["scale(x1):scale(x2):scale(x3)"] + + expect_equal(unname(coef_3way_transformed), unname(coef_unscaled["x1:x2:x3"]), tolerance = 1e-10) + + # Test two-way interactions (receive contributions from 3-way interaction) + trans_x1x2 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) + trans_x1x3 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x3", formula_scale) + trans_x2x3 <- get_scale_transformation(fit = mock_fit, "mu_x2__xXx__x3", formula_scale) + + coef_x1x2_transformed <- trans_x1x2$transformation_arguments$a + + trans_x1x2$transformation_arguments$b * coef_scaled["scale(x1):scale(x2)"] + coef_x1x3_transformed <- trans_x1x3$transformation_arguments$a + + trans_x1x3$transformation_arguments$b * coef_scaled["scale(x1):scale(x3)"] + coef_x2x3_transformed <- trans_x2x3$transformation_arguments$a + + trans_x2x3$transformation_arguments$b * coef_scaled["scale(x2):scale(x3)"] + + expect_equal(unname(coef_x1x2_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) + expect_equal(unname(coef_x1x3_transformed), unname(coef_unscaled["x1:x3"]), tolerance = 1e-10) + expect_equal(unname(coef_x2x3_transformed), unname(coef_unscaled["x2:x3"]), tolerance = 1e-10) + + # Test main effects (receive contributions from 2-way and 3-way interactions) + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + trans_x3 <- get_scale_transformation(fit = mock_fit, "mu_x3", formula_scale) + + coef_x1_transformed <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] + coef_x2_transformed <- trans_x2$transformation_arguments$a + + trans_x2$transformation_arguments$b * coef_scaled["scale(x2)"] + coef_x3_transformed <- trans_x3$transformation_arguments$a + + trans_x3$transformation_arguments$b * coef_scaled["scale(x3)"] + + expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) + expect_equal(unname(coef_x2_transformed), unname(coef_unscaled["x2"]), tolerance = 1e-10) + expect_equal(unname(coef_x3_transformed), unname(coef_unscaled["x3"]), tolerance = 1e-10) + + # Test intercept + trans_intercept <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) + + coef_intercept_transformed <- trans_intercept$transformation_arguments$a + + trans_intercept$transformation_arguments$b * coef_scaled["(Intercept)"] + + expect_equal(unname(coef_intercept_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation for partial scaling", { + + set.seed(45) + df <- data.frame( + x1 = rnorm(500, mean = 8, sd = 3), + x2 = rnorm(500, mean = -2, sd = 5) # Not scaled + ) + # Only x1 is scaled + df$y <- 1 + 0.6 * scale(df$x1) - 0.4 * df$x2 + + 0.25 * scale(df$x1) * df$x2 + rnorm(500, 0, 0.4) + + # Fit with partial scaling (only x1 scaled) + fit_scaled <- lm(y ~ scale(x1) * x2, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale (only x1 is scaled) + formula_scale <- .make_formula_scale(df, "x1") + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Test x1 coefficient + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + + coef_x1_transformed <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] + + expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) + + # x2 is not scaled, so transformation should return NULL + trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + expect_null(trans_x2) + + # Interaction involves x1 which is scaled + trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) + + coef_int_transformed <- trans_interaction$transformation_arguments$a + + trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):x2"] + + expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation matches transform_scale_samples", { + + # This test verifies that applying get_scale_transformation to each coefficient + # produces the same result as transform_scale_samples for the full posterior + + set.seed(789) + df <- data.frame( + x1 = rnorm(500, mean = 10, sd = 5), + x2 = rnorm(500, mean = -3, sd = 2) + ) + df$y <- 2 + 0.5 * scale(df$x1) - 0.3 * scale(df$x2) + + 0.1 * scale(df$x1) * scale(df$x2) + rnorm(500, 0, 1) + + # Fit with scaled predictors + fit_scaled <- lm(y ~ scale(x1) * scale(x2), data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictors (ground truth) + fit_unscaled <- lm(y ~ x1 * x2, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale and mock fit + formula_scale <- .make_formula_scale(df, c("x1", "x2")) + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled, n_rep = 50) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Apply transform_scale_samples (the reference implementation) + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + + # Get individual transformations and apply them + # For the highest-order term (interaction), transformation is simple + trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) + transformed_interaction <- trans_interaction$transformation_arguments$a + + trans_interaction$transformation_arguments$b * posterior_scaled[1, "mu_x1__xXx__x2"] + + expect_equal( + unname(transformed_interaction), + unname(posterior_transformed[1, "mu_x1__xXx__x2"]), + tolerance = 1e-10, + info = "Parameter: mu_x1__xXx__x2" + ) + + # For main effects and intercept, the transformation includes offset from other terms + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) + trans_int <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) + + transformed_x1 <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * posterior_scaled[1, "mu_x1"] + transformed_x2 <- trans_x2$transformation_arguments$a + + trans_x2$transformation_arguments$b * posterior_scaled[1, "mu_x2"] + transformed_int <- trans_int$transformation_arguments$a + + trans_int$transformation_arguments$b * posterior_scaled[1, "mu_intercept"] + + expect_equal( + unname(transformed_x1), + unname(posterior_transformed[1, "mu_x1"]), + tolerance = 1e-10, + info = "Parameter: mu_x1" + ) + + expect_equal( + unname(transformed_x2), + unname(posterior_transformed[1, "mu_x2"]), + tolerance = 1e-10, + info = "Parameter: mu_x2" + ) + + expect_equal( + unname(transformed_int), + unname(posterior_transformed[1, "mu_intercept"]), + tolerance = 1e-10, + info = "Parameter: mu_intercept" + ) + + # Also verify against unscaled lm coefficients + expect_equal(unname(transformed_x1), unname(coef_unscaled["x1"]), tolerance = 1e-10) + expect_equal(unname(transformed_x2), unname(coef_unscaled["x2"]), tolerance = 1e-10) + expect_equal(unname(transformed_int), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) +}) + + +test_that("lm validation: get_scale_transformation with factor + continuous interaction", { + + set.seed(50) + df <- data.frame( + x1 = rnorm(500, mean = 5, sd = 3), + f1 = factor(sample(letters[1:2], 500, TRUE)) + ) + df$y <- 2 + 0.5 * scale(df$x1) + + ifelse(df$f1 == "b", 0.3, 0) + + ifelse(df$f1 == "b", 0.2, 0) * scale(df$x1) + + rnorm(500, 0, 0.4) + + # Fit with scaled predictor + fit_scaled <- lm(y ~ scale(x1) * f1, data = df) + coef_scaled <- coef(fit_scaled) + + # Fit with unscaled predictor (ground truth) + fit_unscaled <- lm(y ~ x1 * f1, data = df) + coef_unscaled <- coef(fit_unscaled) + + # Create formula_scale (only x1 is scaled, f1 is factor) + formula_scale <- .make_formula_scale(df, "x1") + posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) + mock_fit <- .make_mock_fit(posterior_scaled) + + # Test main effect of x1 + trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + + coef_x1_transformed <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] + + expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) + + # Test interaction (x1:f1b involves scaled x1) + trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__f1b", formula_scale) + + coef_int_transformed <- trans_interaction$transformation_arguments$a + + trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):f1b"] + + expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:f1b"]), tolerance = 1e-10) +}) diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-model-averaging-plots.R index be0f78d..f23895e 100644 --- a/tests/testthat/test-model-averaging-plots.R +++ b/tests/testthat/test-model-averaging-plots.R @@ -536,3 +536,236 @@ test_that(".plot_prior_list.factor handles transformation", { }) }) + +# ============================================================================ # +# SECTION: get_scale_transformation with plotting +# ============================================================================ # + +test_that("exp_lin transformation functions are defined correctly", { + # Test that exp_lin transformation is correctly defined + # (used for log-intercept unscaling) + + # Get the transformation functions + trans_funcs <- BayesTools:::.density.prior_transformation_functions("exp_lin") + + # Verify the functions exist + expect_true(is.function(trans_funcs$fun)) + expect_true(is.function(trans_funcs$inv)) + expect_true(is.function(trans_funcs$jac)) + + # Test the transformation: exp(a + b * log(x)) + x <- 2 + a <- 0.5 + b <- 1 + + # fun: exp(0.5 + 1 * log(2)) = exp(0.5 + 0.693) = exp(1.193) ≈ 3.30 + expected <- exp(a + b * log(x)) + expect_equal(trans_funcs$fun(x, a, b), expected) + + # inv: should reverse the transformation + y <- trans_funcs$fun(x, a, b) + expect_equal(trans_funcs$inv(y, a, b), x, tolerance = 1e-10) + + # jac: 1 / (b * x) + expect_equal(trans_funcs$jac(x, a, b), 1 / (b * x)) +}) + + +test_that("get_scale_transformation with cached fit plots correctly", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load the auto-scaled fit + fit <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + formula_scale <- attr(fit, "formula_scale") + + # Create priors matching those used in test-00-model-fits.R + prior_x_cont <- prior("normal", list(0, 1)) + prior_x_int <- prior("normal", list(0, 1)) + + # Get transformations for the scaled parameters + trans_x1 <- get_scale_transformation("mu_x_cont1", formula_scale, fit = fit) + trans_x2 <- get_scale_transformation("mu_x_cont2", formula_scale, fit = fit) + trans_int <- get_scale_transformation("mu_x_cont1__xXx__x_cont2", formula_scale, fit = fit) + trans_intercept <- get_scale_transformation("mu_intercept", formula_scale, fit = fit) + + # Side-by-side: Standardized prior (left) vs Unscaled prior (right) for x_cont1 + vdiffr::expect_doppelganger("scale-transform-x1-standardized", function() { + plot(prior_x_cont, main = "x_cont1 (standardized)") + }) + + vdiffr::expect_doppelganger("scale-transform-x1-unscaled", function() { + plot(prior_x_cont, + transformation = trans_x1$transformation, + transformation_arguments = trans_x1$transformation_arguments, + main = "x_cont1 (unscaled)") + }) + + # Side-by-side: Standardized prior (left) vs Unscaled prior (right) for interaction + vdiffr::expect_doppelganger("scale-transform-interaction-standardized", function() { + plot(prior_x_int, main = "x1:x2 (standardized)") + }) + + vdiffr::expect_doppelganger("scale-transform-interaction-unscaled", function() { + plot(prior_x_int, + transformation = trans_int$transformation, + transformation_arguments = trans_int$transformation_arguments, + main = "x1:x2 (unscaled)") + }) +}) + + +test_that("get_scale_transformation posterior plots with cached fit", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load the auto-scaled fit + fit <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) + formula_scale <- attr(fit, "formula_scale") + + # Create priors matching those used in test-00-model-fits.R + prior_x_cont <- prior("normal", list(0, 1)) + prior_x_int <- prior("normal", list(0, 1)) + + # Get transformations + trans_x1 <- get_scale_transformation("mu_x_cont1", formula_scale, fit = fit) + trans_int <- get_scale_transformation("mu_x_cont1__xXx__x_cont2", formula_scale, fit = fit) + + # Extract posterior samples + posterior <- as.matrix(coda::as.mcmc.list(fit)) + + # Side-by-side posterior plots: Standardized vs Unscaled + vdiffr::expect_doppelganger("scale-posterior-x1-standardized", function() { + hist(posterior[, "mu_x_cont1"], breaks = 30, probability = TRUE, + main = "mu_x_cont1 posterior (standardized)", xlab = "") + lines(prior_x_cont, col = "red", lwd = 2) + }) + + # Apply transformation to posterior for unscaled plot + posterior_x1_unscaled <- trans_x1$transformation_arguments$a + + trans_x1$transformation_arguments$b * posterior[, "mu_x_cont1"] + + vdiffr::expect_doppelganger("scale-posterior-x1-unscaled", function() { + hist(posterior_x1_unscaled, breaks = 30, probability = TRUE, + main = "mu_x_cont1 posterior (unscaled)", xlab = "") + lines(prior_x_cont, + transformation = trans_x1$transformation, + transformation_arguments = trans_x1$transformation_arguments, + col = "red", lwd = 2) + }) + + # Interaction term + posterior_int_unscaled <- trans_int$transformation_arguments$a + + trans_int$transformation_arguments$b * posterior[, "mu_x_cont1__xXx__x_cont2"] + + vdiffr::expect_doppelganger("scale-posterior-interaction-standardized", function() { + hist(posterior[, "mu_x_cont1__xXx__x_cont2"], breaks = 30, probability = TRUE, + main = "interaction posterior (standardized)", xlab = "") + lines(prior_x_int, col = "red", lwd = 2) + }) + + vdiffr::expect_doppelganger("scale-posterior-interaction-unscaled", function() { + hist(posterior_int_unscaled, breaks = 30, probability = TRUE, + main = "interaction posterior (unscaled)", xlab = "") + lines(prior_x_int, + transformation = trans_int$transformation, + transformation_arguments = trans_int$transformation_arguments, + col = "red", lwd = 2) + }) +}) + + +test_that("get_scale_transformation with dual parameter model (log intercept)", { + set.seed(1) + skip_if_not_installed("rjags") + skip_on_cran() + skip_if_no_fits() + + # Load the dual parameter regression fit (has log(intercept) for log_sigma) + fit <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) + formula_scale <- attr(fit, "formula_scale") + + # Create priors matching those used in test-00-model-fits.R + prior_mu_x <- prior("normal", list(0, 1)) + prior_ls_x <- prior("normal", list(0, 0.5)) + + # Get transformations for mu (standard intercept) + trans_mu_x <- get_scale_transformation("mu_x_mu", formula_scale, fit = fit) + trans_mu_int <- get_scale_transformation("mu_intercept", formula_scale, fit = fit) + + # Get transformations for log_sigma (log intercept) + trans_ls_x <- get_scale_transformation("log_sigma_x_sigma", formula_scale, fit = fit) + trans_ls_int <- get_scale_transformation("log_sigma_intercept", formula_scale, fit = fit) + + # Verify log_sigma intercept uses exp_lin transformation + expect_equal(trans_ls_int$transformation, "exp_lin") + + # Extract posterior samples + posterior <- as.matrix(coda::as.mcmc.list(fit)) + + # Plot mu coefficient: standardized vs unscaled + vdiffr::expect_doppelganger("dual-mu-x-standardized", function() { + hist(posterior[, "mu_x_mu"], breaks = 30, probability = TRUE, + main = "mu_x_mu (standardized)", xlab = "") + lines(prior_mu_x, col = "red", lwd = 2) + }) + + posterior_mu_x_unscaled <- trans_mu_x$transformation_arguments$a + + trans_mu_x$transformation_arguments$b * posterior[, "mu_x_mu"] + + vdiffr::expect_doppelganger("dual-mu-x-unscaled", function() { + hist(posterior_mu_x_unscaled, breaks = 30, probability = TRUE, + main = "mu_x_mu (unscaled)", xlab = "") + lines(prior_mu_x, + transformation = trans_mu_x$transformation, + transformation_arguments = trans_mu_x$transformation_arguments, + col = "red", lwd = 2) + }) + + # Plot log_sigma coefficient: standardized vs unscaled + vdiffr::expect_doppelganger("dual-log-sigma-x-standardized", function() { + hist(posterior[, "log_sigma_x_sigma"], breaks = 30, probability = TRUE, + main = "log_sigma_x_sigma (standardized)", xlab = "") + lines(prior_ls_x, col = "red", lwd = 2) + }) + + posterior_ls_x_unscaled <- trans_ls_x$transformation_arguments$a + + trans_ls_x$transformation_arguments$b * posterior[, "log_sigma_x_sigma"] + + vdiffr::expect_doppelganger("dual-log-sigma-x-unscaled", function() { + hist(posterior_ls_x_unscaled, breaks = 30, probability = TRUE, + main = "log_sigma_x_sigma (unscaled)", xlab = "") + lines(prior_ls_x, + transformation = trans_ls_x$transformation, + transformation_arguments = trans_ls_x$transformation_arguments, + col = "red", lwd = 2) + }) +}) + + +test_that("linear transformation matches expected behavior", { + set.seed(1) + + # Create a normal prior + prior_list <- list(p1 = prior("normal", list(0, 1))) + + # Apply linear transformation: a + b*x with a=0, b=0.5 + # This should compress the distribution by half + vdiffr::expect_doppelganger("plot-normal-lin-compress", function() { + plot_prior_list(prior_list, + transformation = "lin", + transformation_arguments = list(a = 0, b = 0.5)) + }) + + # Apply linear transformation with offset: a + b*x with a=2, b=0.5 + # This should compress and shift + vdiffr::expect_doppelganger("plot-normal-lin-shift-compress", function() { + plot_prior_list(prior_list, + transformation = "lin", + transformation_arguments = list(a = 2, b = 0.5)) + }) +}) \ No newline at end of file From 236338e156990ade49ce6e52e04d663f2b1e1f5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Fri, 30 Jan 2026 16:16:09 +0100 Subject: [PATCH 37/38] follow: `plan-transform-scaled-plot-posterior.md` --- .vscode/settings.json | 1 + R/JAGS-formula.R | 126 ++-- R/JAGS-marglik.R | 10 +- man/get_scale_transformation.Rd | 31 +- plan-transform-scaled-plot-posterior.md | 591 ++++++++++++++++++ ...ale-posterior-interaction-standardized.svg | 90 --- .../scale-posterior-interaction-unscaled.svg | 88 --- .../scale-posterior-x1-standardized.svg | 95 --- .../scale-posterior-x1-unscaled.svg | 89 --- .../scale-transform-interaction-1x2.svg | 185 ++++++ ...ale-transform-interaction-standardized.svg | 61 -- .../scale-transform-interaction-unscaled.svg | 57 -- .../scale-transform-intercept-1x2.svg | 176 ++++++ .../scale-transform-x1-1x2.svg | 256 ++++++++ .../scale-transform-x1-standardized.svg | 61 -- .../scale-transform-x1-unscaled.svg | 57 -- tests/testthat/test-JAGS-formula-scale.R | 283 +++++---- tests/testthat/test-model-averaging-plots.R | 143 ++--- 18 files changed, 1550 insertions(+), 850 deletions(-) create mode 100644 .vscode/settings.json create mode 100644 plan-transform-scaled-plot-posterior.md delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..9e26dfe --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1 @@ +{} \ No newline at end of file diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 4f61ddd..75bdbed 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -1474,6 +1474,10 @@ transform_scale_samples <- function(fit, formula_scale = NULL){ #' posterior means of other coefficients when there are interactions in the model. #' #' @details +#' This function returns a \strong{marginal} transformation for visualizing +#' prior distributions on the original (unscaled) scale. The transformation +#' accounts for the variance contribution from interaction terms. +#' #' For a simple coefficient (single predictor, no interactions), the transformation is: #' \deqn{\beta_{orig} = \beta_z / \sigma_x} #' which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. @@ -1482,16 +1486,27 @@ transform_scale_samples <- function(fit, formula_scale = NULL){ #' higher-order terms), the transformation is similar: #' \deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} #' -#' For main effects when interactions are present, or for the intercept, the -#' transformation includes contributions from other coefficients: -#' \deqn{\beta_{orig} = a + b \times \beta_z} -#' where \code{a} is computed from the posterior means of other coefficients. -#' This requires the \code{fit} argument to access posterior samples. +#' For main effects when interactions are present, the \code{b} coefficient is the +#' L2 norm of the transformation matrix row (excluding intercept). This captures +#' the total variance contribution from all related interaction terms: +#' \deqn{b = \sqrt{\sum_j M_{ij}^2}} +#' where the sum is over all non-intercept terms that receive contributions from +#' the standardized coefficient. +#' +#' For intercepts, the diagonal coefficient is used (\code{b = 1}). This is because +#' the intercept prior itself doesn't get scaled - it's the same on both the +#' standardized and original scales. The L2 norm approach would be incorrect +#' because the intercept row mixes contributions from different priors +#' (intercept prior vs coefficient priors). #' #' For intercepts with \code{log_intercept = TRUE}, the transformation is: #' \deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} #' which uses the \code{"exp_lin"} transformation type. #' +#' \strong{Important:} For transforming posterior samples, use +#' \code{\link{transform_scale_samples}} instead, which correctly applies the +#' full matrix transformation to all parameters simultaneously. +#' #' @return A list with elements: #' \describe{ #' \item{\code{transformation}}{Character string (\code{"lin"} or \code{"exp_lin"}).} @@ -1515,32 +1530,34 @@ get_scale_transformation <- function(fit, parameter_name, formula_scale = NULL){ stop("'fit' argument is required to compute the scale transformation.") } + check_char(parameter_name, "parameter_name", check_length = 1) + # Extract formula_scale from fit if not provided if(is.null(formula_scale)){ - if(!is.null(attr(fit, "formula_scale"))){ - formula_scale <- attr(fit, "formula_scale") - } + formula_scale <- attr(fit, "formula_scale") } - check_char(parameter_name, "parameter_name", check_length = 1) - if(is.null(formula_scale) || length(formula_scale) == 0){ return(NULL) } check_list(formula_scale, "formula_scale") - # Identify the parameter prefix (e.g., "mu" from "mu_x1") - prefix <- NULL - for(param_name in names(formula_scale)){ - if(startsWith(parameter_name, paste0(param_name, "_"))){ - prefix <- param_name - break - } + # Get the parameter prefix from prior_list attribute + prior_list <- attr(fit, "prior_list") + + if(is.null(prior_list)){ + stop("'fit' must have a 'prior_list' attribute.") } + if(!parameter_name %in% names(prior_list)){ + stop("Parameter '", parameter_name, "' not found in prior_list.") + } + + prefix <- attr(prior_list[[parameter_name]], "parameter") + if(is.null(prefix)){ - # Parameter not affected by any scaling + # Parameter not part of a formula (no scaling applies) return(NULL) } @@ -1690,39 +1707,56 @@ get_scale_transformation <- function(fit, parameter_name, formula_scale = NULL){ self_coef <- unname(transform_row[parameter_name]) if(is.na(self_coef)) self_coef <- 1 - # Compute offset from other coefficients' posterior means - # offset = Σ(transform_row[j] * posterior_mean[j]) for j != self - offset <- 0 + # For non-intercept terms: compute the MARGINAL transformation. + # This is for prior visualization where we don't have samples of interaction terms. + # The b coefficient is the L2 norm of the transformation matrix row (excluding intercept), + # which captures the total variance contribution from all related terms. + # + # For intercept: use b = 1 (diagonal coefficient). The intercept prior itself + # doesn't get scaled - only the offset changes (which is 0 under centered priors). + # The L2 norm approach would be wrong because the intercept row mixes contributions - if(!is.null(fit)){ - # Get posterior samples (already have it if we entered this branch) - if(!exists("posterior")){ - posterior <- as.matrix(coda::as.mcmc.list(fit)) - } - other_cols <- setdiff(names(transform_row), parameter_name) - other_cols <- other_cols[other_cols %in% colnames(posterior)] - - if(length(other_cols) > 0){ - # Compute offset as sum of (coefficient * posterior_mean) - for(col in other_cols){ - coef_val <- transform_row[col] - if(!is.na(coef_val) && coef_val != 0){ - offset <- offset + coef_val * mean(posterior[, col]) - } - } - } - } + # from DIFFERENT priors (intercept prior vs coefficient priors). + + if(!is_intercept){ + # Marginal transformation: a = 0 (prior is centered), b = L2 norm of row + # Exclude intercept column from L2 norm calculation since we're looking at + # the effect of this coefficient, not the intercept contribution + non_intercept_cols <- setdiff(names(transform_row), intercept_col) + row_vals <- transform_row[non_intercept_cols] + row_vals <- row_vals[!is.na(row_vals)] + + b_marginal <- sqrt(sum(row_vals^2)) - if(is_intercept && log_intercept){ - return(list( - transformation = "exp_lin", - transformation_arguments = list(a = offset, b = unname(self_coef)) - )) - }else{ return(list( transformation = "lin", - transformation_arguments = list(a = offset, b = unname(self_coef)) + transformation_arguments = list(a = 0, b = b_marginal) )) + }else{ + # Intercept: use L2 norm of ENTIRE row (all columns) + # The intercept on the original scale is: + # beta_0 = beta_0* - (mean(x1)/sd(x1)) * beta_1* - (mean(x2)/sd(x2)) * beta_2* - ... + # + # The variance of the marginal prior for beta_0 includes contributions from + # ALL coefficient priors via the off-diagonal terms. The L2 norm captures this: + # Var(beta_0) = Var(beta_0*) * 1^2 + Var(beta_1*) * (mean(x1)/sd(x1))^2 + ... + # + # For the shift 'a': if priors are centered at 0, the expected value is still 0. + # TODO: If priors have non-zero means, compute a = sum(M[i,j] * E[beta_j*]) + row_vals <- transform_row[!is.na(transform_row)] + b_marginal <- sqrt(sum(row_vals^2)) + + if(log_intercept){ + return(list( + transformation = "exp_lin", + transformation_arguments = list(a = 0, b = b_marginal) + )) + }else{ + return(list( + transformation = "lin", + transformation_arguments = list(a = 0, b = b_marginal) + )) + } } } diff --git a/R/JAGS-marglik.R b/R/JAGS-marglik.R index 427886e..0bedec9 100644 --- a/R/JAGS-marglik.R +++ b/R/JAGS-marglik.R @@ -129,22 +129,22 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU # prepare object for holding the parameters, later accessible to the user specified 'log_posterior' parameters <- list() - if(!is.null(prior_list)){ + if(length(prior_list) > 0){ parameters <- c(parameters, JAGS_marglik_parameters(samples.row, prior_list)) } - if(!is.null(formula_prior_list)){ + if(length(formula_prior_list) > 0){ parameters <- c(parameters, JAGS_marglik_parameters_formula(samples.row, formula_list, formula_data_list, formula_prior_list, parameters)) } - if(!is.null(add_parameters)){ + if(length(add_parameters) > 0){ parameters <- c(parameters, samples.row[add_parameters]) } # compute the marginal likelihoods marglik <- 0 - if(!is.null(prior_list)){ + if(length(prior_list) > 0){ marglik <- marglik + JAGS_marglik_priors(samples.row, prior_list) } - if(!is.null(formula_prior_list)){ + if(length(formula_prior_list) > 0){ marglik <- marglik + JAGS_marglik_priors_formula(samples.row, formula_prior_list) } marglik <- marglik + log_posterior(parameters = parameters, data = data, ...) diff --git a/man/get_scale_transformation.Rd b/man/get_scale_transformation.Rd index 5857fde..76369ab 100644 --- a/man/get_scale_transformation.Rd +++ b/man/get_scale_transformation.Rd @@ -4,19 +4,19 @@ \alias{get_scale_transformation} \title{Get scale transformation for plotting} \usage{ -get_scale_transformation(parameter_name, formula_scale = NULL, fit) +get_scale_transformation(fit, parameter_name, formula_scale = NULL) } \arguments{ +\item{fit}{A fitted model object (e.g., from \code{JAGS_fit}) containing posterior +samples. Required for computing the transformation, as the offset depends on +posterior means of other coefficients when there are interactions in the model.} + \item{parameter_name}{The full name of the parameter (e.g., \code{"mu_x1"}, \code{"mu_intercept"}, or \code{"mu_x1__xXx__x2"} for interaction)} \item{formula_scale}{Nested list containing standardization information keyed by parameter name. Each parameter entry contains scaling info (mean and sd) for each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}.} - -\item{fit}{A fitted model object (e.g., from \code{JAGS_fit}) containing posterior -samples. Required for computing the transformation, as the offset depends on -posterior means of other coefficients when there are interactions in the model.} } \value{ A list with elements: @@ -33,6 +33,11 @@ that can be used with plotting functions via \code{transformation} and \code{transformation_arguments} parameters. } \details{ +This function returns the \strong{marginal} transformation for visualizing priors +on the original (unscaled) parameter scale. When a main effect has interactions, +the marginal prior on the unscaled coefficient is a convolution of independent +priors, with variance equal to the sum of squared transformation coefficients. + For a simple coefficient (single predictor, no interactions), the transformation is: \deqn{\beta_{orig} = \beta_z / \sigma_x} which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. @@ -41,11 +46,15 @@ For the highest-order interaction term (which receives no contributions from higher-order terms), the transformation is similar: \deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} -For main effects when interactions are present, or for the intercept, the -transformation includes contributions from other coefficients: -\deqn{\beta_{orig} = a + b \times \beta_z} -where \code{a} is computed from the posterior means of other coefficients. -This requires the \code{fit} argument to access posterior samples. +For main effects when interactions are present, the marginal transformation +uses the L2 norm of the transformation matrix row coefficients: +\deqn{b = \sqrt{\sum_j M_{ij}^2}} +where \eqn{M_{ij}} are the coefficients from the unscaling matrix for terms +with the same prior distribution (typically all regression coefficients). +This correctly captures the variance of the convolution of independent priors. + +For intercepts, the transformation includes contributions from other coefficients +using their posterior means, since the intercept typically has a different prior. For intercepts with \code{log_intercept = TRUE}, the transformation is: \deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} @@ -53,7 +62,7 @@ which uses the \code{"exp_lin"} transformation type. } \examples{ # With a fitted model -# trans <- get_scale_transformation("mu_x1", fit = fit) +# trans <- get_scale_transformation(fit, "mu_x1") # Returns: list(transformation = "lin", transformation_arguments = list(a = offset, b = scale)) } diff --git a/plan-transform-scaled-plot-posterior.md b/plan-transform-scaled-plot-posterior.md new file mode 100644 index 0000000..237765f --- /dev/null +++ b/plan-transform-scaled-plot-posterior.md @@ -0,0 +1,591 @@ +# Plan: Add `transform_scaled` to `plot_posterior` + +## Overview + +Add the ability to visualize prior and posterior distributions on both the **standardized** (scaled) and **original** (unscaled) scales when using formula-based models with auto-scaling. + +## Problem Statement + +When models use auto-scaling (standardizing predictors), the posterior samples are on the standardized scale. Users often want to visualize and interpret results on the original scale. + +### Why Simple Linear Transformation Fails + +For **coefficients** (main effects and interactions), a simple linear transformation `a + b*x` works because: +- Main effect: `β_orig = β_z / sd(x)` → `b = 1/sd(x)`, `a = 0` +- Interaction: `β_orig = β_z / (sd(x1) * sd(x2))` → `b = 1/(sd(x1)*sd(x2))`, `a = 0` + +For the **intercept**, simple transformation FAILS because: +``` +β₀_orig = β₀* - (mean(x₁)/sd(x₁)) * β₁* - (mean(x₂)/sd(x₂)) * β₂* - ... +``` + +The intercept on the original scale is a **weighted sum of multiple priors with different variances**: +- `Var(β₀_orig) = Var(β₀*) + (m₁/s₁)² * Var(β₁*) + (m₂/s₂)² * Var(β₂*) + ...` + +If priors have different scales (e.g., intercept prior N(0,5) vs coefficient prior N(0,1)), the marginal prior for the intercept on the original scale is NOT a simple transformation of the intercept prior alone. + +### Correct Approach + +Generate samples from **ALL** priors simultaneously and apply the **same matrix transformation** used for posterior samples: +1. Sample from each prior (intercept, coefficients, interactions) +2. Form a matrix of prior samples (matching posterior structure) +3. Apply `transform_scale_samples()` to get prior samples on original scale +4. Extract marginal samples for the parameter of interest + +This naturally handles all cases correctly, including the intercept. + +--- + +## Proposed Solution + +### New Function: `transform_prior_samples()` + +Create a new function that generates prior samples and transforms them: + +```r +#' Transform prior samples to original scale +#' +#' @param fit Fitted model object with prior_list and formula_scale attributes +#' @param n_samples Number of samples to generate (default: 10000) +#' @param seed Random seed for reproducibility +#' @return Matrix of prior samples on the original scale +transform_prior_samples <- function(fit, n_samples = 10000, seed = NULL) +``` + +**Implementation steps:** +1. Extract `prior_list` from fit +2. Extract `formula_scale` from fit +3. For each prior in `prior_list`, generate `n_samples` using `rng()` method +4. Arrange samples into matrix with same column structure as posterior +5. Apply `transform_scale_samples()` to transform to original scale +6. Return transformed prior samples matrix + +### Modify `plot_posterior()` + +Add `transform_scaled` argument to `plot_posterior()`: + +```r +plot_posterior <- function(samples, parameter, ..., + transform_scaled = FALSE, + formula_scale = NULL, + prior_samples = NULL) +``` + +When `transform_scaled = TRUE`: +1. Transform posterior samples using `transform_scale_samples()` +2. If `prior = TRUE`, use pre-generated `prior_samples` or generate via `transform_prior_samples()` +3. Plot both on the original scale + +--- + +## Integration with `mix_posteriors` / `as_mixed_posteriors` + +### Current State + +- `mix_posteriors()` creates mixed posterior samples from multiple models +- Returns object with class `mixed_posteriors` containing: + - `$samples` - mixed posterior samples + - `$prior_list` - list of priors used + - `$inference` - model weights and inference results + +### Required Modifications + +#### Option A: Extend `mix_posteriors()` + +Add optional arguments: +```r +mix_posteriors(..., + transform_scaled = FALSE, + formula_scale = NULL, + generate_prior_samples = FALSE, + n_prior_samples = 10000) +``` + +When `generate_prior_samples = TRUE`: +- Generate prior samples for each model +- Mix prior samples according to model weights (same as posterior mixing) +- Store in `$prior_samples` attribute + +#### Option B: Create `as_mixed_posteriors()` enhancement + +The function `as_mixed_posteriors()` can be enhanced to: +1. Accept single model fits and wrap them in mixed_posteriors format +2. Generate prior samples on demand +3. Handle formula_scale attribute propagation + +**Note:** `as_mixed_posteriors()` may already support forcing prior samples for plotting - verify this capability and extend if needed. + +--- + +## Implementation Plan + +### Phase 1: Core Infrastructure + +1. **Create `transform_prior_samples()`** + - Location: `R/JAGS-formula.R` (near `transform_scale_samples`) + - Inputs: fit object, n_samples, seed + - Outputs: Matrix of transformed prior samples + +2. **Create helper: `.generate_prior_sample_matrix()`** + - Generate samples from all priors in prior_list + - Match column structure to posterior samples + - Handle different prior types (simple, factor, spike, etc.) + +### Phase 2: Plot Integration + +3. **Modify `plot_posterior()`** in `R/model-averaging-plots.R` + - Add `transform_scaled` argument + - Add `formula_scale` argument (optional, extracted from samples if available) + - When `transform_scaled = TRUE`: + - Transform posterior samples + - Transform prior samples (if prior = TRUE) + - Adjust axis labels to indicate "original scale" + +### Phase 3: Mixed Posteriors Integration + +5. **Extend `mix_posteriors()`** + - Add `generate_prior_samples` argument + - Store `prior_samples` in returned object + - Propagate `formula_scale` attribute + +6. **Extend `as_mixed_posteriors()`** + - Handle single model case + - Support prior sample generation + - Ensure formula_scale is preserved + +### Phase 4: Testing + +7. **Unit tests** in `tests/testthat/test-JAGS-formula-scale.R` + - Test `transform_prior_samples()` generates correct samples + - Verify prior samples have expected distribution after transformation + - Test with various model structures (main effects, interactions, intercept) + +8. **Visual regression tests** in `tests/testthat/test-model-averaging-plots.R` + - Side-by-side: scaled vs unscaled plots + - Verify prior overlays match posterior distributions + +--- + +## Technical Considerations + +### Prior Sample Generation + +Different prior types need different handling: +- **Simple priors** (normal, cauchy, etc.): Use `rng(prior, n_samples)` +- **Factor priors**: Generate for each level +- **Spike priors**: All samples = spike location +- **Mixture priors**: Sample component, then sample from component + +### Column Matching + +Prior sample matrix must match posterior column names exactly: +```r +# Posterior columns might be: c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2", "sigma") +# Prior sample matrix must have same columns +``` + +### Missing Priors + +Some posterior parameters may not have corresponding priors in `prior_list`: +- Handle gracefully (skip transformation or use identity) +- Document behavior clearly + +### Performance + +Generating many prior samples can be slow: +- Default to reasonable n_samples (10000) +- Allow caching/reuse of prior samples +- Consider lazy evaluation + +--- + +## API Examples + +### Basic Usage + +```r +# Fit model with auto-scaling +fit <- JAGS_fit(data, formula = y ~ x1 * x2, ...) + +# Extract posterior +posterior <- as.matrix(coda::as.mcmc.list(fit)) + +# Plot on standardized scale (current behavior) +plot_posterior(posterior, "mu_x1", prior = TRUE) + +# Plot on original scale (new behavior) +plot_posterior(posterior, "mu_x1", prior = TRUE, + transform_scaled = TRUE, + fit = fit) # or formula_scale = attr(fit, "formula_scale") +``` + +### With Mixed Posteriors + +```r +# Mix posteriors from multiple models +mixed <- mix_posteriors(model_list, parameters = c("mu_x1", "mu_intercept"), ...) + +# Plot on original scale with prior +plot_posterior(mixed, "mu_x1", + prior = TRUE, + transform_scaled = TRUE) +``` + +--- + +## Open Questions + +1. **Should `transform_scaled` default to `TRUE` or `FALSE`?** + - FALSE maintains backward compatibility + - TRUE might be more intuitive for users + +2. **How to handle parameters not affected by scaling?** + - Skip transformation (identity) + - Or always apply (no-op for unscaled parameters) + +3. **Axis labeling convention?** + - Add "(original scale)" to axis labels? + - Use parameter name transformation (e.g., "x1" vs "scale(x1)")? + +4. **Integration with existing `transformation` argument?** + - `transform_scaled` is separate from user-specified transformations (exp, log, etc.) + - Should they be combinable? (first unscale, then apply user transformation) + +--- + +## Files to Modify + +| File | Changes | +|------|---------| +| `R/JAGS-formula.R` | Add `transform_prior_samples()`, `.generate_prior_sample_matrix()` | +| `R/model-averaging-plots.R` | Modify `plot_posterior()`, `plot_models()` | +| `R/model-averaging.R` | Extend `mix_posteriors()`, `as_mixed_posteriors()` | +| `tests/testthat/test-JAGS-formula-scale.R` | Add tests for prior sample transformation | +| `tests/testthat/test-model-averaging-plots.R` | Add visual tests for transformed plots | +| `man/plot_posterior.Rd` | Update documentation | +| `man/transform_prior_samples.Rd` | New documentation | + +--- + +## Success Criteria + +1. Prior and posterior distributions align correctly on both scales +2. Intercept transformation is correct (uses matrix transformation) +3. Coefficient transformations remain correct +4. Backward compatible (existing code works unchanged) +5. Clear documentation and examples +6. Comprehensive test coverage + +remove incorrect: get_scale_transformation and the corresponding tests +--- + +## References + +- Current implementation: `get_scale_transformation()` in `R/JAGS-formula.R` +- Matrix transformation: `.build_unscale_matrix()` in `R/JAGS-formula.R` +- Posterior transformation: `transform_scale_samples()` in `R/JAGS-formula.R` +- Plot functions: `R/model-averaging-plots.R` + +--- + +## Detailed Implementation Analysis + +### Existing Infrastructure (Code Review) + +#### 1. `mix_posteriors()` (R/model-averaging.R:177) + +**Current behavior:** +- Takes `model_list`, `parameters`, `is_null_list` +- Extracts `fits`, `priors` from each model +- Dispatches to type-specific helpers: `.mix_posteriors.simple()`, `.mix_posteriors.factor()`, etc. +- Each helper: + - Samples from posterior based on `post_probs` (model weights) + - For spike priors: uses `priors[[i]]$parameters[["location"]]` directly (no sampling) + - Attaches `prior_list` as attribute to output + +**Key insight:** The mixing logic samples from posteriors proportionally to model weights. The same logic can sample from priors. + +**Relevant code pattern (`.mix_posteriors.simple`, line 370-378):** +```r +if(is.prior.point(priors[[i]])){ + # not sampling the priors as the samples would be already transformed + samples <- c(samples, rep(priors[[i]]$parameters[["location"]], length(temp_ind))) +}else{ + samples <- c(samples, model_samples[temp_ind, parameter]) +} +``` + +#### 2. `as_mixed_posteriors()` (R/model-averaging.R:707) + +**Current behavior:** +- Takes single `BayesTools_fit` model +- Extracts `priors` from `attr(model, "prior_list")` +- Extracts `model_samples` from `coda::as.mcmc(model)` +- Applies conditioning if specified +- Dispatches to type-specific helpers: `.as_mixed_posteriors.simple()`, etc. +- Returns object with class `"as_mixed_posteriors"`, `"mixed_posteriors"` + +**Key insight:** This wraps a single model's posterior as mixed_posteriors format. Ideal place to also generate prior samples. + +**Note:** `force_plots` argument exists but appears minimally used (line 694-696): +> "temporal argument allowing to generate conditional posterior samples suitable for prior and posterior plots" + +#### 3. `plot_posterior()` (R/model-averaging-plots.R:995) + +**Current behavior:** +- Takes `samples` (mixed_posteriors object) and `parameter` +- If `prior = TRUE`: + - Extracts `prior_list` from `attr(samples[[parameter]], "prior_list")` + - Calls `.plot_data_prior_list.simple()` which uses `density()` on priors + - The `density.prior()` function uses `rng()` when `force_samples = TRUE` + +**Key insight:** Prior visualization already uses `rng()` via the `density()` method. The infrastructure for sampling exists. + +#### 4. `rng.prior()` (R/priors.R:1129) + +**Current behavior:** +- Generates random samples from any prior type +- Handles: simple priors, spike_and_slab, mixture, factor priors +- For mixtures: samples component first, then samples from that component + +**Key insight:** This is the building block for generating prior samples. Already handles all prior types. + +#### 5. `transform_scale_samples()` (R/JAGS-formula.R:1432) + +**Current behavior:** +- Takes fit or matrix, extracts/uses `formula_scale` +- Calls `.apply_unscale_transform()` which uses `.build_unscale_matrix()` +- Applies full matrix transformation: `posterior_transformed = posterior %*% M^T` + +**Key insight:** This can transform ANY matrix with the right column structure - posterior OR prior samples. + +--- + +## Recommended Implementation Strategy + +### Strategy: Minimal Changes with Maximum Reuse + +The most maintainable approach leverages existing infrastructure: + +1. **Reuse `rng.prior()`** for prior sample generation (already handles all types) +2. **Reuse `transform_scale_samples()`** for matrix transformation +3. **Extend `as_mixed_posteriors()`** to optionally generate prior samples +4. **Modify `plot_posterior()`** minimally to use transformed samples + +### Implementation Details + +#### Step 1: Create `.generate_prior_sample_matrix()` helper + +Location: `R/JAGS-formula.R` (or `R/model-averaging.R` if preferred) + +```r +.generate_prior_sample_matrix <- function(prior_list, n_samples, column_names = NULL, seed = NULL) { + # Generate samples from all priors matching posterior column structure + + if (!is.null(seed)) set.seed(seed) + + # Initialize matrix + n_params <- length(prior_list) + samples <- matrix(NA, nrow = n_samples, ncol = n_params) + colnames(samples) <- names(prior_list) + + for (i in seq_along(prior_list)) { + prior <- prior_list[[i]] + param_name <- names(prior_list)[i] + + if (is.null(prior) || is.prior.none(prior)) { + samples[, i] <- 0 # No effect + } else if (is.prior.point(prior)) { + samples[, i] <- prior$parameters[["location"]] + } else { + samples[, i] <- rng(prior, n_samples) # Uses existing rng.prior() + } + } + + # Reorder columns to match column_names if provided + if (!is.null(column_names)) { + # Match available columns + available <- intersect(column_names, colnames(samples)) + samples <- samples[, available, drop = FALSE] + } + + return(samples) +} +``` + +#### Step 2: Create `transform_prior_samples()` (exported function) + +Location: `R/JAGS-formula.R` + +```r +#' @title Transform prior samples to original scale +#' @description Generate prior samples and transform them using the same +#' matrix transformation as posterior samples. +#' @param fit Fitted model with prior_list and formula_scale attributes +#' @param n_samples Number of samples to generate +#' @param seed Random seed for reproducibility +#' @return Matrix of prior samples on original scale +#' @export +transform_prior_samples <- function(fit, n_samples = 10000, seed = NULL) { + + prior_list <- attr(fit, "prior_list") + formula_scale <- attr(fit, "formula_scale") + + if (is.null(prior_list)) { + stop("'fit' must have 'prior_list' attribute") + } + + # Get posterior column names for structure matching + posterior <- as.matrix(coda::as.mcmc.list(fit)) + + # Generate prior samples + prior_samples <- .generate_prior_sample_matrix( + prior_list, + n_samples = n_samples, + column_names = colnames(posterior), + seed = seed + ) + + # Apply same transformation as posterior + if (!is.null(formula_scale) && length(formula_scale) > 0) { + prior_samples <- transform_scale_samples(prior_samples, formula_scale) + } + + return(prior_samples) +} +``` + +#### Step 3: Extend `as_mixed_posteriors()` + +Add `generate_prior_samples` argument: + +```r +as_mixed_posteriors <- function(model, parameters, conditional = NULL, + conditional_rule = "AND", force_plots = FALSE, + generate_prior_samples = FALSE, # NEW + n_prior_samples = 10000) { # NEW + # ... existing code ... + + # At the end, before return: + if (generate_prior_samples) { + prior_samples <- transform_prior_samples(model, n_samples = n_prior_samples) + attr(out, "prior_samples") <- prior_samples + } + + # Propagate formula_scale + attr(out, "formula_scale") <- attr(model, "formula_scale") + + return(out) +} +``` + +#### Step 4: Modify `plot_posterior()` + +Add `transform_scaled` argument: + +```r +plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE, + n_points = 1000, n_samples = 10000, force_samples = FALSE, + transform_scaled = FALSE, # NEW + formula_scale = NULL, # NEW + ...) { + + # Extract formula_scale from samples if not provided + if (transform_scaled && is.null(formula_scale)) { + formula_scale <- attr(samples, "formula_scale") + } + + # ... existing parameter extraction ... + + # Transform posterior samples if requested + if (transform_scaled && !is.null(formula_scale)) { + # Get raw samples and transform + raw_samples <- # extract from samples object + transformed_samples <- transform_scale_samples(raw_samples, formula_scale) + # Use transformed_samples for plotting + } + + # For prior plotting with transform_scaled: + if (prior && transform_scaled) { + # Check if pre-generated prior_samples exist + prior_samples <- attr(samples, "prior_samples") + if (is.null(prior_samples)) { + # Generate on the fly (need fit object) + warning("Prior samples not pre-generated. For best results, use generate_prior_samples=TRUE in as_mixed_posteriors()") + # Fall back to standard prior density (may be incorrect for intercept) + } + # Use prior_samples[, parameter] for density estimation + } + + # ... rest of plotting logic ... +} +``` + +--- + +## Alternative: Simpler `plot_posterior` Enhancement + +If modifying the mixed_posteriors infrastructure is too invasive, a simpler approach: + +```r +plot_posterior <- function(samples, parameter, ..., + transform_scaled = FALSE, + fit = NULL) { # Accept original fit object + + if (transform_scaled) { + if (is.null(fit)) { + stop("'fit' required when transform_scaled = TRUE") + } + + # Transform posterior + posterior_orig <- transform_scale_samples(fit) + + # For prior, generate and transform + if (prior) { + prior_samples_orig <- transform_prior_samples(fit, n_samples = n_samples) + # Use density(prior_samples_orig[, parameter]) for prior overlay + } + } +} +``` + +This keeps all transformation logic in the plotting function, avoiding changes to `mix_posteriors` / `as_mixed_posteriors`. + +--- + +## Recommendation + +**Phase 1 (Immediate):** Implement the simpler approach - add `transform_scaled` and `fit` arguments to `plot_posterior()`. This: +- Requires minimal changes +- Keeps transformation logic centralized +- Works for single-model cases + +**Phase 2 (Future):** Extend `as_mixed_posteriors()` with `generate_prior_samples` for: +- Pre-computed prior samples +- Multi-model averaging cases +- Better performance (compute once, plot multiple times) + +--- + +## Factor Priors Consideration + +For factor priors (orthonormal, meandif, treatment contrasts), the sample structure is more complex: +- Multiple columns per factor level +- Need to match column naming convention + +The `rng.prior()` already handles this via `transform_factor_samples` argument. +Ensure `.generate_prior_sample_matrix()` correctly handles: +- `is.prior.factor()` → returns matrix, not vector +- Column naming: `parameter[1]`, `parameter[2]`, etc. + +--- + +## Edge Cases to Handle + +1. **Parameters not in prior_list**: Skip or use 0 +2. **Parameters not affected by scaling**: Identity transformation (already handled by `transform_scale_samples`) +3. **Spike priors**: Generate constant samples at spike location +4. **Mixture priors**: Sample component, then sample from component (handled by `rng.prior`) +5. **Models without formula_scale**: Return untransformed samples + +```` diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg deleted file mode 100644 index 5b8e8d6..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-standardized.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - -interaction posterior (standardized) -Density - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg deleted file mode 100644 index 29bdfa2..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-interaction-unscaled.svg +++ /dev/null @@ -1,88 +0,0 @@ - - - - - - - - - - - - -interaction posterior (unscaled) -Density - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg deleted file mode 100644 index 49c74a8..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-standardized.svg +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - - - - - - -mu_x_cont1 posterior (standardized) -Density - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 -4 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg deleted file mode 100644 index 85d0503..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-posterior-x1-unscaled.svg +++ /dev/null @@ -1,89 +0,0 @@ - - - - - - - - - - - - -mu_x_cont1 posterior (unscaled) -Density - - - - - - - - --0.006 --0.005 --0.004 --0.003 --0.002 --0.001 -0.000 - - - - - - -0 -100 -200 -300 -400 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg new file mode 100644 index 0000000..41a21c9 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg @@ -0,0 +1,185 @@ + + + + + + + + + + + + + + + + + + + +x1:x2 (scaled) +Density + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x1:x2 (unscaled) +Density + + + + + + + + + + +-0.3 +-0.2 +-0.1 +0.0 +0.1 +0.2 +0.3 + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg deleted file mode 100644 index 73c6b5d..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-standardized.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -x1:x2 (standardized) - -Normal -(0, 1) -Density - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg deleted file mode 100644 index e98f575..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-unscaled.svg +++ /dev/null @@ -1,57 +0,0 @@ - - - - - - - - - - - - - - - - - - --0.2 --0.1 -0.0 -0.1 -0.2 - - - - - - -0 -1 -2 -3 -4 -x1:x2 (unscaled) - -Normal -(0, 1) -Density - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg new file mode 100644 index 0000000..ae16c96 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg @@ -0,0 +1,176 @@ + + + + + + + + + + + + + + + + + + + +intercept (scaled) +Density + + + + + + + + + +-10 +0 +10 +20 +30 +40 + + + + + + + + +0.00 +0.01 +0.02 +0.03 +0.04 +0.05 +0.06 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +intercept (unscaled) +Density + + + + + + + + +-200 +-100 +0 +100 +200 + + + + + + + + +0.000 +0.001 +0.002 +0.003 +0.004 +0.005 +0.006 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg new file mode 100644 index 0000000..f1e33df --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg @@ -0,0 +1,256 @@ + + + + + + + + + + + + + + + + + + + +x_cont1 (scaled) +Density + + + + + + + + + + + +-3 +-2 +-1 +0 +1 +2 +3 +4 + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x_cont1 (unscaled) +Density + + + + + + + + + + +-0.15 +-0.10 +-0.05 +0.00 +0.05 +0.10 +0.15 + + + + + + + +0 +2 +4 +6 +8 +10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg deleted file mode 100644 index 47490d8..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-standardized.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -x_cont1 (standardized) - -Normal -(0, 1) -Density - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg deleted file mode 100644 index 7b0ffc9..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-unscaled.svg +++ /dev/null @@ -1,57 +0,0 @@ - - - - - - - - - - - - - - - - - - --0.005 --0.004 --0.003 --0.002 --0.001 - - - - - - -0 -100 -200 -300 -400 -x_cont1 (unscaled) - -Normal -(0, 1) -Density - - - - - - - - - - diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index 2888855..65d9625 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -1401,12 +1401,23 @@ test_that("lm validation: factor interactions with multiple scaled continuous", # Helper: Create a mock fit object from coefficient matrix # This mimics the structure expected by get_scale_transformation -.make_mock_fit <- function(posterior_matrix) { +.make_mock_fit <- function(posterior_matrix, prefix = "mu") { # Create a simple coda mcmc object mcmc_obj <- coda::mcmc(posterior_matrix) fit <- list(mcmc = mcmc_obj) class(fit) <- "runjags" attr(fit, "mcmc") <- coda::mcmc.list(mcmc_obj) + + # Create prior_list with "parameter" attribute for each column + # This is needed by get_scale_transformation to determine the prefix + prior_list <- lapply(colnames(posterior_matrix), function(param_name) { + p <- prior("normal", list(mean = 0, sd = 1)) + attr(p, "parameter") <- prefix + p + }) + names(prior_list) <- colnames(posterior_matrix) + attr(fit, "prior_list") <- prior_list + fit } @@ -1434,11 +1445,11 @@ test_that("get_scale_transformation requires fit argument", { }) -test_that("get_scale_transformation returns NULL for unscaled parameters", { +test_that("get_scale_transformation returns NULL for unscaled parameters and errors for missing", { - # Create a minimal mock fit - posterior <- matrix(c(0, 0.5), nrow = 10, ncol = 2, byrow = TRUE) - colnames(posterior) <- c("mu_intercept", "mu_x1") + # Create a minimal mock fit with mu_x1 and mu_x2 but only x1 is scaled + posterior <- matrix(c(0, 0.5, 0.3), nrow = 10, ncol = 3, byrow = TRUE) + colnames(posterior) <- c("mu_intercept", "mu_x1", "mu_x2") mock_fit <- .make_mock_fit(posterior) formula_scale <- list( @@ -1447,15 +1458,17 @@ test_that("get_scale_transformation returns NULL for unscaled parameters", { ) ) - # Parameter not in formula_scale + # Parameter in prior_list but not in formula_scale -> returns NULL result <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) expect_null(result) - # Parameter with different prefix - result <- get_scale_transformation(fit = mock_fit, "sigma_x1", formula_scale) - expect_null(result) + # Parameter not in prior_list -> error + expect_error( + get_scale_transformation(fit = mock_fit, "sigma_x1", formula_scale), + "not found in prior_list" + ) - # Empty formula_scale + # Empty formula_scale -> NULL (no scaling to apply) result <- get_scale_transformation(fit = mock_fit, "mu_x1", NULL) expect_null(result) @@ -1517,14 +1530,24 @@ test_that("lm validation: get_scale_transformation for intercept (one predictor) posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) mock_fit <- .make_mock_fit(posterior_scaled) - # Get transformation for intercept (requires fit for offset computation) + # Get transformation for intercept trans <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - # Apply transformation - coef_int_transformed <- trans$transformation_arguments$a + - trans$transformation_arguments$b * coef_scaled["(Intercept)"] + # Intercept uses a = 0, b = L2 norm of ENTIRE row (all columns) + # The variance includes contributions from coefficient priors via off-diagonal terms + M <- .build_unscale_matrix(c("mu_intercept", "mu_x1"), formula_scale[["mu"]], "mu") + expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) + + expect_equal(trans$transformation_arguments$a, 0) + expect_equal(trans$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - expect_equal(unname(coef_int_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) + # For point transformation, use transform_scale_samples + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + expect_equal( + unname(posterior_transformed[1, "mu_intercept"]), + unname(coef_unscaled["(Intercept)"]), + tolerance = 1e-10 + ) }) @@ -1559,12 +1582,24 @@ test_that("lm validation: get_scale_transformation for multiple predictors", { trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] coef_x2_transformed <- trans_x2$transformation_arguments$a + trans_x2$transformation_arguments$b * coef_scaled["scale(x2)"] - coef_int_transformed <- trans_int$transformation_arguments$a + - trans_int$transformation_arguments$b * coef_scaled["(Intercept)"] expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) expect_equal(unname(coef_x2_transformed), unname(coef_unscaled["x2"]), tolerance = 1e-10) - expect_equal(unname(coef_int_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) + + # Intercept uses a = 0, b = L2 norm of ENTIRE row (all columns) + M <- .build_unscale_matrix(c("mu_intercept", "mu_x1", "mu_x2"), formula_scale[["mu"]], "mu") + expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) + + expect_equal(trans_int$transformation_arguments$a, 0) + expect_equal(trans_int$transformation_arguments$b, expected_b_int, tolerance = 1e-10) + + # For point transformation, use transform_scale_samples + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + expect_equal( + unname(posterior_transformed[1, "mu_intercept"]), + unname(coef_unscaled["(Intercept)"]), + tolerance = 1e-10 + ) }) @@ -1591,7 +1626,7 @@ test_that("lm validation: get_scale_transformation for two-way interaction", { posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) mock_fit <- .make_mock_fit(posterior_scaled) - # Test interaction coefficient - this works because interaction has no higher-order terms + # Test interaction coefficient - highest order term, marginal = conditional trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) coef_int_transformed <- trans_interaction$transformation_arguments$a + @@ -1599,20 +1634,31 @@ test_that("lm validation: get_scale_transformation for two-way interaction", { expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) - # For main effects with interactions: get_scale_transformation returns the MARGINAL - # transformation (b = 1/sd, a = 0). The full transformation requires knowing other - # coefficients' values. When we use transform_scale_samples on the full posterior, - # the matrix multiplication handles this correctly. + # For main effects with interactions: get_scale_transformation returns MARGINAL + # transformation for prior visualization. a = 0 (prior is centered), b = L2 norm. - # Verify that the b-coefficient is correct (1/sd) trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - expect_equal(trans_x1$transformation_arguments$b, 1/sd(df$x1), tolerance = 1e-10) - expect_equal(trans_x2$transformation_arguments$b, 1/sd(df$x2), tolerance = 1e-10) + # Build the unscale matrix to compute expected L2 norms + M <- .build_unscale_matrix( + c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2"), + formula_scale[["mu"]], + "mu" + ) + + # Expected marginal b = L2 norm of non-intercept coefficients in each row + expected_b_x1 <- sqrt(sum(M["mu_x1", c("mu_x1", "mu_x1__xXx__x2")]^2)) + expected_b_x2 <- sqrt(sum(M["mu_x2", c("mu_x2", "mu_x1__xXx__x2")]^2)) + + expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) + expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) - # To get the full transformation for main effects, use transform_scale_samples - # and then compare with unscaled coefficients + # Marginal transformation has a = 0 (prior is centered at origin) + expect_equal(trans_x1$transformation_arguments$a, 0) + expect_equal(trans_x2$transformation_arguments$a, 0) + + # For POINT transformation of coefficients, use transform_scale_samples posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) expect_equal(unname(posterior_transformed[1, "mu_x1"]), unname(coef_unscaled["x1"]), tolerance = 1e-10) @@ -1650,7 +1696,15 @@ test_that("lm validation: get_scale_transformation for three-way interaction", { posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) mock_fit <- .make_mock_fit(posterior_scaled) - # Test three-way interaction (highest order - no contributions from higher terms) + # Validate point transformation produced by transform_scale_samples + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) + expect_equal( + unname(posterior_transformed[1, ]), + unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), + tolerance = 1e-10 + ) + + # Test three-way interaction (highest order - marginal = conditional) trans_3way <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2__xXx__x3", formula_scale) coef_3way_transformed <- trans_3way$transformation_arguments$a + @@ -1658,45 +1712,62 @@ test_that("lm validation: get_scale_transformation for three-way interaction", { expect_equal(unname(coef_3way_transformed), unname(coef_unscaled["x1:x2:x3"]), tolerance = 1e-10) - # Test two-way interactions (receive contributions from 3-way interaction) + # For lower-order terms: get_scale_transformation returns MARGINAL transformation. + # Verify b = L2 norm, a = 0 + trans_x1x2 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) trans_x1x3 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x3", formula_scale) trans_x2x3 <- get_scale_transformation(fit = mock_fit, "mu_x2__xXx__x3", formula_scale) - - coef_x1x2_transformed <- trans_x1x2$transformation_arguments$a + - trans_x1x2$transformation_arguments$b * coef_scaled["scale(x1):scale(x2)"] - coef_x1x3_transformed <- trans_x1x3$transformation_arguments$a + - trans_x1x3$transformation_arguments$b * coef_scaled["scale(x1):scale(x3)"] - coef_x2x3_transformed <- trans_x2x3$transformation_arguments$a + - trans_x2x3$transformation_arguments$b * coef_scaled["scale(x2):scale(x3)"] - - expect_equal(unname(coef_x1x2_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) - expect_equal(unname(coef_x1x3_transformed), unname(coef_unscaled["x1:x3"]), tolerance = 1e-10) - expect_equal(unname(coef_x2x3_transformed), unname(coef_unscaled["x2:x3"]), tolerance = 1e-10) - - # Test main effects (receive contributions from 2-way and 3-way interactions) trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) trans_x3 <- get_scale_transformation(fit = mock_fit, "mu_x3", formula_scale) - coef_x1_transformed <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] - coef_x2_transformed <- trans_x2$transformation_arguments$a + - trans_x2$transformation_arguments$b * coef_scaled["scale(x2)"] - coef_x3_transformed <- trans_x3$transformation_arguments$a + - trans_x3$transformation_arguments$b * coef_scaled["scale(x3)"] - - expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) - expect_equal(unname(coef_x2_transformed), unname(coef_unscaled["x2"]), tolerance = 1e-10) - expect_equal(unname(coef_x3_transformed), unname(coef_unscaled["x3"]), tolerance = 1e-10) - - # Test intercept + # Build the unscale matrix to compute expected L2 norms + all_terms <- c("mu_intercept", "mu_x1", "mu_x2", "mu_x3", + "mu_x1__xXx__x2", "mu_x1__xXx__x3", "mu_x2__xXx__x3", + "mu_x1__xXx__x2__xXx__x3") + M <- .build_unscale_matrix(all_terms, formula_scale[["mu"]], "mu") + + # Non-intercept columns for L2 norm calculation + non_int_cols <- setdiff(all_terms, "mu_intercept") + + # Validate L2 norms for two-way interactions + expected_b_x1x2 <- sqrt(sum(M["mu_x1__xXx__x2", non_int_cols]^2)) + expected_b_x1x3 <- sqrt(sum(M["mu_x1__xXx__x3", non_int_cols]^2)) + expected_b_x2x3 <- sqrt(sum(M["mu_x2__xXx__x3", non_int_cols]^2)) + + expect_equal(trans_x1x2$transformation_arguments$b, expected_b_x1x2, tolerance = 1e-10) + expect_equal(trans_x1x3$transformation_arguments$b, expected_b_x1x3, tolerance = 1e-10) + expect_equal(trans_x2x3$transformation_arguments$b, expected_b_x2x3, tolerance = 1e-10) + + # Validate L2 norms for main effects + expected_b_x1 <- sqrt(sum(M["mu_x1", non_int_cols]^2)) + expected_b_x2 <- sqrt(sum(M["mu_x2", non_int_cols]^2)) + expected_b_x3 <- sqrt(sum(M["mu_x3", non_int_cols]^2)) + + expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) + expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) + expect_equal(trans_x3$transformation_arguments$b, expected_b_x3, tolerance = 1e-10) + + # All non-intercept terms should have a = 0 (marginal transformation is centered) + expect_equal(trans_x1x2$transformation_arguments$a, 0) + expect_equal(trans_x1x3$transformation_arguments$a, 0) + expect_equal(trans_x2x3$transformation_arguments$a, 0) + expect_equal(trans_x1$transformation_arguments$a, 0) + expect_equal(trans_x2$transformation_arguments$a, 0) + expect_equal(trans_x3$transformation_arguments$a, 0) + + # Test intercept: uses L2 norm of ENTIRE row (all columns) + # The variance includes contributions from coefficient priors via off-diagonal terms trans_intercept <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - coef_intercept_transformed <- trans_intercept$transformation_arguments$a + - trans_intercept$transformation_arguments$b * coef_scaled["(Intercept)"] + # Intercept should have a = 0, b = L2 norm of full row + expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) + expect_equal(trans_intercept$transformation_arguments$a, 0) + expect_equal(trans_intercept$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - expect_equal(unname(coef_intercept_transformed), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) + # NOTE: For point transformation of posterior samples (including intercept), + # use transform_scale_samples() which applies the full matrix multiplication. }) @@ -1724,19 +1795,15 @@ test_that("lm validation: get_scale_transformation for partial scaling", { posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) mock_fit <- .make_mock_fit(posterior_scaled) - # Test x1 coefficient + # Test x1 coefficient - marginal transformation has a = 0 trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - - coef_x1_transformed <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] - - expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) + expect_equal(trans_x1$transformation_arguments$a, 0) # x2 is not scaled, so transformation should return NULL trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) expect_null(trans_x2) - # Interaction involves x1 which is scaled + # Interaction involves x1 which is scaled - highest order, so marginal = conditional trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) coef_int_transformed <- trans_interaction$transformation_arguments$a + @@ -1746,10 +1813,10 @@ test_that("lm validation: get_scale_transformation for partial scaling", { }) -test_that("lm validation: get_scale_transformation matches transform_scale_samples", { +test_that("lm validation: get_scale_transformation returns marginal transformation", { - # This test verifies that applying get_scale_transformation to each coefficient - # produces the same result as transform_scale_samples for the full posterior + # This test verifies that get_scale_transformation returns the MARGINAL transformation + # for prior visualization. For posterior sample transformation, use transform_scale_samples. set.seed(789) df <- data.frame( @@ -1772,59 +1839,47 @@ test_that("lm validation: get_scale_transformation matches transform_scale_sampl posterior_scaled <- .lm_coefs_to_posterior(coef_scaled, n_rep = 50) mock_fit <- .make_mock_fit(posterior_scaled) - # Apply transform_scale_samples (the reference implementation) - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - - # Get individual transformations and apply them - # For the highest-order term (interaction), transformation is simple + # Get individual transformations trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) - transformed_interaction <- trans_interaction$transformation_arguments$a + - trans_interaction$transformation_arguments$b * posterior_scaled[1, "mu_x1__xXx__x2"] - - expect_equal( - unname(transformed_interaction), - unname(posterior_transformed[1, "mu_x1__xXx__x2"]), - tolerance = 1e-10, - info = "Parameter: mu_x1__xXx__x2" - ) - - # For main effects and intercept, the transformation includes offset from other terms trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) trans_int <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - transformed_x1 <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * posterior_scaled[1, "mu_x1"] - transformed_x2 <- trans_x2$transformation_arguments$a + - trans_x2$transformation_arguments$b * posterior_scaled[1, "mu_x2"] - transformed_int <- trans_int$transformation_arguments$a + - trans_int$transformation_arguments$b * posterior_scaled[1, "mu_intercept"] + # For highest-order term (interaction): marginal = conditional, point transform works + transformed_interaction <- trans_interaction$transformation_arguments$a + + trans_interaction$transformation_arguments$b * posterior_scaled[1, "mu_x1__xXx__x2"] - expect_equal( - unname(transformed_x1), - unname(posterior_transformed[1, "mu_x1"]), - tolerance = 1e-10, - info = "Parameter: mu_x1" - ) + expect_equal(unname(transformed_interaction), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) - expect_equal( - unname(transformed_x2), - unname(posterior_transformed[1, "mu_x2"]), - tolerance = 1e-10, - info = "Parameter: mu_x2" + # For main effects: marginal transformation has a = 0 and b = L2 norm + expect_equal(trans_x1$transformation_arguments$a, 0) + expect_equal(trans_x2$transformation_arguments$a, 0) + + # Build unscale matrix to verify L2 norm calculation + M <- .build_unscale_matrix( + c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2"), + formula_scale[["mu"]], + "mu" ) + expected_b_x1 <- sqrt(sum(M["mu_x1", c("mu_x1", "mu_x1__xXx__x2")]^2)) + expected_b_x2 <- sqrt(sum(M["mu_x2", c("mu_x2", "mu_x1__xXx__x2")]^2)) + + expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) + expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) + + # For intercept: uses L2 norm of ENTIRE row (all columns) + expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) + expect_equal(trans_int$transformation_arguments$a, 0) + expect_equal(trans_int$transformation_arguments$b, expected_b_int, tolerance = 1e-10) + + # NOTE: For point transformation of posterior samples, use transform_scale_samples() + posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) expect_equal( - unname(transformed_int), unname(posterior_transformed[1, "mu_intercept"]), - tolerance = 1e-10, - info = "Parameter: mu_intercept" + unname(coef_unscaled["(Intercept)"]), + tolerance = 1e-10 ) - - # Also verify against unscaled lm coefficients - expect_equal(unname(transformed_x1), unname(coef_unscaled["x1"]), tolerance = 1e-10) - expect_equal(unname(transformed_x2), unname(coef_unscaled["x2"]), tolerance = 1e-10) - expect_equal(unname(transformed_int), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) }) @@ -1853,15 +1908,11 @@ test_that("lm validation: get_scale_transformation with factor + continuous inte posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) mock_fit <- .make_mock_fit(posterior_scaled) - # Test main effect of x1 + # Test main effect of x1 - marginal transformation has a = 0 trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) + expect_equal(trans_x1$transformation_arguments$a, 0) - coef_x1_transformed <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] - - expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) - - # Test interaction (x1:f1b involves scaled x1) + # Test interaction (x1:f1b involves scaled x1) - highest order, marginal = conditional trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__f1b", formula_scale) coef_int_transformed <- trans_interaction$transformation_arguments$a + diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-model-averaging-plots.R index f23895e..006c55c 100644 --- a/tests/testthat/test-model-averaging-plots.R +++ b/tests/testthat/test-model-averaging-plots.R @@ -571,7 +571,7 @@ test_that("exp_lin transformation functions are defined correctly", { }) -test_that("get_scale_transformation with cached fit plots correctly", { +test_that("get_scale_transformation prior/posterior plots with cached fit", { set.seed(1) skip_if_not_installed("rjags") skip_on_cran() @@ -584,98 +584,93 @@ test_that("get_scale_transformation with cached fit plots correctly", { # Create priors matching those used in test-00-model-fits.R prior_x_cont <- prior("normal", list(0, 1)) prior_x_int <- prior("normal", list(0, 1)) + prior_intercept <- prior("normal", list(0, 5)) # Get transformations for the scaled parameters - trans_x1 <- get_scale_transformation("mu_x_cont1", formula_scale, fit = fit) - trans_x2 <- get_scale_transformation("mu_x_cont2", formula_scale, fit = fit) - trans_int <- get_scale_transformation("mu_x_cont1__xXx__x_cont2", formula_scale, fit = fit) - trans_intercept <- get_scale_transformation("mu_intercept", formula_scale, fit = fit) + # get_scale_transformation now returns MARGINAL transformation by default, - # Side-by-side: Standardized prior (left) vs Unscaled prior (right) for x_cont1 - vdiffr::expect_doppelganger("scale-transform-x1-standardized", function() { - plot(prior_x_cont, main = "x_cont1 (standardized)") - }) - - vdiffr::expect_doppelganger("scale-transform-x1-unscaled", function() { - plot(prior_x_cont, - transformation = trans_x1$transformation, - transformation_arguments = trans_x1$transformation_arguments, - main = "x_cont1 (unscaled)") - }) - - # Side-by-side: Standardized prior (left) vs Unscaled prior (right) for interaction - vdiffr::expect_doppelganger("scale-transform-interaction-standardized", function() { - plot(prior_x_int, main = "x1:x2 (standardized)") - }) - - vdiffr::expect_doppelganger("scale-transform-interaction-unscaled", function() { - plot(prior_x_int, - transformation = trans_int$transformation, - transformation_arguments = trans_int$transformation_arguments, - main = "x1:x2 (unscaled)") - }) -}) - - -test_that("get_scale_transformation posterior plots with cached fit", { - set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() - skip_if_no_fits() - - # Load the auto-scaled fit - fit <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) - formula_scale <- attr(fit, "formula_scale") + # using L2 norm of transformation coefficients for correct prior visualization + trans_x1 <- get_scale_transformation(fit, "mu_x_cont1", formula_scale) + trans_int <- get_scale_transformation(fit, "mu_x_cont1__xXx__x_cont2", formula_scale) + trans_intercept <- get_scale_transformation(fit, "mu_intercept", formula_scale) - # Create priors matching those used in test-00-model-fits.R - prior_x_cont <- prior("normal", list(0, 1)) - prior_x_int <- prior("normal", list(0, 1)) + # Extract posterior samples and transform back to original scale + posterior <- as.matrix(coda::as.mcmc.list(fit)) + posterior_transformed <- transform_scale_samples(posterior, formula_scale) - # Get transformations - trans_x1 <- get_scale_transformation("mu_x_cont1", formula_scale, fit = fit) - trans_int <- get_scale_transformation("mu_x_cont1__xXx__x_cont2", formula_scale, fit = fit) + posterior_x1_unscaled <- posterior_transformed[, "mu_x_cont1"] + posterior_int_unscaled <- posterior_transformed[, "mu_x_cont1__xXx__x_cont2"] + posterior_intercept_unscaled <- posterior_transformed[, "mu_intercept"] - # Extract posterior samples - posterior <- as.matrix(coda::as.mcmc.list(fit)) + # 1x2 layout for x_cont1: scaled | unscaled + vdiffr::expect_doppelganger("scale-transform-x1-1x2", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(oldpar)) + par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) - # Side-by-side posterior plots: Standardized vs Unscaled - vdiffr::expect_doppelganger("scale-posterior-x1-standardized", function() { - hist(posterior[, "mu_x_cont1"], breaks = 30, probability = TRUE, - main = "mu_x_cont1 posterior (standardized)", xlab = "") + # Scaled panel: histogram of scaled posterior with posterior density and prior + hist(posterior[, "mu_x_cont1"], breaks = 50, probability = TRUE, + main = "x_cont1 (scaled)", xlab = "") + lines(stats::density(posterior[, "mu_x_cont1"]), col = "blue", lwd = 2) lines(prior_x_cont, col = "red", lwd = 2) - }) - # Apply transformation to posterior for unscaled plot - posterior_x1_unscaled <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * posterior[, "mu_x_cont1"] - - vdiffr::expect_doppelganger("scale-posterior-x1-unscaled", function() { - hist(posterior_x1_unscaled, breaks = 30, probability = TRUE, - main = "mu_x_cont1 posterior (unscaled)", xlab = "") + # Unscaled panel: histogram of unscaled posterior with density and transformed prior + hist(posterior_x1_unscaled, breaks = 50, probability = TRUE, + main = "x_cont1 (unscaled)", xlab = "") + lines(stats::density(posterior_x1_unscaled), col = "blue", lwd = 2) # Use transformed posterior + lines(stats::density( + trans_x1$transformation_arguments$a + trans_x1$transformation_arguments$b * posterior[, "mu_x_cont1"]), + col = "blue", lwd = 2, lty = 2) lines(prior_x_cont, transformation = trans_x1$transformation, transformation_arguments = trans_x1$transformation_arguments, col = "red", lwd = 2) }) - # Interaction term - posterior_int_unscaled <- trans_int$transformation_arguments$a + - trans_int$transformation_arguments$b * posterior[, "mu_x_cont1__xXx__x_cont2"] + # 1x2 layout for interaction: scaled | unscaled + vdiffr::expect_doppelganger("scale-transform-interaction-1x2", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(oldpar)) + par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) - vdiffr::expect_doppelganger("scale-posterior-interaction-standardized", function() { + # Scaled panel: histogram of scaled posterior with posterior density and prior hist(posterior[, "mu_x_cont1__xXx__x_cont2"], breaks = 30, probability = TRUE, - main = "interaction posterior (standardized)", xlab = "") + main = "x1:x2 (scaled)", xlab = "") + lines(stats::density(posterior[, "mu_x_cont1__xXx__x_cont2"]), col = "blue", lwd = 2) lines(prior_x_int, col = "red", lwd = 2) - }) - vdiffr::expect_doppelganger("scale-posterior-interaction-unscaled", function() { + # Unscaled panel: histogram of unscaled posterior with density and transformed prior hist(posterior_int_unscaled, breaks = 30, probability = TRUE, - main = "interaction posterior (unscaled)", xlab = "") + main = "x1:x2 (unscaled)", xlab = "") + lines(stats::density(posterior_int_unscaled), col = "blue", lwd = 2) lines(prior_x_int, transformation = trans_int$transformation, transformation_arguments = trans_int$transformation_arguments, col = "red", lwd = 2) }) + + # 1x2 layout for intercept: scaled | unscaled + # Intercept uses MARGINAL transformation (L2 norm of entire row) + vdiffr::expect_doppelganger("scale-transform-intercept-1x2", function() { + oldpar <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(oldpar)) + par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) + + # Scaled panel: histogram of scaled posterior with posterior density and prior + hist(posterior[, "mu_intercept"], breaks = 30, probability = TRUE, + main = "intercept (scaled)", xlab = "") + lines(stats::density(posterior[, "mu_intercept"]), col = "blue", lwd = 2) + lines(prior_intercept, col = "red", lwd = 2) + + # Unscaled panel: histogram of unscaled posterior with density and transformed prior + hist(posterior_intercept_unscaled, breaks = 30, probability = TRUE, + main = "intercept (unscaled)", xlab = "") + lines(stats::density(posterior_intercept_unscaled), col = "blue", lwd = 2) + lines(prior_intercept, + transformation = trans_intercept$transformation, + transformation_arguments = trans_intercept$transformation_arguments, + col = "red", lwd = 2) + }) }) @@ -693,13 +688,13 @@ test_that("get_scale_transformation with dual parameter model (log intercept)", prior_mu_x <- prior("normal", list(0, 1)) prior_ls_x <- prior("normal", list(0, 0.5)) - # Get transformations for mu (standard intercept) - trans_mu_x <- get_scale_transformation("mu_x_mu", formula_scale, fit = fit) - trans_mu_int <- get_scale_transformation("mu_intercept", formula_scale, fit = fit) + # Get transformations for mu (standard intercept) - fit must be first argument + trans_mu_x <- get_scale_transformation(fit, "mu_x_mu", formula_scale) + trans_mu_int <- get_scale_transformation(fit, "mu_intercept", formula_scale) # Get transformations for log_sigma (log intercept) - trans_ls_x <- get_scale_transformation("log_sigma_x_sigma", formula_scale, fit = fit) - trans_ls_int <- get_scale_transformation("log_sigma_intercept", formula_scale, fit = fit) + trans_ls_x <- get_scale_transformation(fit, "log_sigma_x_sigma", formula_scale) + trans_ls_int <- get_scale_transformation(fit, "log_sigma_intercept", formula_scale) # Verify log_sigma intercept uses exp_lin transformation expect_equal(trans_ls_int$transformation, "exp_lin") @@ -768,4 +763,4 @@ test_that("linear transformation matches expected behavior", { transformation = "lin", transformation_arguments = list(a = 2, b = 0.5)) }) -}) \ No newline at end of file +}) From 03a38f2ba0164938ce98482eed9da766025a9bb2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= Date: Sun, 1 Feb 2026 16:19:58 +0100 Subject: [PATCH 38/38] Add transform_prior_samples and scaled prior plotting support Introduces transform_prior_samples() to generate and transform prior samples to the original (unscaled) scale using the same matrix transformation as posterior samples. Updates as_mixed_posteriors() and plot_posterior() to support transform_scaled, enabling correct visualization of priors and posteriors on the original scale when using standardized predictors. Removes get_scale_transformation and related documentation, and updates tests and documentation accordingly. --- .Rbuildignore | 1 + NAMESPACE | 2 +- NEWS.md | 3 +- R/JAGS-formula.R | 405 +++++------- R/model-averaging-plots.R | 97 ++- R/model-averaging.R | 33 +- man/as_mixed_posteriors.Rd | 13 +- man/get_scale_transformation.Rd | 71 --- man/plot_marginal.Rd | 4 +- man/plot_models.Rd | 6 +- man/plot_posterior.Rd | 12 +- man/transform_prior_samples.Rd | 56 ++ plan-transform-scaled-plot-posterior.md | 591 ------------------ .../dual-log-sigma-x-standardized.svg | 83 --- .../dual-log-sigma-x-unscaled.svg | 80 --- .../dual-mu-x-standardized.svg | 85 --- .../dual-mu-x-unscaled.svg | 86 --- .../scale-transform-interaction-1x2.svg | 185 ------ .../scale-transform-intercept-1x2.svg | 176 ------ .../scale-transform-x1-1x2.svg | 256 -------- .../transform-scaled-all-params-grid.svg | 296 +++++++++ ...ansform-scaled-coef-x-cont1-comparison.svg | 106 ++++ ...ansform-scaled-coef-x-cont2-comparison.svg | 112 ++++ .../transform-scaled-dual-param-intercept.svg | 200 ++++++ .../transform-scaled-intercept-comparison.svg | 118 ++++ tests/testthat/test-JAGS-formula-scale.R | 550 +--------------- tests/testthat/test-model-averaging-plots.R | 303 +++++---- 27 files changed, 1351 insertions(+), 2579 deletions(-) delete mode 100644 man/get_scale_transformation.Rd create mode 100644 man/transform_prior_samples.Rd delete mode 100644 plan-transform-scaled-plot-posterior.md delete mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg delete mode 100644 tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/transform-scaled-all-params-grid.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont1-comparison.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont2-comparison.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/transform-scaled-dual-param-intercept.svg create mode 100644 tests/testthat/_snaps/model-averaging-plots/transform-scaled-intercept-comparison.svg diff --git a/.Rbuildignore b/.Rbuildignore index 1b29c38..b9e417c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ ^doc$ ^Meta$ ^tests +^\.vscode$ diff --git a/NAMESPACE b/NAMESPACE index 3f722f1..ba374ef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -81,7 +81,6 @@ export(format_BF) export(format_parameter_names) export(geom_prior) export(geom_prior_list) -export(get_scale_transformation) export(inclusion_BF) export(interpret) export(interpret2) @@ -164,6 +163,7 @@ export(stan_estimates_table) export(transform_factor_samples) export(transform_meandif_samples) export(transform_orthonormal_samples) +export(transform_prior_samples) export(transform_scale_samples) export(var) export(weightfunctions_mapping) diff --git a/NEWS.md b/NEWS.md index d2b196b..b2f9008 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,8 @@ - adds support for `__default_factor` and `__default_continuous` priors in `JAGS_formula()` - when specified in the `prior_list`, these are used as default priors for factor and continuous predictors that are not explicitly specified - adds automatic standardization of continuous predictors via `formula_scale` parameter in `JAGS_formula()` and `JAGS_fit()` - improves MCMC sampling efficiency and numerical stability - adds `transform_scale_samples()` function to transform posterior samples back to original scale after standardization -- adds `get_scale_transformation()` function to extract linear transformation parameters from `formula_scale` for use with plotting functions via `transformation` and `transformation_arguments` parameters - enables plotting priors/posteriors on the original (unscaled) predictor scale +- adds `transform_prior_samples()` function to generate and transform prior samples using the same matrix transformation as posterior samples - enables correct visualization of priors on the original (unscaled) predictor scale, including proper handling of the intercept which depends on multiple coefficient priors +- adds `transform_scaled` argument to `plot_posterior()` for visualizing prior and posterior distributions on the original (unscaled) scale when using formula-based models with auto-scaling - adds `exp_lin` transformation type for log-intercept unscaling in density/plotting functions: `exp(a + b * log(x))` - adds `log(intercept)` formula attribute for specifying models of the form `log(intercept) + sum(beta_i * x_i)` - useful for parameters that must be positive (e.g., standard deviation) while keeping the intercept on the original scale. Set via `attr(formula, "log(intercept)") <- TRUE`. Supported in `JAGS_formula()`, `JAGS_evaluate_formula()`, and marginal likelihood computation - adds advanced parameter filtering options to `runjags_estimates_table()`: diff --git a/R/JAGS-formula.R b/R/JAGS-formula.R index 75bdbed..da986ff 100644 --- a/R/JAGS-formula.R +++ b/R/JAGS-formula.R @@ -1458,306 +1458,203 @@ transform_scale_samples <- function(fit, formula_scale = NULL){ } -#' @title Get scale transformation for plotting +#' @title Transform prior samples to original scale #' -#' @description Extracts linear transformation parameters from scaling information -#' that can be used with plotting functions via \code{transformation} and -#' \code{transformation_arguments} parameters. +#' @description Generate prior samples and transform them using the same +#' matrix transformation as posterior samples. This is the correct approach for +#' visualizing priors on the original (unscaled) scale, especially for the intercept +#' which depends on contributions from multiple coefficient priors. #' -#' @param parameter_name The full name of the parameter (e.g., \code{"mu_x1"}, -#' \code{"mu_intercept"}, or \code{"mu_x1__xXx__x2"} for interaction) -#' @param formula_scale Nested list containing standardization information keyed by -#' parameter name. Each parameter entry contains scaling info (mean and sd) for -#' each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}. -#' @param fit A fitted model object (e.g., from \code{JAGS_fit}) containing posterior -#' samples. Required for computing the transformation, as the offset depends on -#' posterior means of other coefficients when there are interactions in the model. -#' -#' @details -#' This function returns a \strong{marginal} transformation for visualizing -#' prior distributions on the original (unscaled) scale. The transformation -#' accounts for the variance contribution from interaction terms. -#' -#' For a simple coefficient (single predictor, no interactions), the transformation is: -#' \deqn{\beta_{orig} = \beta_z / \sigma_x} -#' which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. +#' @param fit a fitted model object with \code{prior_list} and optionally +#' \code{formula_scale} attributes +#' @param n_samples number of samples to generate (default: 10000) +#' @param seed random seed for reproducibility (optional) +#' @param formula_scale optional nested list containing standardization information. +#' If not provided, extracted from \code{fit} attribute. #' -#' For the highest-order interaction term (which receives no contributions from -#' higher-order terms), the transformation is similar: -#' \deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} +#' @details When models use auto-scaling (standardizing predictors), the posterior +#' samples are on the standardized scale. To correctly visualize priors on the +#' original scale, we cannot simply apply a linear transformation to individual +#' priors because the intercept on the original scale is a weighted sum of +#' multiple priors: #' -#' For main effects when interactions are present, the \code{b} coefficient is the -#' L2 norm of the transformation matrix row (excluding intercept). This captures -#' the total variance contribution from all related interaction terms: -#' \deqn{b = \sqrt{\sum_j M_{ij}^2}} -#' where the sum is over all non-intercept terms that receive contributions from -#' the standardized coefficient. +#' \deqn{\beta_0^{orig} = \beta_0^* - \sum_i \frac{\mu_i}{\sigma_i} \beta_i^*} #' -#' For intercepts, the diagonal coefficient is used (\code{b = 1}). This is because -#' the intercept prior itself doesn't get scaled - it's the same on both the -#' standardized and original scales. The L2 norm approach would be incorrect -#' because the intercept row mixes contributions from different priors -#' (intercept prior vs coefficient priors). -#' -#' For intercepts with \code{log_intercept = TRUE}, the transformation is: -#' \deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} -#' which uses the \code{"exp_lin"} transformation type. -#' -#' \strong{Important:} For transforming posterior samples, use -#' \code{\link{transform_scale_samples}} instead, which correctly applies the -#' full matrix transformation to all parameters simultaneously. + +#' This function generates samples from ALL priors simultaneously and applies +#' the same matrix transformation used for posterior samples, which correctly +#' handles the intercept and all other parameters. #' -#' @return A list with elements: -#' \describe{ -#' \item{\code{transformation}}{Character string (\code{"lin"} or \code{"exp_lin"}).} -#' \item{\code{transformation_arguments}}{A named list with \code{a} (offset) and -#' \code{b} (scale factor).} -#' } -#' Returns \code{NULL} if no transformation is needed (parameter not affected by scaling). +#' @return A matrix of prior samples on the original (unscaled) scale, with +#' columns matching the structure of posterior samples. #' -#' @seealso [transform_scale_samples()] [plot_posterior()] [plot_prior_list()] +#' @seealso [transform_scale_samples()] [plot_posterior()] #' #' @examples -#' # With a fitted model -#' # trans <- get_scale_transformation(fit, "mu_x1") -#' # Returns: list(transformation = "lin", transformation_arguments = list(a = offset, b = scale)) +#' # With a fitted model that used formula_scale: +#' # prior_samples <- transform_prior_samples(fit, n_samples = 10000) +#' # This can then be used with density() or for custom plotting #' #' @export -get_scale_transformation <- function(fit, parameter_name, formula_scale = NULL){ +transform_prior_samples <- function(fit, n_samples = 10000, seed = NULL, formula_scale = NULL){ - # fit is required - if(missing(fit) || is.null(fit)){ - stop("'fit' argument is required to compute the scale transformation.") - } - - check_char(parameter_name, "parameter_name", check_length = 1) - - # Extract formula_scale from fit if not provided - if(is.null(formula_scale)){ - formula_scale <- attr(fit, "formula_scale") - } - - if(is.null(formula_scale) || length(formula_scale) == 0){ - return(NULL) - } + check_int(n_samples, "n_samples", lower = 1) + check_int(seed, "seed", allow_NULL = TRUE) - check_list(formula_scale, "formula_scale") + # Extract prior_list from fit - # Get the parameter prefix from prior_list attribute prior_list <- attr(fit, "prior_list") if(is.null(prior_list)){ - stop("'fit' must have a 'prior_list' attribute.") + stop("'fit' must have 'prior_list' attribute.") } - if(!parameter_name %in% names(prior_list)){ - stop("Parameter '", parameter_name, "' not found in prior_list.") + # Extract formula_scale from fit if not provided + if(is.null(formula_scale)){ + formula_scale <- attr(fit, "formula_scale") } - prefix <- attr(prior_list[[parameter_name]], "parameter") - - if(is.null(prefix)){ - # Parameter not part of a formula (no scaling applies) - return(NULL) + # Get posterior column names for structure matching + if(inherits(fit, "runjags") || inherits(fit, "BayesTools_fit")){ + posterior <- as.matrix(.fit_to_posterior(fit)) + }else{ + stop("'fit' must be a fitted model object.") } - param_scale <- formula_scale[[prefix]] + # Generate prior samples matching posterior column structure + prior_samples <- .generate_prior_sample_matrix( + prior_list = prior_list, + n_samples = n_samples, + column_names = colnames(posterior), + seed = seed + ) - if(is.null(param_scale) || length(param_scale) == 0){ - return(NULL) + # Apply same transformation as posterior + if(!is.null(formula_scale) && length(formula_scale) > 0){ + prior_samples <- .apply_unscale_transform(prior_samples, formula_scale) } - # Get transformation using internal helper - result <- .get_scale_transformation_single(parameter_name, param_scale, prefix, fit) - - return(result) + return(prior_samples) } -# Internal helper to get transformation for a single parameter -# @param parameter_name The parameter name (e.g., "mu_x1" or "mu_intercept") -# @param formula_scale Flat list of scaling info for this prefix -# @param prefix The parameter prefix (e.g., "mu") -# @param fit Optional fit object containing posterior samples -# @return List with transformation and transformation_arguments, or NULL -.get_scale_transformation_single <- function(parameter_name, formula_scale, prefix, fit = NULL){ +# Helper: Generate a matrix of prior samples matching posterior structure +# +# @param prior_list Named list of prior objects +# @param n_samples Number of samples to generate +# @param column_names Optional vector of column names to match (filters output) +# @param seed Optional random seed +# @return Matrix with prior samples (rows = samples, columns = parameters) +.generate_prior_sample_matrix <- function(prior_list, n_samples, column_names = NULL, seed = NULL){ - if(is.null(formula_scale) || length(formula_scale) == 0){ - return(NULL) + if(!is.null(seed)){ + set.seed(seed) } - # Check if this parameter uses log(intercept) - log_intercept <- isTRUE(attr(formula_scale, "log_intercept")) - intercept_col <- paste0(prefix, "_intercept") - is_intercept <- (parameter_name == intercept_col) + # Determine which parameters to sample + param_names <- names(prior_list) - # Get scaled variable names (without prefix) - scaled_vars <- sub(paste0("^", prefix, "_"), "", names(formula_scale)) + if(is.null(param_names) || length(param_names) == 0){ + stop("'prior_list' must be a named list of priors.") + } - # Parse the parameter to understand its components - term_components <- .parse_term_components(parameter_name, prefix) + # Initialize list to collect samples (handles varying column counts per prior) + samples_list <- list() - # Check if parameter is affected by scaling - if(length(term_components) == 0){ - # Intercept case - if(!is_intercept){ - return(NULL) - } - }else{ - # Check if any components are scaled - if(!any(term_components %in% scaled_vars)){ - return(NULL) - } - } + for(param_name in param_names){ + prior <- prior_list[[param_name]] - # For the highest-order terms (interaction terms that don't receive contributions - # from any higher-order terms), we can compute the scale factor directly - # Check if there are any higher-order terms that could contribute to this term - has_higher_order_contributions <- FALSE - if(length(term_components) > 0 && !is_intercept){ - # This term could receive contributions from terms with MORE components - # that include all of this term's components - # For now, we check if fit is NULL - if so, we can only return marginal transformation - if(!is.null(fit)){ - # We'll use the full matrix approach to check for contributions - affected_cols <- c(intercept_col, names(formula_scale)) - - # Get posterior to find all available columns - posterior <- as.matrix(coda::as.mcmc.list(fit)) - available_cols <- intersect(affected_cols, colnames(posterior)) - - # Also include interaction terms from posterior - all_posterior_cols <- colnames(posterior) - prefix_pattern <- paste0("^", prefix, "_") - param_cols <- all_posterior_cols[grepl(prefix_pattern, all_posterior_cols)] - affected_cols <- union(affected_cols, param_cols) - affected_cols <- intersect(affected_cols, all_posterior_cols) - - if(length(affected_cols) > 1){ - # Build the transformation matrix - M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) - - # Find row for our parameter - param_row <- which(rownames(M) == parameter_name) - if(length(param_row) > 0){ - transform_row <- M[param_row, , drop = TRUE] - - # Check if there are non-zero off-diagonal entries - other_cols <- setdiff(names(transform_row), parameter_name) - other_coeffs <- transform_row[other_cols] - if(any(!is.na(other_coeffs) & other_coeffs != 0)){ - has_higher_order_contributions <- TRUE - } - } - } - } - } + if(is.null(prior)){ + # No prior for this parameter - use zeros + samples_list[[param_name]] <- matrix(0, nrow = n_samples, ncol = 1) + colnames(samples_list[[param_name]]) <- param_name - # For interaction terms without higher-order contributions, use simple formula - if(length(term_components) > 0 && !is_intercept && !has_higher_order_contributions){ - # Identify which components are scaled - scaled_components <- term_components[term_components %in% scaled_vars] - - if(length(scaled_components) > 0){ - # The scale factor is the product of 1/sd for all scaled components - sd_product <- 1 - for(comp in scaled_components){ - comp_name <- paste0(prefix, "_", comp) - if(comp_name %in% names(formula_scale)){ - sd_product <- sd_product * formula_scale[[comp_name]]$sd - } - } - scale_factor <- 1 / sd_product + }else if(is.prior.none(prior)){ + # No effect prior - use zeros + samples_list[[param_name]] <- matrix(0, nrow = n_samples, ncol = 1) + colnames(samples_list[[param_name]]) <- param_name - return(list( - transformation = "lin", - transformation_arguments = list(a = 0, b = unname(scale_factor)) - )) - } - } + }else if(is.prior.point(prior)){ + # Point prior - constant values + samples_list[[param_name]] <- matrix( + prior$parameters[["location"]], + nrow = n_samples, + ncol = 1 + ) + colnames(samples_list[[param_name]]) <- param_name + + }else if(is.prior.factor(prior)){ + # Factor priors return matrix from rng + temp_samples <- rng(prior, n_samples, transform_factor_samples = TRUE) + if(is.matrix(temp_samples)){ + # Multiple columns for factor levels + n_levels <- ncol(temp_samples) + col_names <- paste0(param_name, "[", 1:n_levels, "]") + colnames(temp_samples) <- col_names + samples_list[[param_name]] <- temp_samples + }else{ + # Single column + samples_list[[param_name]] <- matrix(temp_samples, nrow = n_samples, ncol = 1) + colnames(samples_list[[param_name]]) <- param_name + } - # For terms with contributions from higher-order terms (or intercept), - # we need the full transformation matrix - # Build affected_cols including all scaled predictors and the intercept - affected_cols <- c(intercept_col, names(formula_scale)) - - # If fit is available, also include interaction terms from posterior - if(!is.null(fit)){ - posterior <- as.matrix(coda::as.mcmc.list(fit)) - all_posterior_cols <- colnames(posterior) - prefix_pattern <- paste0("^", prefix, "_") - param_cols <- all_posterior_cols[grepl(prefix_pattern, all_posterior_cols)] - affected_cols <- union(affected_cols, param_cols) - affected_cols <- intersect(affected_cols, all_posterior_cols) - } + }else if(is.prior.simple(prior)){ + # Simple priors - single column + samples_list[[param_name]] <- matrix( + rng(prior, n_samples), + nrow = n_samples, + ncol = 1 + ) + colnames(samples_list[[param_name]]) <- param_name + + }else if(is.prior.vector(prior)){ + # Vector priors return matrix from rng + temp_samples <- rng(prior, n_samples) + if(is.matrix(temp_samples)){ + n_cols <- ncol(temp_samples) + col_names <- paste0(param_name, "[", 1:n_cols, "]") + colnames(temp_samples) <- col_names + samples_list[[param_name]] <- temp_samples + }else{ + samples_list[[param_name]] <- matrix(temp_samples, nrow = n_samples, ncol = 1) + colnames(samples_list[[param_name]]) <- param_name + } - # Build the transformation matrix - M <- .build_unscale_matrix(affected_cols, formula_scale, prefix) + }else{ + # Fallback for other prior types - try rng + temp_samples <- tryCatch( + rng(prior, n_samples), + error = function(e){ + warning(sprintf("Could not generate samples for prior '%s': %s. Using zeros.", + param_name, e$message)) + rep(0, n_samples) + } + ) - # Find row for our parameter - param_row <- which(rownames(M) == parameter_name) - if(length(param_row) == 0){ - return(NULL) + if(is.matrix(temp_samples)){ + n_cols <- ncol(temp_samples) + col_names <- paste0(param_name, "[", 1:n_cols, "]") + colnames(temp_samples) <- col_names + samples_list[[param_name]] <- temp_samples + }else{ + samples_list[[param_name]] <- matrix(temp_samples, nrow = n_samples, ncol = 1) + colnames(samples_list[[param_name]]) <- param_name + } + } } - # Extract the transformation coefficients - transform_row <- M[param_row, , drop = TRUE] - - # The self-coefficient is the diagonal entry - self_coef <- unname(transform_row[parameter_name]) - if(is.na(self_coef)) self_coef <- 1 - - # For non-intercept terms: compute the MARGINAL transformation. - # This is for prior visualization where we don't have samples of interaction terms. - # The b coefficient is the L2 norm of the transformation matrix row (excluding intercept), - # which captures the total variance contribution from all related terms. - # - # For intercept: use b = 1 (diagonal coefficient). The intercept prior itself - # doesn't get scaled - only the offset changes (which is 0 under centered priors). - # The L2 norm approach would be wrong because the intercept row mixes contributions - - # from DIFFERENT priors (intercept prior vs coefficient priors). - - if(!is_intercept){ - # Marginal transformation: a = 0 (prior is centered), b = L2 norm of row - # Exclude intercept column from L2 norm calculation since we're looking at - # the effect of this coefficient, not the intercept contribution - non_intercept_cols <- setdiff(names(transform_row), intercept_col) - row_vals <- transform_row[non_intercept_cols] - row_vals <- row_vals[!is.na(row_vals)] - - b_marginal <- sqrt(sum(row_vals^2)) - - return(list( - transformation = "lin", - transformation_arguments = list(a = 0, b = b_marginal) - )) - }else{ - # Intercept: use L2 norm of ENTIRE row (all columns) - # The intercept on the original scale is: - # beta_0 = beta_0* - (mean(x1)/sd(x1)) * beta_1* - (mean(x2)/sd(x2)) * beta_2* - ... - # - # The variance of the marginal prior for beta_0 includes contributions from - # ALL coefficient priors via the off-diagonal terms. The L2 norm captures this: - # Var(beta_0) = Var(beta_0*) * 1^2 + Var(beta_1*) * (mean(x1)/sd(x1))^2 + ... - # - # For the shift 'a': if priors are centered at 0, the expected value is still 0. - # TODO: If priors have non-zero means, compute a = sum(M[i,j] * E[beta_j*]) - row_vals <- transform_row[!is.na(transform_row)] - b_marginal <- sqrt(sum(row_vals^2)) + # Combine all samples into one matrix + samples <- do.call(cbind, samples_list) - if(log_intercept){ - return(list( - transformation = "exp_lin", - transformation_arguments = list(a = 0, b = b_marginal) - )) - }else{ - return(list( - transformation = "lin", - transformation_arguments = list(a = 0, b = b_marginal) - )) + # Filter to match column_names if provided + if(!is.null(column_names)){ + available_cols <- intersect(column_names, colnames(samples)) + if(length(available_cols) > 0){ + samples <- samples[, available_cols, drop = FALSE] } } + + return(samples) } diff --git a/R/model-averaging-plots.R b/R/model-averaging-plots.R index a761467..554986e 100644 --- a/R/model-averaging-plots.R +++ b/R/model-averaging-plots.R @@ -972,12 +972,14 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @title Plot samples from the mixed posterior distributions #' #' @param samples samples from a posterior distribution for a -#' parameter generated by [mix_posteriors]. +#' parameter generated by [mix_posteriors] or [as_mixed_posteriors]. #' @param parameter parameter name to be plotted. Use \code{"PETPEESE"} #' for PET-PEESE plot with parameters \code{"PET"} and \code{"PEESE"}, #' and \code{"weightfunction"} for plotting a weightfunction with #' parameters \code{"omega"}. -#' @param prior whether prior distribution should be added to the figure +#' @param prior whether prior distribution should be added to the figure. +#' When samples were prepared with \code{as_mixed_posteriors(..., transform_scaled = TRUE)}, +#' the transformed prior samples are automatically used. #' @param effect_direction direction of the effect for PET-PEESE #' regression. Use \code{"positive"} (default) for #' \code{mu + PET*se + PEESE*se^2} or \code{"negative"} for @@ -987,6 +989,12 @@ geom_prior_list <- function(prior_list, xlim = NULL, x_seq = NULL, x_range_quan #' @inheritParams density.prior #' @inheritParams plot.prior #' +#' @details +#' When using scaled predictors (via \code{formula_scale_list} in [JAGS_fit]), +#' you can plot posteriors on the original (unscaled) scale by preparing samples with +#' \code{as_mixed_posteriors(..., transform_scaled = TRUE)}. The function automatically +#' detects this and uses the pre-computed transformed prior samples when \code{prior = TRUE}. +#' #' @return \code{plot_posterior} returns either \code{NULL} or #' an object of class 'ggplot' if plot_type is \code{plot_type = "ggplot"}. #' @@ -996,7 +1004,8 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE n_points = 1000, n_samples = 10000, force_samples = FALSE, individual = FALSE, show_figures = NULL, transformation = NULL, transformation_arguments = NULL, transformation_settings = FALSE, - rescale_x = FALSE, par_name = NULL, effect_direction = "positive", dots_prior = list(), ...){ + rescale_x = FALSE, par_name = NULL, effect_direction = "positive", + dots_prior = list(), ...){ # check input check_list(samples, "prior_list") @@ -1021,6 +1030,19 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE parameter <- "PEESE" } + # auto-detect transform_scaled from samples attribute + transform_scaled <- isTRUE(attr(samples, "transform_scaled")) + + # handle transform_scaled: check for pre-computed prior samples + prior_samples_transformed <- NULL + if(transform_scaled && prior){ + prior_samples_transformed <- attr(samples, "prior_samples") + if(is.null(prior_samples_transformed)){ + stop("Samples were prepared with 'transform_scaled = TRUE' but no prior samples found. ", + "This should not happen - please report this as a bug.") + } + } + # get the plotting range dots <- list(...) xlim <- dots[["xlim"]] @@ -1313,10 +1335,24 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE # add priors, if requested if(prior){ - plot_data_prior <- .plot_data_prior_list.simple(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, - n_points = n_points, n_samples = n_samples, force_samples = force_samples, individual = individual, - transformation = transformation, transformation_arguments = transformation_arguments, - transformation_settings = transformation_settings) + # use transformed prior samples if available (from transform_scaled) + if(transform_scaled && !is.null(prior_samples_transformed) && parameter %in% colnames(prior_samples_transformed)){ + # Create plot data from transformed prior samples + plot_data_prior <- .plot_data_prior_samples_transformed( + prior_samples_transformed[, parameter], + prior_list = prior_list, + n_points = n_points, + x_range = xlim, + transformation = transformation, + transformation_arguments = transformation_arguments, + transformation_settings = transformation_settings + ) + }else{ + plot_data_prior <- .plot_data_prior_list.simple(prior_list, x_seq = NULL, x_range = xlim, x_range_quant = NULL, + n_points = n_points, n_samples = n_samples, force_samples = force_samples, individual = individual, + transformation = transformation, transformation_arguments = transformation_arguments, + transformation_settings = transformation_settings) + } # transplant common xlim and ylim plot_data_joined <- c(plot_data_prior, plot_data) @@ -1406,6 +1442,51 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE } } +# Helper function to create plot data from transformed prior samples +# This is used when transform_scaled = TRUE to visualize priors on the original scale +.plot_data_prior_samples_transformed <- function(prior_samples, prior_list, n_points, x_range = NULL, + transformation = NULL, transformation_arguments = NULL, + transformation_settings = FALSE){ + + x_points <- NULL + y_points <- NULL + x_den <- NULL + y_den <- NULL + + # Handle the samples as a simple density + if(length(prior_samples) > 0){ + args <- list(x = prior_samples, n = n_points) + + # Set range if provided + if(!is.null(x_range) && length(x_range) == 2){ + args$from <- x_range[1] + args$to <- x_range[2] + } + + # Get the density estimate + density_estimate <- do.call(stats::density, args) + x_den <- density_estimate$x + y_den <- density_estimate$y + + # Apply transformation if specified (for additional user transformations) + if(!is.null(transformation)){ + x_den <- .density.prior_transformation_x(x_den, transformation, transformation_arguments) + y_den <- .density.prior_transformation_y(x_den, y_den, transformation, transformation_arguments) + } + } + + # Create output object matching density.prior.simple structure + out <- list( + x = x_den, + y = y_den + ) + attr(out, "x_range") <- range(x_den, na.rm = TRUE) + attr(out, "y_range") <- range(y_den, na.rm = TRUE) + class(out) <- c("density.prior.simple", "density.prior") + + return(list(out)) +} + .plot_data_samples.simple <- function(samples, parameter, n_points, transformation, transformation_arguments, transformation_settings){ check_list(samples, "samples", check_names = parameter, allow_other = TRUE) @@ -1703,7 +1784,7 @@ plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE for (i in seq_along(prior_list)) { if (is.prior.none(prior_list[[i]])) { temp_weight <- prior_list[[i]][["prior_weights"]] - prior_list[[i]] <- prior("spike", parameter = list(1)) + prior_list[[i]] <- prior("spike", parameters = list(location = 1)) prior_list[[i]][["prior_weights"]] <- temp_weight } } diff --git a/R/model-averaging.R b/R/model-averaging.R index 366891e..756470d 100644 --- a/R/model-averaging.R +++ b/R/model-averaging.R @@ -694,8 +694,14 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F #' @param force_plots temporal argument allowing to generate conditional posterior samples #' suitable for prior and posterior plots. Only available when conditioning on a #' single parameter. +#' @param transform_scaled whether to transform samples from standardized (scaled) to +#' original (unscaled) scale. When \code{TRUE}, both posterior and prior samples are +#' transformed, and the result can be directly passed to [plot_posterior] which will +#' automatically detect the transformation and use the transformed prior samples. +#' Requires a model fitted with \code{formula_scale_list}. Defaults to \code{FALSE}. +#' @param n_prior_samples number of prior samples to generate when +#' \code{transform_scaled = TRUE}. Defaults to 10000. #' @inheritParams ensemble_inference -#' @inheritParams mix_posteriors #' #' @return \code{as_mix_posteriors} returns a named list of mixed posterior #' distributions (either a vector of matrix). @@ -704,7 +710,8 @@ mix_posteriors <- function(model_list, parameters, is_null_list, conditional = F #' #' @name as_mixed_posteriors #' @export -as_mixed_posteriors <- function(model, parameters, conditional = NULL, conditional_rule = "AND", force_plots = FALSE){ +as_mixed_posteriors <- function(model, parameters, conditional = NULL, conditional_rule = "AND", force_plots = FALSE, + transform_scaled = FALSE, n_prior_samples = 10000){ # check input if(!inherits(model, "BayesTools_fit")) @@ -712,6 +719,8 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition check_char(parameters, "parameters", check_length = FALSE) check_char(conditional, "conditional", check_length = FALSE, allow_values = c(parameters, "PET", "PEESE", "PETPEESE", "omega"), allow_NULL = TRUE) check_char(conditional_rule, "conditional_rule", allow_values = c("AND", "OR")) + check_bool(transform_scaled, "transform_scaled") + check_int(n_prior_samples, "n_prior_samples", lower = 1) # extract the list of priors priors <- attr(model, "prior_list") @@ -839,6 +848,13 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition } } + # extract formula_scale early for transform_scaled support + formula_scale <- attr(model, "formula_scale") + + # apply scale transformation to posterior samples if requested + if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){ + model_samples <- transform_scale_samples(model_samples, formula_scale) + } out <- list() @@ -891,6 +907,19 @@ as_mixed_posteriors <- function(model, parameters, conditional = NULL, condition attr(out, "prior_list") <- priors attr(out, "conditional") <- conditional attr(out, "conditional_rule") <- conditional_rule + + # propagate formula_scale attribute for transform_scaled support + if(!is.null(formula_scale)){ + attr(out, "formula_scale") <- formula_scale + } + + # generate and store transformed prior samples if requested + if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){ + prior_samples <- transform_prior_samples(model, n_samples = n_prior_samples) + attr(out, "prior_samples") <- prior_samples + attr(out, "transform_scaled") <- TRUE + } + class(out) <- c(class(out), "as_mixed_posteriors", "mixed_posteriors") return(out) } diff --git a/man/as_mixed_posteriors.Rd b/man/as_mixed_posteriors.Rd index 77bb85c..e772cb5 100644 --- a/man/as_mixed_posteriors.Rd +++ b/man/as_mixed_posteriors.Rd @@ -9,7 +9,9 @@ as_mixed_posteriors( parameters, conditional = NULL, conditional_rule = "AND", - force_plots = FALSE + force_plots = FALSE, + transform_scaled = FALSE, + n_prior_samples = 10000 ) } \arguments{ @@ -26,6 +28,15 @@ Either "AND" or "OR". Defaults to "AND".} \item{force_plots}{temporal argument allowing to generate conditional posterior samples suitable for prior and posterior plots. Only available when conditioning on a single parameter.} + +\item{transform_scaled}{whether to transform samples from standardized (scaled) to +original (unscaled) scale. When \code{TRUE}, both posterior and prior samples are +transformed, and the result can be directly passed to \link{plot_posterior} which will +automatically detect the transformation and use the transformed prior samples. +Requires a model fitted with \code{formula_scale_list}. Defaults to \code{FALSE}.} + +\item{n_prior_samples}{number of prior samples to generate when +\code{transform_scaled = TRUE}. Defaults to 10000.} } \value{ \code{as_mix_posteriors} returns a named list of mixed posterior diff --git a/man/get_scale_transformation.Rd b/man/get_scale_transformation.Rd deleted file mode 100644 index 76369ab..0000000 --- a/man/get_scale_transformation.Rd +++ /dev/null @@ -1,71 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/JAGS-formula.R -\name{get_scale_transformation} -\alias{get_scale_transformation} -\title{Get scale transformation for plotting} -\usage{ -get_scale_transformation(fit, parameter_name, formula_scale = NULL) -} -\arguments{ -\item{fit}{A fitted model object (e.g., from \code{JAGS_fit}) containing posterior -samples. Required for computing the transformation, as the offset depends on -posterior means of other coefficients when there are interactions in the model.} - -\item{parameter_name}{The full name of the parameter (e.g., \code{"mu_x1"}, -\code{"mu_intercept"}, or \code{"mu_x1__xXx__x2"} for interaction)} - -\item{formula_scale}{Nested list containing standardization information keyed by -parameter name. Each parameter entry contains scaling info (mean and sd) for -each standardized predictor, e.g., \code{list(mu = list(mu_x1 = list(mean = 0, sd = 1)))}.} -} -\value{ -A list with elements: -\describe{ -\item{\code{transformation}}{Character string (\code{"lin"} or \code{"exp_lin"}).} -\item{\code{transformation_arguments}}{A named list with \code{a} (offset) and -\code{b} (scale factor).} -} -Returns \code{NULL} if no transformation is needed (parameter not affected by scaling). -} -\description{ -Extracts linear transformation parameters from scaling information -that can be used with plotting functions via \code{transformation} and -\code{transformation_arguments} parameters. -} -\details{ -This function returns the \strong{marginal} transformation for visualizing priors -on the original (unscaled) parameter scale. When a main effect has interactions, -the marginal prior on the unscaled coefficient is a convolution of independent -priors, with variance equal to the sum of squared transformation coefficients. - -For a simple coefficient (single predictor, no interactions), the transformation is: -\deqn{\beta_{orig} = \beta_z / \sigma_x} -which corresponds to \code{transformation = "lin"} with \code{a = 0, b = 1/sd}. - -For the highest-order interaction term (which receives no contributions from -higher-order terms), the transformation is similar: -\deqn{\beta_{orig} = \beta_z / (\sigma_{x1} \times \sigma_{x2} \times ...)} - -For main effects when interactions are present, the marginal transformation -uses the L2 norm of the transformation matrix row coefficients: -\deqn{b = \sqrt{\sum_j M_{ij}^2}} -where \eqn{M_{ij}} are the coefficients from the unscaling matrix for terms -with the same prior distribution (typically all regression coefficients). -This correctly captures the variance of the convolution of independent priors. - -For intercepts, the transformation includes contributions from other coefficients -using their posterior means, since the intercept typically has a different prior. - -For intercepts with \code{log_intercept = TRUE}, the transformation is: -\deqn{intercept_{orig} = \exp(a + b \times \log(intercept_z))} -which uses the \code{"exp_lin"} transformation type. -} -\examples{ -# With a fitted model -# trans <- get_scale_transformation(fit, "mu_x1") -# Returns: list(transformation = "lin", transformation_arguments = list(a = offset, b = scale)) - -} -\seealso{ -\code{\link[=transform_scale_samples]{transform_scale_samples()}} \code{\link[=plot_posterior]{plot_posterior()}} \code{\link[=plot_prior_list]{plot_prior_list()}} -} diff --git a/man/plot_marginal.Rd b/man/plot_marginal.Rd index 3d01bf7..372e403 100644 --- a/man/plot_marginal.Rd +++ b/man/plot_marginal.Rd @@ -28,7 +28,9 @@ parameter generated by \link{marginal_inference}.} \item{plot_type}{whether to use a base plot \code{"base"} or ggplot2 \code{"ggplot"} for plotting.} -\item{prior}{whether prior distribution should be added to the figure} +\item{prior}{whether prior distribution should be added to the figure. +When samples were prepared with \code{as_mixed_posteriors(..., transform_scaled = TRUE)}, +the transformed prior samples are automatically used.} \item{n_points}{number of equally spaced points in the \code{x_range} if \code{x_seq} is unspecified} diff --git a/man/plot_models.Rd b/man/plot_models.Rd index 2ba29a5..e35be9a 100644 --- a/man/plot_models.Rd +++ b/man/plot_models.Rd @@ -27,7 +27,7 @@ likelihood estimated with bridge sampling \code{marglik} and prior model odds \code{prior_weights}} \item{samples}{samples from a posterior distribution for a -parameter generated by \link{mix_posteriors}.} +parameter generated by \link{mix_posteriors} or \link{as_mixed_posteriors}.} \item{inference}{object created by \link{ensemble_inference} function} @@ -37,7 +37,9 @@ PET-PEESE and weightfunction.} \item{plot_type}{whether to use a base plot \code{"base"} or ggplot2 \code{"ggplot"} for plotting.} -\item{prior}{whether prior distribution should be added to the figure} +\item{prior}{whether prior distribution should be added to the figure. +When samples were prepared with \code{as_mixed_posteriors(..., transform_scaled = TRUE)}, +the transformed prior samples are automatically used.} \item{conditional}{whether conditional models should be displayed} diff --git a/man/plot_posterior.Rd b/man/plot_posterior.Rd index a7a6f30..a128007 100644 --- a/man/plot_posterior.Rd +++ b/man/plot_posterior.Rd @@ -26,7 +26,7 @@ plot_posterior( } \arguments{ \item{samples}{samples from a posterior distribution for a -parameter generated by \link{mix_posteriors}.} +parameter generated by \link{mix_posteriors} or \link{as_mixed_posteriors}.} \item{parameter}{parameter name to be plotted. Use \code{"PETPEESE"} for PET-PEESE plot with parameters \code{"PET"} and \code{"PEESE"}, @@ -36,7 +36,9 @@ parameters \code{"omega"}.} \item{plot_type}{whether to use a base plot \code{"base"} or ggplot2 \code{"ggplot"} for plotting.} -\item{prior}{whether prior distribution should be added to the figure} +\item{prior}{whether prior distribution should be added to the figure. +When samples were prepared with \code{as_mixed_posteriors(..., transform_scaled = TRUE)}, +the transformed prior samples are automatically used.} \item{n_points}{number of equally spaced points in the \code{x_range} if \code{x_seq} is unspecified} @@ -97,6 +99,12 @@ an object of class 'ggplot' if plot_type is \code{plot_type = "ggplot"}. \description{ Plot samples from the mixed posterior distributions } +\details{ +When using scaled predictors (via \code{formula_scale_list} in \link{JAGS_fit}), +you can plot posteriors on the original (unscaled) scale by preparing samples with +\code{as_mixed_posteriors(..., transform_scaled = TRUE)}. The function automatically +detects this and uses the pre-computed transformed prior samples when \code{prior = TRUE}. +} \seealso{ \code{\link[=prior]{prior()}} \code{\link[=lines_prior_list]{lines_prior_list()}} \code{\link[=geom_prior_list]{geom_prior_list()}} } diff --git a/man/transform_prior_samples.Rd b/man/transform_prior_samples.Rd new file mode 100644 index 0000000..d2abcbe --- /dev/null +++ b/man/transform_prior_samples.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/JAGS-formula.R +\name{transform_prior_samples} +\alias{transform_prior_samples} +\title{Transform prior samples to original scale} +\usage{ +transform_prior_samples( + fit, + n_samples = 10000, + seed = NULL, + formula_scale = NULL +) +} +\arguments{ +\item{fit}{a fitted model object with \code{prior_list} and optionally +\code{formula_scale} attributes} + +\item{n_samples}{number of samples to generate (default: 10000)} + +\item{seed}{random seed for reproducibility (optional)} + +\item{formula_scale}{optional nested list containing standardization information. +If not provided, extracted from \code{fit} attribute.} +} +\value{ +A matrix of prior samples on the original (unscaled) scale, with +columns matching the structure of posterior samples. +} +\description{ +Generate prior samples and transform them using the same +matrix transformation as posterior samples. This is the correct approach for +visualizing priors on the original (unscaled) scale, especially for the intercept +which depends on contributions from multiple coefficient priors. +} +\details{ +When models use auto-scaling (standardizing predictors), the posterior +samples are on the standardized scale. To correctly visualize priors on the +original scale, we cannot simply apply a linear transformation to individual +priors because the intercept on the original scale is a weighted sum of +multiple priors: + +\deqn{\beta_0^{orig} = \beta_0^* - \sum_i \frac{\mu_i}{\sigma_i} \beta_i^*} + +This function generates samples from ALL priors simultaneously and applies +the same matrix transformation used for posterior samples, which correctly +handles the intercept and all other parameters. +} +\examples{ +# With a fitted model that used formula_scale: +# prior_samples <- transform_prior_samples(fit, n_samples = 10000) +# This can then be used with density() or for custom plotting + +} +\seealso{ +\code{\link[=transform_scale_samples]{transform_scale_samples()}} \code{\link[=plot_posterior]{plot_posterior()}} +} diff --git a/plan-transform-scaled-plot-posterior.md b/plan-transform-scaled-plot-posterior.md deleted file mode 100644 index 237765f..0000000 --- a/plan-transform-scaled-plot-posterior.md +++ /dev/null @@ -1,591 +0,0 @@ -# Plan: Add `transform_scaled` to `plot_posterior` - -## Overview - -Add the ability to visualize prior and posterior distributions on both the **standardized** (scaled) and **original** (unscaled) scales when using formula-based models with auto-scaling. - -## Problem Statement - -When models use auto-scaling (standardizing predictors), the posterior samples are on the standardized scale. Users often want to visualize and interpret results on the original scale. - -### Why Simple Linear Transformation Fails - -For **coefficients** (main effects and interactions), a simple linear transformation `a + b*x` works because: -- Main effect: `β_orig = β_z / sd(x)` → `b = 1/sd(x)`, `a = 0` -- Interaction: `β_orig = β_z / (sd(x1) * sd(x2))` → `b = 1/(sd(x1)*sd(x2))`, `a = 0` - -For the **intercept**, simple transformation FAILS because: -``` -β₀_orig = β₀* - (mean(x₁)/sd(x₁)) * β₁* - (mean(x₂)/sd(x₂)) * β₂* - ... -``` - -The intercept on the original scale is a **weighted sum of multiple priors with different variances**: -- `Var(β₀_orig) = Var(β₀*) + (m₁/s₁)² * Var(β₁*) + (m₂/s₂)² * Var(β₂*) + ...` - -If priors have different scales (e.g., intercept prior N(0,5) vs coefficient prior N(0,1)), the marginal prior for the intercept on the original scale is NOT a simple transformation of the intercept prior alone. - -### Correct Approach - -Generate samples from **ALL** priors simultaneously and apply the **same matrix transformation** used for posterior samples: -1. Sample from each prior (intercept, coefficients, interactions) -2. Form a matrix of prior samples (matching posterior structure) -3. Apply `transform_scale_samples()` to get prior samples on original scale -4. Extract marginal samples for the parameter of interest - -This naturally handles all cases correctly, including the intercept. - ---- - -## Proposed Solution - -### New Function: `transform_prior_samples()` - -Create a new function that generates prior samples and transforms them: - -```r -#' Transform prior samples to original scale -#' -#' @param fit Fitted model object with prior_list and formula_scale attributes -#' @param n_samples Number of samples to generate (default: 10000) -#' @param seed Random seed for reproducibility -#' @return Matrix of prior samples on the original scale -transform_prior_samples <- function(fit, n_samples = 10000, seed = NULL) -``` - -**Implementation steps:** -1. Extract `prior_list` from fit -2. Extract `formula_scale` from fit -3. For each prior in `prior_list`, generate `n_samples` using `rng()` method -4. Arrange samples into matrix with same column structure as posterior -5. Apply `transform_scale_samples()` to transform to original scale -6. Return transformed prior samples matrix - -### Modify `plot_posterior()` - -Add `transform_scaled` argument to `plot_posterior()`: - -```r -plot_posterior <- function(samples, parameter, ..., - transform_scaled = FALSE, - formula_scale = NULL, - prior_samples = NULL) -``` - -When `transform_scaled = TRUE`: -1. Transform posterior samples using `transform_scale_samples()` -2. If `prior = TRUE`, use pre-generated `prior_samples` or generate via `transform_prior_samples()` -3. Plot both on the original scale - ---- - -## Integration with `mix_posteriors` / `as_mixed_posteriors` - -### Current State - -- `mix_posteriors()` creates mixed posterior samples from multiple models -- Returns object with class `mixed_posteriors` containing: - - `$samples` - mixed posterior samples - - `$prior_list` - list of priors used - - `$inference` - model weights and inference results - -### Required Modifications - -#### Option A: Extend `mix_posteriors()` - -Add optional arguments: -```r -mix_posteriors(..., - transform_scaled = FALSE, - formula_scale = NULL, - generate_prior_samples = FALSE, - n_prior_samples = 10000) -``` - -When `generate_prior_samples = TRUE`: -- Generate prior samples for each model -- Mix prior samples according to model weights (same as posterior mixing) -- Store in `$prior_samples` attribute - -#### Option B: Create `as_mixed_posteriors()` enhancement - -The function `as_mixed_posteriors()` can be enhanced to: -1. Accept single model fits and wrap them in mixed_posteriors format -2. Generate prior samples on demand -3. Handle formula_scale attribute propagation - -**Note:** `as_mixed_posteriors()` may already support forcing prior samples for plotting - verify this capability and extend if needed. - ---- - -## Implementation Plan - -### Phase 1: Core Infrastructure - -1. **Create `transform_prior_samples()`** - - Location: `R/JAGS-formula.R` (near `transform_scale_samples`) - - Inputs: fit object, n_samples, seed - - Outputs: Matrix of transformed prior samples - -2. **Create helper: `.generate_prior_sample_matrix()`** - - Generate samples from all priors in prior_list - - Match column structure to posterior samples - - Handle different prior types (simple, factor, spike, etc.) - -### Phase 2: Plot Integration - -3. **Modify `plot_posterior()`** in `R/model-averaging-plots.R` - - Add `transform_scaled` argument - - Add `formula_scale` argument (optional, extracted from samples if available) - - When `transform_scaled = TRUE`: - - Transform posterior samples - - Transform prior samples (if prior = TRUE) - - Adjust axis labels to indicate "original scale" - -### Phase 3: Mixed Posteriors Integration - -5. **Extend `mix_posteriors()`** - - Add `generate_prior_samples` argument - - Store `prior_samples` in returned object - - Propagate `formula_scale` attribute - -6. **Extend `as_mixed_posteriors()`** - - Handle single model case - - Support prior sample generation - - Ensure formula_scale is preserved - -### Phase 4: Testing - -7. **Unit tests** in `tests/testthat/test-JAGS-formula-scale.R` - - Test `transform_prior_samples()` generates correct samples - - Verify prior samples have expected distribution after transformation - - Test with various model structures (main effects, interactions, intercept) - -8. **Visual regression tests** in `tests/testthat/test-model-averaging-plots.R` - - Side-by-side: scaled vs unscaled plots - - Verify prior overlays match posterior distributions - ---- - -## Technical Considerations - -### Prior Sample Generation - -Different prior types need different handling: -- **Simple priors** (normal, cauchy, etc.): Use `rng(prior, n_samples)` -- **Factor priors**: Generate for each level -- **Spike priors**: All samples = spike location -- **Mixture priors**: Sample component, then sample from component - -### Column Matching - -Prior sample matrix must match posterior column names exactly: -```r -# Posterior columns might be: c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2", "sigma") -# Prior sample matrix must have same columns -``` - -### Missing Priors - -Some posterior parameters may not have corresponding priors in `prior_list`: -- Handle gracefully (skip transformation or use identity) -- Document behavior clearly - -### Performance - -Generating many prior samples can be slow: -- Default to reasonable n_samples (10000) -- Allow caching/reuse of prior samples -- Consider lazy evaluation - ---- - -## API Examples - -### Basic Usage - -```r -# Fit model with auto-scaling -fit <- JAGS_fit(data, formula = y ~ x1 * x2, ...) - -# Extract posterior -posterior <- as.matrix(coda::as.mcmc.list(fit)) - -# Plot on standardized scale (current behavior) -plot_posterior(posterior, "mu_x1", prior = TRUE) - -# Plot on original scale (new behavior) -plot_posterior(posterior, "mu_x1", prior = TRUE, - transform_scaled = TRUE, - fit = fit) # or formula_scale = attr(fit, "formula_scale") -``` - -### With Mixed Posteriors - -```r -# Mix posteriors from multiple models -mixed <- mix_posteriors(model_list, parameters = c("mu_x1", "mu_intercept"), ...) - -# Plot on original scale with prior -plot_posterior(mixed, "mu_x1", - prior = TRUE, - transform_scaled = TRUE) -``` - ---- - -## Open Questions - -1. **Should `transform_scaled` default to `TRUE` or `FALSE`?** - - FALSE maintains backward compatibility - - TRUE might be more intuitive for users - -2. **How to handle parameters not affected by scaling?** - - Skip transformation (identity) - - Or always apply (no-op for unscaled parameters) - -3. **Axis labeling convention?** - - Add "(original scale)" to axis labels? - - Use parameter name transformation (e.g., "x1" vs "scale(x1)")? - -4. **Integration with existing `transformation` argument?** - - `transform_scaled` is separate from user-specified transformations (exp, log, etc.) - - Should they be combinable? (first unscale, then apply user transformation) - ---- - -## Files to Modify - -| File | Changes | -|------|---------| -| `R/JAGS-formula.R` | Add `transform_prior_samples()`, `.generate_prior_sample_matrix()` | -| `R/model-averaging-plots.R` | Modify `plot_posterior()`, `plot_models()` | -| `R/model-averaging.R` | Extend `mix_posteriors()`, `as_mixed_posteriors()` | -| `tests/testthat/test-JAGS-formula-scale.R` | Add tests for prior sample transformation | -| `tests/testthat/test-model-averaging-plots.R` | Add visual tests for transformed plots | -| `man/plot_posterior.Rd` | Update documentation | -| `man/transform_prior_samples.Rd` | New documentation | - ---- - -## Success Criteria - -1. Prior and posterior distributions align correctly on both scales -2. Intercept transformation is correct (uses matrix transformation) -3. Coefficient transformations remain correct -4. Backward compatible (existing code works unchanged) -5. Clear documentation and examples -6. Comprehensive test coverage - -remove incorrect: get_scale_transformation and the corresponding tests ---- - -## References - -- Current implementation: `get_scale_transformation()` in `R/JAGS-formula.R` -- Matrix transformation: `.build_unscale_matrix()` in `R/JAGS-formula.R` -- Posterior transformation: `transform_scale_samples()` in `R/JAGS-formula.R` -- Plot functions: `R/model-averaging-plots.R` - ---- - -## Detailed Implementation Analysis - -### Existing Infrastructure (Code Review) - -#### 1. `mix_posteriors()` (R/model-averaging.R:177) - -**Current behavior:** -- Takes `model_list`, `parameters`, `is_null_list` -- Extracts `fits`, `priors` from each model -- Dispatches to type-specific helpers: `.mix_posteriors.simple()`, `.mix_posteriors.factor()`, etc. -- Each helper: - - Samples from posterior based on `post_probs` (model weights) - - For spike priors: uses `priors[[i]]$parameters[["location"]]` directly (no sampling) - - Attaches `prior_list` as attribute to output - -**Key insight:** The mixing logic samples from posteriors proportionally to model weights. The same logic can sample from priors. - -**Relevant code pattern (`.mix_posteriors.simple`, line 370-378):** -```r -if(is.prior.point(priors[[i]])){ - # not sampling the priors as the samples would be already transformed - samples <- c(samples, rep(priors[[i]]$parameters[["location"]], length(temp_ind))) -}else{ - samples <- c(samples, model_samples[temp_ind, parameter]) -} -``` - -#### 2. `as_mixed_posteriors()` (R/model-averaging.R:707) - -**Current behavior:** -- Takes single `BayesTools_fit` model -- Extracts `priors` from `attr(model, "prior_list")` -- Extracts `model_samples` from `coda::as.mcmc(model)` -- Applies conditioning if specified -- Dispatches to type-specific helpers: `.as_mixed_posteriors.simple()`, etc. -- Returns object with class `"as_mixed_posteriors"`, `"mixed_posteriors"` - -**Key insight:** This wraps a single model's posterior as mixed_posteriors format. Ideal place to also generate prior samples. - -**Note:** `force_plots` argument exists but appears minimally used (line 694-696): -> "temporal argument allowing to generate conditional posterior samples suitable for prior and posterior plots" - -#### 3. `plot_posterior()` (R/model-averaging-plots.R:995) - -**Current behavior:** -- Takes `samples` (mixed_posteriors object) and `parameter` -- If `prior = TRUE`: - - Extracts `prior_list` from `attr(samples[[parameter]], "prior_list")` - - Calls `.plot_data_prior_list.simple()` which uses `density()` on priors - - The `density.prior()` function uses `rng()` when `force_samples = TRUE` - -**Key insight:** Prior visualization already uses `rng()` via the `density()` method. The infrastructure for sampling exists. - -#### 4. `rng.prior()` (R/priors.R:1129) - -**Current behavior:** -- Generates random samples from any prior type -- Handles: simple priors, spike_and_slab, mixture, factor priors -- For mixtures: samples component first, then samples from that component - -**Key insight:** This is the building block for generating prior samples. Already handles all prior types. - -#### 5. `transform_scale_samples()` (R/JAGS-formula.R:1432) - -**Current behavior:** -- Takes fit or matrix, extracts/uses `formula_scale` -- Calls `.apply_unscale_transform()` which uses `.build_unscale_matrix()` -- Applies full matrix transformation: `posterior_transformed = posterior %*% M^T` - -**Key insight:** This can transform ANY matrix with the right column structure - posterior OR prior samples. - ---- - -## Recommended Implementation Strategy - -### Strategy: Minimal Changes with Maximum Reuse - -The most maintainable approach leverages existing infrastructure: - -1. **Reuse `rng.prior()`** for prior sample generation (already handles all types) -2. **Reuse `transform_scale_samples()`** for matrix transformation -3. **Extend `as_mixed_posteriors()`** to optionally generate prior samples -4. **Modify `plot_posterior()`** minimally to use transformed samples - -### Implementation Details - -#### Step 1: Create `.generate_prior_sample_matrix()` helper - -Location: `R/JAGS-formula.R` (or `R/model-averaging.R` if preferred) - -```r -.generate_prior_sample_matrix <- function(prior_list, n_samples, column_names = NULL, seed = NULL) { - # Generate samples from all priors matching posterior column structure - - if (!is.null(seed)) set.seed(seed) - - # Initialize matrix - n_params <- length(prior_list) - samples <- matrix(NA, nrow = n_samples, ncol = n_params) - colnames(samples) <- names(prior_list) - - for (i in seq_along(prior_list)) { - prior <- prior_list[[i]] - param_name <- names(prior_list)[i] - - if (is.null(prior) || is.prior.none(prior)) { - samples[, i] <- 0 # No effect - } else if (is.prior.point(prior)) { - samples[, i] <- prior$parameters[["location"]] - } else { - samples[, i] <- rng(prior, n_samples) # Uses existing rng.prior() - } - } - - # Reorder columns to match column_names if provided - if (!is.null(column_names)) { - # Match available columns - available <- intersect(column_names, colnames(samples)) - samples <- samples[, available, drop = FALSE] - } - - return(samples) -} -``` - -#### Step 2: Create `transform_prior_samples()` (exported function) - -Location: `R/JAGS-formula.R` - -```r -#' @title Transform prior samples to original scale -#' @description Generate prior samples and transform them using the same -#' matrix transformation as posterior samples. -#' @param fit Fitted model with prior_list and formula_scale attributes -#' @param n_samples Number of samples to generate -#' @param seed Random seed for reproducibility -#' @return Matrix of prior samples on original scale -#' @export -transform_prior_samples <- function(fit, n_samples = 10000, seed = NULL) { - - prior_list <- attr(fit, "prior_list") - formula_scale <- attr(fit, "formula_scale") - - if (is.null(prior_list)) { - stop("'fit' must have 'prior_list' attribute") - } - - # Get posterior column names for structure matching - posterior <- as.matrix(coda::as.mcmc.list(fit)) - - # Generate prior samples - prior_samples <- .generate_prior_sample_matrix( - prior_list, - n_samples = n_samples, - column_names = colnames(posterior), - seed = seed - ) - - # Apply same transformation as posterior - if (!is.null(formula_scale) && length(formula_scale) > 0) { - prior_samples <- transform_scale_samples(prior_samples, formula_scale) - } - - return(prior_samples) -} -``` - -#### Step 3: Extend `as_mixed_posteriors()` - -Add `generate_prior_samples` argument: - -```r -as_mixed_posteriors <- function(model, parameters, conditional = NULL, - conditional_rule = "AND", force_plots = FALSE, - generate_prior_samples = FALSE, # NEW - n_prior_samples = 10000) { # NEW - # ... existing code ... - - # At the end, before return: - if (generate_prior_samples) { - prior_samples <- transform_prior_samples(model, n_samples = n_prior_samples) - attr(out, "prior_samples") <- prior_samples - } - - # Propagate formula_scale - attr(out, "formula_scale") <- attr(model, "formula_scale") - - return(out) -} -``` - -#### Step 4: Modify `plot_posterior()` - -Add `transform_scaled` argument: - -```r -plot_posterior <- function(samples, parameter, plot_type = "base", prior = FALSE, - n_points = 1000, n_samples = 10000, force_samples = FALSE, - transform_scaled = FALSE, # NEW - formula_scale = NULL, # NEW - ...) { - - # Extract formula_scale from samples if not provided - if (transform_scaled && is.null(formula_scale)) { - formula_scale <- attr(samples, "formula_scale") - } - - # ... existing parameter extraction ... - - # Transform posterior samples if requested - if (transform_scaled && !is.null(formula_scale)) { - # Get raw samples and transform - raw_samples <- # extract from samples object - transformed_samples <- transform_scale_samples(raw_samples, formula_scale) - # Use transformed_samples for plotting - } - - # For prior plotting with transform_scaled: - if (prior && transform_scaled) { - # Check if pre-generated prior_samples exist - prior_samples <- attr(samples, "prior_samples") - if (is.null(prior_samples)) { - # Generate on the fly (need fit object) - warning("Prior samples not pre-generated. For best results, use generate_prior_samples=TRUE in as_mixed_posteriors()") - # Fall back to standard prior density (may be incorrect for intercept) - } - # Use prior_samples[, parameter] for density estimation - } - - # ... rest of plotting logic ... -} -``` - ---- - -## Alternative: Simpler `plot_posterior` Enhancement - -If modifying the mixed_posteriors infrastructure is too invasive, a simpler approach: - -```r -plot_posterior <- function(samples, parameter, ..., - transform_scaled = FALSE, - fit = NULL) { # Accept original fit object - - if (transform_scaled) { - if (is.null(fit)) { - stop("'fit' required when transform_scaled = TRUE") - } - - # Transform posterior - posterior_orig <- transform_scale_samples(fit) - - # For prior, generate and transform - if (prior) { - prior_samples_orig <- transform_prior_samples(fit, n_samples = n_samples) - # Use density(prior_samples_orig[, parameter]) for prior overlay - } - } -} -``` - -This keeps all transformation logic in the plotting function, avoiding changes to `mix_posteriors` / `as_mixed_posteriors`. - ---- - -## Recommendation - -**Phase 1 (Immediate):** Implement the simpler approach - add `transform_scaled` and `fit` arguments to `plot_posterior()`. This: -- Requires minimal changes -- Keeps transformation logic centralized -- Works for single-model cases - -**Phase 2 (Future):** Extend `as_mixed_posteriors()` with `generate_prior_samples` for: -- Pre-computed prior samples -- Multi-model averaging cases -- Better performance (compute once, plot multiple times) - ---- - -## Factor Priors Consideration - -For factor priors (orthonormal, meandif, treatment contrasts), the sample structure is more complex: -- Multiple columns per factor level -- Need to match column naming convention - -The `rng.prior()` already handles this via `transform_factor_samples` argument. -Ensure `.generate_prior_sample_matrix()` correctly handles: -- `is.prior.factor()` → returns matrix, not vector -- Column naming: `parameter[1]`, `parameter[2]`, etc. - ---- - -## Edge Cases to Handle - -1. **Parameters not in prior_list**: Skip or use 0 -2. **Parameters not affected by scaling**: Identity transformation (already handled by `transform_scale_samples`) -3. **Spike priors**: Generate constant samples at spike location -4. **Mixture priors**: Sample component, then sample from component (handled by `rng.prior`) -5. **Models without formula_scale**: Return untransformed samples - -```` diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg deleted file mode 100644 index a4c6ae5..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-standardized.svg +++ /dev/null @@ -1,83 +0,0 @@ - - - - - - - - - - - - -log_sigma_x_sigma (standardized) -Density - - - - - --0.40 --0.35 --0.30 --0.25 - - - - - -0 -5 -10 -15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg deleted file mode 100644 index 39d37bc..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/dual-log-sigma-x-unscaled.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - -log_sigma_x_sigma (unscaled) -Density - - - - - - - --0.26 --0.24 --0.22 --0.20 --0.18 --0.16 - - - - - - - -0 -5 -10 -15 -20 -25 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg deleted file mode 100644 index 8154049..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-standardized.svg +++ /dev/null @@ -1,85 +0,0 @@ - - - - - - - - - - - - -mu_x_mu (standardized) -Density - - - - - - - -0.61 -0.62 -0.63 -0.64 -0.65 -0.66 - - - - - - - -0 -10 -20 -30 -40 -50 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg b/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg deleted file mode 100644 index 75ec155..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/dual-mu-x-unscaled.svg +++ /dev/null @@ -1,86 +0,0 @@ - - - - - - - - - - - - -mu_x_mu (unscaled) -Density - - - - - - - -0.295 -0.300 -0.305 -0.310 -0.315 -0.320 - - - - - - - - -0 -20 -40 -60 -80 -100 -120 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg deleted file mode 100644 index 41a21c9..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-interaction-1x2.svg +++ /dev/null @@ -1,185 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x1:x2 (scaled) -Density - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x1:x2 (unscaled) -Density - - - - - - - - - - --0.3 --0.2 --0.1 -0.0 -0.1 -0.2 -0.3 - - - - - - - -0 -1 -2 -3 -4 -5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg deleted file mode 100644 index ae16c96..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-intercept-1x2.svg +++ /dev/null @@ -1,176 +0,0 @@ - - - - - - - - - - - - - - - - - - - -intercept (scaled) -Density - - - - - - - - - --10 -0 -10 -20 -30 -40 - - - - - - - - -0.00 -0.01 -0.02 -0.03 -0.04 -0.05 -0.06 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -intercept (unscaled) -Density - - - - - - - - --200 --100 -0 -100 -200 - - - - - - - - -0.000 -0.001 -0.002 -0.003 -0.004 -0.005 -0.006 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg b/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg deleted file mode 100644 index f1e33df..0000000 --- a/tests/testthat/_snaps/model-averaging-plots/scale-transform-x1-1x2.svg +++ /dev/null @@ -1,256 +0,0 @@ - - - - - - - - - - - - - - - - - - - -x_cont1 (scaled) -Density - - - - - - - - - - - --3 --2 --1 -0 -1 -2 -3 -4 - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -x_cont1 (unscaled) -Density - - - - - - - - - - --0.15 --0.10 --0.05 -0.00 -0.05 -0.10 -0.15 - - - - - - - -0 -2 -4 -6 -8 -10 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/testthat/_snaps/model-averaging-plots/transform-scaled-all-params-grid.svg b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-all-params-grid.svg new file mode 100644 index 0000000..af6b17a --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-all-params-grid.svg @@ -0,0 +1,296 @@ + + + + + + + + + + + + + + + + + + + + +-20 +-10 +0 +10 +20 +30 +40 + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 + + + + + + + +Intercept (Scaled) +Density + + + + + + + + + + + + + + + + + + + + + + + + + + +-300 +-200 +-100 +0 +100 +200 +300 + + + + + + + + +0.000 +0.001 +0.002 +0.003 +0.004 +0.005 +0.006 + + + + + + + +Intercept (Original) +Density + + + + + + + + + + + + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + +x_cont1 (Scaled) +Density + + + + + + + + + + + + + + + + + +-0.1 +0.0 +0.1 + + + + + + +0 +2 +4 +6 +8 + + + + + + + +x_cont1 (Original) +Density + + + + + + + + + + + + + + + + + + +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + +x_cont2 (Scaled) +Density + + + + + + + + + + + + + + + + + + + + + +-600 +-400 +-200 +0 +200 +400 +600 + + + + + + + + +0.0000 +0.0005 +0.0010 +0.0015 +0.0020 +0.0025 +0.0030 + + + + + + + +x_cont2 (Original) +Density + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont1-comparison.svg b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont1-comparison.svg new file mode 100644 index 0000000..7fafc7a --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont1-comparison.svg @@ -0,0 +1,106 @@ + + + + + + + + + + + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + +x_cont1 (Standardized Scale) +Density + + + + + + + + + + + + + + + + + + + + + + + + +-0.2 +-0.1 +0.0 +0.1 +0.2 + + + + + + +0 +2 +4 +6 +8 + + + + + + + +x_cont1 (Original Scale) +Density + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont2-comparison.svg b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont2-comparison.svg new file mode 100644 index 0000000..84c70c9 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-coef-x-cont2-comparison.svg @@ -0,0 +1,112 @@ + + + + + + + + + + + + + + + + + +-2 +0 +2 +4 + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 + + + + + + + +x_cont2 (Standardized Scale) +Density + + + + + + + + + + + + + + + + + + + + + + + + + + +-600 +-400 +-200 +0 +200 +400 +600 + + + + + + + + +0.0000 +0.0005 +0.0010 +0.0015 +0.0020 +0.0025 +0.0030 + + + + + + + +x_cont2 (Original Scale) +Density + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/transform-scaled-dual-param-intercept.svg b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-dual-param-intercept.svg new file mode 100644 index 0000000..b06b89f --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-dual-param-intercept.svg @@ -0,0 +1,200 @@ + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + + + + +0 +10 +20 +30 +40 +50 +60 + + + + + + + +Dual: Intercept (Scaled) +Density + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 + + + + + +0 +5 +10 +15 + + + + + + + +Dual: Intercept (Original) +Density + + + + + + + + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + +0 +5 +10 +15 + + + + + + + +Dual: Slope (Scaled) +Density + + + + + + + + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + + + +0 +5 +10 +15 +20 +25 + + + + + + + +Dual: Slope (Original) +Density + + + + + + diff --git a/tests/testthat/_snaps/model-averaging-plots/transform-scaled-intercept-comparison.svg b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-intercept-comparison.svg new file mode 100644 index 0000000..db102b6 --- /dev/null +++ b/tests/testthat/_snaps/model-averaging-plots/transform-scaled-intercept-comparison.svg @@ -0,0 +1,118 @@ + + + + + + + + + + + + + + + + + + + + +-20 +-10 +0 +10 +20 +30 +40 + + + + + + +0.00 +0.02 +0.04 +0.06 +0.08 + + + + + + + +Intercept (Standardized Scale) +Density + + + + + + + + + + + + + + + + + + + + + + + + + + +-300 +-200 +-100 +0 +100 +200 +300 + + + + + + + + +0.000 +0.001 +0.002 +0.003 +0.004 +0.005 +0.006 + + + + + + + +Intercept (Original Scale) +Density + + + + + + diff --git a/tests/testthat/test-JAGS-formula-scale.R b/tests/testthat/test-JAGS-formula-scale.R index 65d9625..cca317d 100644 --- a/tests/testthat/test-JAGS-formula-scale.R +++ b/tests/testthat/test-JAGS-formula-scale.R @@ -334,6 +334,19 @@ test_that("Downstream functions work with scaled models", { expect_equal(JAGS_estimates_table(fit_manual), JAGS_estimates_table(fit_auto)) }) +test_that("Marginal likelihoods match for manual and automatic scaling", { + + skip_if_no_fits() + skip("no margliks") + # Load pre-fitted marginal likelihoods + marglik_manual <- readRDS(file.path(temp_fits_dir, "fit_formula_manual_scaled_marglik.RDS")) + marglik_auto <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled_marglik.RDS")) + + # The log marginal likelihoods should be very similar + # (both models use same scaled data internally) + expect_equal(marglik_manual$logml, marglik_auto$logml, tolerance = 0.1) +}) + test_that("JAGS_evaluate_formula applies scaling correctly", { skip_if_no_fits() @@ -1383,540 +1396,3 @@ test_that("lm validation: factor interactions with multiple scaled continuous", ) }) - -# ============================================================================ # -# SECTION: get_scale_transformation tests -# ============================================================================ # -# -# These tests validate get_scale_transformation using the lm validation pattern: -# 1. Fit lm() with scaled predictors -> extract coefficients (scaled) -# 2. Fit lm() with unscaled predictors -> extract coefficients (ground truth) -# 3. Create mock "fit" object with scaled coefficients as posterior samples -# 4. Use get_scale_transformation to get transformation parameters -# 5. Apply transformation and verify it matches unscaled coefficients -# -# This validates that get_scale_transformation returns the correct transformation -# to convert standardized posterior samples to original scale. -# ============================================================================ # - -# Helper: Create a mock fit object from coefficient matrix -# This mimics the structure expected by get_scale_transformation -.make_mock_fit <- function(posterior_matrix, prefix = "mu") { - # Create a simple coda mcmc object - mcmc_obj <- coda::mcmc(posterior_matrix) - fit <- list(mcmc = mcmc_obj) - class(fit) <- "runjags" - attr(fit, "mcmc") <- coda::mcmc.list(mcmc_obj) - - # Create prior_list with "parameter" attribute for each column - # This is needed by get_scale_transformation to determine the prefix - prior_list <- lapply(colnames(posterior_matrix), function(param_name) { - p <- prior("normal", list(mean = 0, sd = 1)) - attr(p, "parameter") <- prefix - p - }) - names(prior_list) <- colnames(posterior_matrix) - attr(fit, "prior_list") <- prior_list - - fit -} - - -test_that("get_scale_transformation requires fit argument", { - - formula_scale <- list( - mu = list( - mu_x1 = list(mean = 5, sd = 2) - ) - ) - - # Error when fit is not provided - - expect_error( - get_scale_transformation(fit = NULL, "mu_x1", formula_scale), - "'fit' argument is required" - ) - - # Error when fit is NULL - expect_error( - get_scale_transformation(fit = NULL, "mu_x1", formula_scale), - "'fit' argument is required" - ) -}) - - -test_that("get_scale_transformation returns NULL for unscaled parameters and errors for missing", { - - # Create a minimal mock fit with mu_x1 and mu_x2 but only x1 is scaled - posterior <- matrix(c(0, 0.5, 0.3), nrow = 10, ncol = 3, byrow = TRUE) - colnames(posterior) <- c("mu_intercept", "mu_x1", "mu_x2") - mock_fit <- .make_mock_fit(posterior) - - formula_scale <- list( - mu = list( - mu_x1 = list(mean = 5, sd = 2) - ) - ) - - # Parameter in prior_list but not in formula_scale -> returns NULL - result <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - expect_null(result) - - # Parameter not in prior_list -> error - expect_error( - get_scale_transformation(fit = mock_fit, "sigma_x1", formula_scale), - "not found in prior_list" - ) - - # Empty formula_scale -> NULL (no scaling to apply) - result <- get_scale_transformation(fit = mock_fit, "mu_x1", NULL) - expect_null(result) - - result <- get_scale_transformation(fit = mock_fit, "mu_x1", list()) - expect_null(result) -}) - - -test_that("lm validation: get_scale_transformation for simple coefficient (one predictor)", { - - set.seed(42) - df <- data.frame(x1 = rnorm(500, mean = 10, sd = 3)) - df$y <- 5 + 2 * scale(df$x1) + rnorm(500, 0, 0.5) - - # Fit with scaled predictor - fit_scaled <- lm(y ~ scale(x1), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictor (ground truth) - fit_unscaled <- lm(y ~ x1, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale - formula_scale <- .make_formula_scale(df, "x1") - - # Create mock fit with scaled coefficients as posterior - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Get transformation for x1 coefficient - trans <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - - # Apply transformation - coef_x1_transformed <- trans$transformation_arguments$a + - trans$transformation_arguments$b * coef_scaled["scale(x1)"] - - expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) -}) - - -test_that("lm validation: get_scale_transformation for intercept (one predictor)", { - - set.seed(42) - df <- data.frame(x1 = rnorm(500, mean = 10, sd = 3)) - df$y <- 5 + 2 * scale(df$x1) + rnorm(500, 0, 0.5) - - # Fit with scaled predictor - fit_scaled <- lm(y ~ scale(x1), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictor (ground truth) - fit_unscaled <- lm(y ~ x1, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale - formula_scale <- .make_formula_scale(df, "x1") - - # Create mock fit with scaled coefficients as posterior - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Get transformation for intercept - trans <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - - # Intercept uses a = 0, b = L2 norm of ENTIRE row (all columns) - # The variance includes contributions from coefficient priors via off-diagonal terms - M <- .build_unscale_matrix(c("mu_intercept", "mu_x1"), formula_scale[["mu"]], "mu") - expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) - - expect_equal(trans$transformation_arguments$a, 0) - expect_equal(trans$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - - # For point transformation, use transform_scale_samples - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - expect_equal( - unname(posterior_transformed[1, "mu_intercept"]), - unname(coef_unscaled["(Intercept)"]), - tolerance = 1e-10 - ) -}) - - -test_that("lm validation: get_scale_transformation for multiple predictors", { - - set.seed(43) - df <- data.frame( - x1 = rnorm(500, mean = 3, sd = 5), - x2 = rnorm(500, mean = -10, sd = 2) - ) - df$y <- 2 - 0.5 * scale(df$x1) + 1.5 * scale(df$x2) + rnorm(500, 0, 0.3) - - # Fit with scaled predictors - fit_scaled <- lm(y ~ scale(x1) + scale(x2), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictors (ground truth) - fit_unscaled <- lm(y ~ x1 + x2, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale and mock fit - formula_scale <- .make_formula_scale(df, c("x1", "x2")) - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Test each coefficient - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - trans_int <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - - coef_x1_transformed <- trans_x1$transformation_arguments$a + - trans_x1$transformation_arguments$b * coef_scaled["scale(x1)"] - coef_x2_transformed <- trans_x2$transformation_arguments$a + - trans_x2$transformation_arguments$b * coef_scaled["scale(x2)"] - - expect_equal(unname(coef_x1_transformed), unname(coef_unscaled["x1"]), tolerance = 1e-10) - expect_equal(unname(coef_x2_transformed), unname(coef_unscaled["x2"]), tolerance = 1e-10) - - # Intercept uses a = 0, b = L2 norm of ENTIRE row (all columns) - M <- .build_unscale_matrix(c("mu_intercept", "mu_x1", "mu_x2"), formula_scale[["mu"]], "mu") - expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) - - expect_equal(trans_int$transformation_arguments$a, 0) - expect_equal(trans_int$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - - # For point transformation, use transform_scale_samples - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - expect_equal( - unname(posterior_transformed[1, "mu_intercept"]), - unname(coef_unscaled["(Intercept)"]), - tolerance = 1e-10 - ) -}) - - -test_that("lm validation: get_scale_transformation for two-way interaction", { - - set.seed(44) - df <- data.frame( - x1 = rnorm(500, mean = 5, sd = 2), - x2 = rnorm(500, mean = -3, sd = 4) - ) - df$y <- 3 + 0.8 * scale(df$x1) - 0.5 * scale(df$x2) + - 0.3 * scale(df$x1) * scale(df$x2) + rnorm(500, 0, 0.5) - - # Fit with scaled predictors - fit_scaled <- lm(y ~ scale(x1) * scale(x2), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictors (ground truth) - fit_unscaled <- lm(y ~ x1 * x2, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale and mock fit - formula_scale <- .make_formula_scale(df, c("x1", "x2")) - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Test interaction coefficient - highest order term, marginal = conditional - trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) - - coef_int_transformed <- trans_interaction$transformation_arguments$a + - trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):scale(x2)"] - - expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) - - # For main effects with interactions: get_scale_transformation returns MARGINAL - # transformation for prior visualization. a = 0 (prior is centered), b = L2 norm. - - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - - # Build the unscale matrix to compute expected L2 norms - M <- .build_unscale_matrix( - c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2"), - formula_scale[["mu"]], - "mu" - ) - - # Expected marginal b = L2 norm of non-intercept coefficients in each row - expected_b_x1 <- sqrt(sum(M["mu_x1", c("mu_x1", "mu_x1__xXx__x2")]^2)) - expected_b_x2 <- sqrt(sum(M["mu_x2", c("mu_x2", "mu_x1__xXx__x2")]^2)) - - expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) - expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) - - # Marginal transformation has a = 0 (prior is centered at origin) - expect_equal(trans_x1$transformation_arguments$a, 0) - expect_equal(trans_x2$transformation_arguments$a, 0) - - # For POINT transformation of coefficients, use transform_scale_samples - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - - expect_equal(unname(posterior_transformed[1, "mu_x1"]), unname(coef_unscaled["x1"]), tolerance = 1e-10) - expect_equal(unname(posterior_transformed[1, "mu_x2"]), unname(coef_unscaled["x2"]), tolerance = 1e-10) - expect_equal(unname(posterior_transformed[1, "mu_intercept"]), unname(coef_unscaled["(Intercept)"]), tolerance = 1e-10) -}) - - -test_that("lm validation: get_scale_transformation for three-way interaction", { - - set.seed(46) - df <- data.frame( - x1 = rnorm(500, mean = 3, sd = 2), - x2 = rnorm(500, mean = -5, sd = 3), - x3 = rnorm(500, mean = 10, sd = 4) - ) - df$y <- 2 + - 0.5 * scale(df$x1) - 0.3 * scale(df$x2) + 0.4 * scale(df$x3) + - 0.2 * scale(df$x1) * scale(df$x2) + - 0.15 * scale(df$x1) * scale(df$x3) + - 0.1 * scale(df$x2) * scale(df$x3) + - 0.08 * scale(df$x1) * scale(df$x2) * scale(df$x3) + - rnorm(500, 0, 0.3) - - # Fit with scaled predictors - fit_scaled <- lm(y ~ scale(x1) * scale(x2) * scale(x3), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictors (ground truth) - fit_unscaled <- lm(y ~ x1 * x2 * x3, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale and mock fit - formula_scale <- .make_formula_scale(df, c("x1", "x2", "x3")) - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Validate point transformation produced by transform_scale_samples - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - expect_equal( - unname(posterior_transformed[1, ]), - unname(.reorder_lm_coefs(coef_unscaled, posterior_transformed)), - tolerance = 1e-10 - ) - - # Test three-way interaction (highest order - marginal = conditional) - trans_3way <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2__xXx__x3", formula_scale) - - coef_3way_transformed <- trans_3way$transformation_arguments$a + - trans_3way$transformation_arguments$b * coef_scaled["scale(x1):scale(x2):scale(x3)"] - - expect_equal(unname(coef_3way_transformed), unname(coef_unscaled["x1:x2:x3"]), tolerance = 1e-10) - - # For lower-order terms: get_scale_transformation returns MARGINAL transformation. - # Verify b = L2 norm, a = 0 - - trans_x1x2 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) - trans_x1x3 <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x3", formula_scale) - trans_x2x3 <- get_scale_transformation(fit = mock_fit, "mu_x2__xXx__x3", formula_scale) - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - trans_x3 <- get_scale_transformation(fit = mock_fit, "mu_x3", formula_scale) - - # Build the unscale matrix to compute expected L2 norms - all_terms <- c("mu_intercept", "mu_x1", "mu_x2", "mu_x3", - "mu_x1__xXx__x2", "mu_x1__xXx__x3", "mu_x2__xXx__x3", - "mu_x1__xXx__x2__xXx__x3") - M <- .build_unscale_matrix(all_terms, formula_scale[["mu"]], "mu") - - # Non-intercept columns for L2 norm calculation - non_int_cols <- setdiff(all_terms, "mu_intercept") - - # Validate L2 norms for two-way interactions - expected_b_x1x2 <- sqrt(sum(M["mu_x1__xXx__x2", non_int_cols]^2)) - expected_b_x1x3 <- sqrt(sum(M["mu_x1__xXx__x3", non_int_cols]^2)) - expected_b_x2x3 <- sqrt(sum(M["mu_x2__xXx__x3", non_int_cols]^2)) - - expect_equal(trans_x1x2$transformation_arguments$b, expected_b_x1x2, tolerance = 1e-10) - expect_equal(trans_x1x3$transformation_arguments$b, expected_b_x1x3, tolerance = 1e-10) - expect_equal(trans_x2x3$transformation_arguments$b, expected_b_x2x3, tolerance = 1e-10) - - # Validate L2 norms for main effects - expected_b_x1 <- sqrt(sum(M["mu_x1", non_int_cols]^2)) - expected_b_x2 <- sqrt(sum(M["mu_x2", non_int_cols]^2)) - expected_b_x3 <- sqrt(sum(M["mu_x3", non_int_cols]^2)) - - expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) - expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) - expect_equal(trans_x3$transformation_arguments$b, expected_b_x3, tolerance = 1e-10) - - # All non-intercept terms should have a = 0 (marginal transformation is centered) - expect_equal(trans_x1x2$transformation_arguments$a, 0) - expect_equal(trans_x1x3$transformation_arguments$a, 0) - expect_equal(trans_x2x3$transformation_arguments$a, 0) - expect_equal(trans_x1$transformation_arguments$a, 0) - expect_equal(trans_x2$transformation_arguments$a, 0) - expect_equal(trans_x3$transformation_arguments$a, 0) - - # Test intercept: uses L2 norm of ENTIRE row (all columns) - # The variance includes contributions from coefficient priors via off-diagonal terms - trans_intercept <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - - # Intercept should have a = 0, b = L2 norm of full row - expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) - expect_equal(trans_intercept$transformation_arguments$a, 0) - expect_equal(trans_intercept$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - - # NOTE: For point transformation of posterior samples (including intercept), - # use transform_scale_samples() which applies the full matrix multiplication. -}) - - -test_that("lm validation: get_scale_transformation for partial scaling", { - - set.seed(45) - df <- data.frame( - x1 = rnorm(500, mean = 8, sd = 3), - x2 = rnorm(500, mean = -2, sd = 5) # Not scaled - ) - # Only x1 is scaled - df$y <- 1 + 0.6 * scale(df$x1) - 0.4 * df$x2 + - 0.25 * scale(df$x1) * df$x2 + rnorm(500, 0, 0.4) - - # Fit with partial scaling (only x1 scaled) - fit_scaled <- lm(y ~ scale(x1) * x2, data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictors (ground truth) - fit_unscaled <- lm(y ~ x1 * x2, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale (only x1 is scaled) - formula_scale <- .make_formula_scale(df, "x1") - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Test x1 coefficient - marginal transformation has a = 0 - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - expect_equal(trans_x1$transformation_arguments$a, 0) - - # x2 is not scaled, so transformation should return NULL - trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - expect_null(trans_x2) - - # Interaction involves x1 which is scaled - highest order, so marginal = conditional - trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) - - coef_int_transformed <- trans_interaction$transformation_arguments$a + - trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):x2"] - - expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) -}) - - -test_that("lm validation: get_scale_transformation returns marginal transformation", { - - # This test verifies that get_scale_transformation returns the MARGINAL transformation - # for prior visualization. For posterior sample transformation, use transform_scale_samples. - - set.seed(789) - df <- data.frame( - x1 = rnorm(500, mean = 10, sd = 5), - x2 = rnorm(500, mean = -3, sd = 2) - ) - df$y <- 2 + 0.5 * scale(df$x1) - 0.3 * scale(df$x2) + - 0.1 * scale(df$x1) * scale(df$x2) + rnorm(500, 0, 1) - - # Fit with scaled predictors - fit_scaled <- lm(y ~ scale(x1) * scale(x2), data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictors (ground truth) - fit_unscaled <- lm(y ~ x1 * x2, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale and mock fit - formula_scale <- .make_formula_scale(df, c("x1", "x2")) - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled, n_rep = 50) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Get individual transformations - trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__x2", formula_scale) - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - trans_x2 <- get_scale_transformation(fit = mock_fit, "mu_x2", formula_scale) - trans_int <- get_scale_transformation(fit = mock_fit, "mu_intercept", formula_scale) - - # For highest-order term (interaction): marginal = conditional, point transform works - transformed_interaction <- trans_interaction$transformation_arguments$a + - trans_interaction$transformation_arguments$b * posterior_scaled[1, "mu_x1__xXx__x2"] - - expect_equal(unname(transformed_interaction), unname(coef_unscaled["x1:x2"]), tolerance = 1e-10) - - # For main effects: marginal transformation has a = 0 and b = L2 norm - expect_equal(trans_x1$transformation_arguments$a, 0) - expect_equal(trans_x2$transformation_arguments$a, 0) - - # Build unscale matrix to verify L2 norm calculation - M <- .build_unscale_matrix( - c("mu_intercept", "mu_x1", "mu_x2", "mu_x1__xXx__x2"), - formula_scale[["mu"]], - "mu" - ) - - expected_b_x1 <- sqrt(sum(M["mu_x1", c("mu_x1", "mu_x1__xXx__x2")]^2)) - expected_b_x2 <- sqrt(sum(M["mu_x2", c("mu_x2", "mu_x1__xXx__x2")]^2)) - - expect_equal(trans_x1$transformation_arguments$b, expected_b_x1, tolerance = 1e-10) - expect_equal(trans_x2$transformation_arguments$b, expected_b_x2, tolerance = 1e-10) - - # For intercept: uses L2 norm of ENTIRE row (all columns) - expected_b_int <- sqrt(sum(M["mu_intercept", ]^2)) - expect_equal(trans_int$transformation_arguments$a, 0) - expect_equal(trans_int$transformation_arguments$b, expected_b_int, tolerance = 1e-10) - - # NOTE: For point transformation of posterior samples, use transform_scale_samples() - posterior_transformed <- transform_scale_samples(posterior_scaled, formula_scale) - expect_equal( - unname(posterior_transformed[1, "mu_intercept"]), - unname(coef_unscaled["(Intercept)"]), - tolerance = 1e-10 - ) -}) - - -test_that("lm validation: get_scale_transformation with factor + continuous interaction", { - - set.seed(50) - df <- data.frame( - x1 = rnorm(500, mean = 5, sd = 3), - f1 = factor(sample(letters[1:2], 500, TRUE)) - ) - df$y <- 2 + 0.5 * scale(df$x1) + - ifelse(df$f1 == "b", 0.3, 0) + - ifelse(df$f1 == "b", 0.2, 0) * scale(df$x1) + - rnorm(500, 0, 0.4) - - # Fit with scaled predictor - fit_scaled <- lm(y ~ scale(x1) * f1, data = df) - coef_scaled <- coef(fit_scaled) - - # Fit with unscaled predictor (ground truth) - fit_unscaled <- lm(y ~ x1 * f1, data = df) - coef_unscaled <- coef(fit_unscaled) - - # Create formula_scale (only x1 is scaled, f1 is factor) - formula_scale <- .make_formula_scale(df, "x1") - posterior_scaled <- .lm_coefs_to_posterior(coef_scaled) - mock_fit <- .make_mock_fit(posterior_scaled) - - # Test main effect of x1 - marginal transformation has a = 0 - trans_x1 <- get_scale_transformation(fit = mock_fit, "mu_x1", formula_scale) - expect_equal(trans_x1$transformation_arguments$a, 0) - - # Test interaction (x1:f1b involves scaled x1) - highest order, marginal = conditional - trans_interaction <- get_scale_transformation(fit = mock_fit, "mu_x1__xXx__f1b", formula_scale) - - coef_int_transformed <- trans_interaction$transformation_arguments$a + - trans_interaction$transformation_arguments$b * coef_scaled["scale(x1):f1b"] - - expect_equal(unname(coef_int_transformed), unname(coef_unscaled["x1:f1b"]), tolerance = 1e-10) -}) diff --git a/tests/testthat/test-model-averaging-plots.R b/tests/testthat/test-model-averaging-plots.R index 006c55c..66062c5 100644 --- a/tests/testthat/test-model-averaging-plots.R +++ b/tests/testthat/test-model-averaging-plots.R @@ -570,197 +570,186 @@ test_that("exp_lin transformation functions are defined correctly", { expect_equal(trans_funcs$jac(x, a, b), 1 / (b * x)) }) - -test_that("get_scale_transformation prior/posterior plots with cached fit", { +test_that("linear transformation matches expected behavior", { set.seed(1) - skip_if_not_installed("rjags") - skip_on_cran() + + # Create a normal prior + prior_list <- list(p1 = prior("normal", list(0, 1))) + + # Apply linear transformation: a + b*x with a=0, b=0.5 + # This should compress the distribution by half + vdiffr::expect_doppelganger("plot-normal-lin-compress", function() { + plot_prior_list(prior_list, + transformation = "lin", + transformation_arguments = list(a = 0, b = 0.5)) + }) + + # Apply linear transformation with offset: a + b*x with a=2, b=0.5 + # This should compress and shift + vdiffr::expect_doppelganger("plot-normal-lin-shift-compress", function() { + plot_prior_list(prior_list, + transformation = "lin", + transformation_arguments = list(a = 2, b = 0.5)) + }) +}) + + +# ============================================================================ # +# SECTION: transform_scaled visual tests +# ============================================================================ # +# These tests use pre-fitted regression models with formula_scale to visually +# verify that the transform_scaled feature correctly transforms priors and +# posteriors from standardized to original scale. + +test_that("transform_scaled is auto-detected from samples attribute", { skip_if_no_fits() - # Load the auto-scaled fit - fit <- readRDS(file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS")) - formula_scale <- attr(fit, "formula_scale") + # Load a model with formula_scale + fit_path <- file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS") + skip_if_not(file.exists(fit_path), "Pre-fitted model not available") - # Create priors matching those used in test-00-model-fits.R - prior_x_cont <- prior("normal", list(0, 1)) - prior_x_int <- prior("normal", list(0, 1)) - prior_intercept <- prior("normal", list(0, 5)) + fit <- readRDS(fit_path) - # Get transformations for the scaled parameters - # get_scale_transformation now returns MARGINAL transformation by default, + # Extract with transform_scaled = TRUE + samples_scaled <- as_mixed_posteriors(fit, parameters = "mu_intercept", transform_scaled = TRUE) - # using L2 norm of transformation coefficients for correct prior visualization - trans_x1 <- get_scale_transformation(fit, "mu_x_cont1", formula_scale) - trans_int <- get_scale_transformation(fit, "mu_x_cont1__xXx__x_cont2", formula_scale) - trans_intercept <- get_scale_transformation(fit, "mu_intercept", formula_scale) + # Verify the attribute is set - # Extract posterior samples and transform back to original scale - posterior <- as.matrix(coda::as.mcmc.list(fit)) - posterior_transformed <- transform_scale_samples(posterior, formula_scale) + expect_true(isTRUE(attr(samples_scaled, "transform_scaled"))) + expect_false(is.null(attr(samples_scaled, "prior_samples"))) - posterior_x1_unscaled <- posterior_transformed[, "mu_x_cont1"] - posterior_int_unscaled <- posterior_transformed[, "mu_x_cont1__xXx__x_cont2"] - posterior_intercept_unscaled <- posterior_transformed[, "mu_intercept"] + # Extract without transform_scaled + samples_unscaled <- as_mixed_posteriors(fit, parameters = "mu_intercept", transform_scaled = FALSE) - # 1x2 layout for x_cont1: scaled | unscaled - vdiffr::expect_doppelganger("scale-transform-x1-1x2", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(oldpar)) - par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) - - # Scaled panel: histogram of scaled posterior with posterior density and prior - hist(posterior[, "mu_x_cont1"], breaks = 50, probability = TRUE, - main = "x_cont1 (scaled)", xlab = "") - lines(stats::density(posterior[, "mu_x_cont1"]), col = "blue", lwd = 2) - lines(prior_x_cont, col = "red", lwd = 2) - - # Unscaled panel: histogram of unscaled posterior with density and transformed prior - hist(posterior_x1_unscaled, breaks = 50, probability = TRUE, - main = "x_cont1 (unscaled)", xlab = "") - lines(stats::density(posterior_x1_unscaled), col = "blue", lwd = 2) # Use transformed posterior - lines(stats::density( - trans_x1$transformation_arguments$a + trans_x1$transformation_arguments$b * posterior[, "mu_x_cont1"]), - col = "blue", lwd = 2, lty = 2) - lines(prior_x_cont, - transformation = trans_x1$transformation, - transformation_arguments = trans_x1$transformation_arguments, - col = "red", lwd = 2) - }) - - # 1x2 layout for interaction: scaled | unscaled - vdiffr::expect_doppelganger("scale-transform-interaction-1x2", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(oldpar)) - par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) - - # Scaled panel: histogram of scaled posterior with posterior density and prior - hist(posterior[, "mu_x_cont1__xXx__x_cont2"], breaks = 30, probability = TRUE, - main = "x1:x2 (scaled)", xlab = "") - lines(stats::density(posterior[, "mu_x_cont1__xXx__x_cont2"]), col = "blue", lwd = 2) - lines(prior_x_int, col = "red", lwd = 2) - - # Unscaled panel: histogram of unscaled posterior with density and transformed prior - hist(posterior_int_unscaled, breaks = 30, probability = TRUE, - main = "x1:x2 (unscaled)", xlab = "") - lines(stats::density(posterior_int_unscaled), col = "blue", lwd = 2) - lines(prior_x_int, - transformation = trans_int$transformation, - transformation_arguments = trans_int$transformation_arguments, - col = "red", lwd = 2) - }) - - # 1x2 layout for intercept: scaled | unscaled - # Intercept uses MARGINAL transformation (L2 norm of entire row) - vdiffr::expect_doppelganger("scale-transform-intercept-1x2", function() { - oldpar <- graphics::par(no.readonly = TRUE) - on.exit(graphics::par(oldpar)) - par(mfrow = c(1, 2), mar = c(4, 4, 2, 1)) - - # Scaled panel: histogram of scaled posterior with posterior density and prior - hist(posterior[, "mu_intercept"], breaks = 30, probability = TRUE, - main = "intercept (scaled)", xlab = "") - lines(stats::density(posterior[, "mu_intercept"]), col = "blue", lwd = 2) - lines(prior_intercept, col = "red", lwd = 2) - - # Unscaled panel: histogram of unscaled posterior with density and transformed prior - hist(posterior_intercept_unscaled, breaks = 30, probability = TRUE, - main = "intercept (unscaled)", xlab = "") - lines(stats::density(posterior_intercept_unscaled), col = "blue", lwd = 2) - lines(prior_intercept, - transformation = trans_intercept$transformation, - transformation_arguments = trans_intercept$transformation_arguments, - col = "red", lwd = 2) - }) + # Verify the attribute is NOT set + expect_null(attr(samples_unscaled, "transform_scaled")) }) -test_that("get_scale_transformation with dual parameter model (log intercept)", { - set.seed(1) - skip_if_not_installed("rjags") +test_that("transform_scaled visual: auto-scaled continuous predictors intercept", { skip_on_cran() skip_if_no_fits() - # Load the dual parameter regression fit (has log(intercept) for log_sigma) - fit <- readRDS(file.path(temp_fits_dir, "fit_dual_param_regression.RDS")) - formula_scale <- attr(fit, "formula_scale") + fit_path <- file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS") + skip_if_not(file.exists(fit_path), "Pre-fitted model not available") - # Create priors matching those used in test-00-model-fits.R - prior_mu_x <- prior("normal", list(0, 1)) - prior_ls_x <- prior("normal", list(0, 0.5)) + fit <- readRDS(fit_path) - # Get transformations for mu (standard intercept) - fit must be first argument - trans_mu_x <- get_scale_transformation(fit, "mu_x_mu", formula_scale) - trans_mu_int <- get_scale_transformation(fit, "mu_intercept", formula_scale) + # Extract posteriors with and without transform_scaled + samples_scaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = TRUE) + samples_unscaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = FALSE) - # Get transformations for log_sigma (log intercept) - trans_ls_x <- get_scale_transformation(fit, "log_sigma_x_sigma", formula_scale) - trans_ls_int <- get_scale_transformation(fit, "log_sigma_intercept", formula_scale) + # Visual test: intercept - scaled (left) vs original (right) + vdiffr::expect_doppelganger("transform-scaled-intercept-comparison", function() { + par(mfrow = c(1, 2)) - # Verify log_sigma intercept uses exp_lin transformation - expect_equal(trans_ls_int$transformation, "exp_lin") + # Left: Standardized scale + plot_posterior(samples_unscaled, "mu_intercept", prior = TRUE, + main = "Intercept (Standardized Scale)", dots_prior = list(col = "grey")) - # Extract posterior samples - posterior <- as.matrix(coda::as.mcmc.list(fit)) - - # Plot mu coefficient: standardized vs unscaled - vdiffr::expect_doppelganger("dual-mu-x-standardized", function() { - hist(posterior[, "mu_x_mu"], breaks = 30, probability = TRUE, - main = "mu_x_mu (standardized)", xlab = "") - lines(prior_mu_x, col = "red", lwd = 2) + # Right: Original scale (auto-detected from samples) + plot_posterior(samples_scaled, "mu_intercept", prior = TRUE, + main = "Intercept (Original Scale)", dots_prior = list(col = "grey")) }) +}) - posterior_mu_x_unscaled <- trans_mu_x$transformation_arguments$a + - trans_mu_x$transformation_arguments$b * posterior[, "mu_x_mu"] - vdiffr::expect_doppelganger("dual-mu-x-unscaled", function() { - hist(posterior_mu_x_unscaled, breaks = 30, probability = TRUE, - main = "mu_x_mu (unscaled)", xlab = "") - lines(prior_mu_x, - transformation = trans_mu_x$transformation, - transformation_arguments = trans_mu_x$transformation_arguments, - col = "red", lwd = 2) - }) +test_that("transform_scaled visual: auto-scaled continuous predictor coefficient", { + skip_on_cran() + skip_if_no_fits() + + fit_path <- file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS") + skip_if_not(file.exists(fit_path), "Pre-fitted model not available") + + fit <- readRDS(fit_path) + + samples_scaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = TRUE, n_prior_samples = 1e5) + samples_unscaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = FALSE) + + # Visual test: coefficient x_cont1 - scaled (left) vs original (right) + vdiffr::expect_doppelganger("transform-scaled-coef-x_cont1-comparison", function() { + par(mfrow = c(1, 2)) - # Plot log_sigma coefficient: standardized vs unscaled - vdiffr::expect_doppelganger("dual-log-sigma-x-standardized", function() { - hist(posterior[, "log_sigma_x_sigma"], breaks = 30, probability = TRUE, - main = "log_sigma_x_sigma (standardized)", xlab = "") - lines(prior_ls_x, col = "red", lwd = 2) + # Left: Standardized scale + plot_posterior(samples_unscaled, "mu_x_cont1", prior = TRUE, + main = "x_cont1 (Standardized Scale)", dots_prior = list(col = "grey")) + + # Right: Original scale (auto-detected from samples) + plot_posterior(samples_scaled, "mu_x_cont1", prior = TRUE, + main = "x_cont1 (Original Scale)", dots_prior = list(col = "grey")) }) - posterior_ls_x_unscaled <- trans_ls_x$transformation_arguments$a + - trans_ls_x$transformation_arguments$b * posterior[, "log_sigma_x_sigma"] + # Visual test: coefficient x_cont2 + vdiffr::expect_doppelganger("transform-scaled-coef-x_cont2-comparison", function() { + par(mfrow = c(1, 2)) + + plot_posterior(samples_unscaled, "mu_x_cont2", prior = TRUE, + main = "x_cont2 (Standardized Scale)", dots_prior = list(col = "grey")) - vdiffr::expect_doppelganger("dual-log-sigma-x-unscaled", function() { - hist(posterior_ls_x_unscaled, breaks = 30, probability = TRUE, - main = "log_sigma_x_sigma (unscaled)", xlab = "") - lines(prior_ls_x, - transformation = trans_ls_x$transformation, - transformation_arguments = trans_ls_x$transformation_arguments, - col = "red", lwd = 2) + plot_posterior(samples_scaled, "mu_x_cont2", prior = TRUE, + main = "x_cont2 (Original Scale)", dots_prior = list(col = "grey")) }) }) -test_that("linear transformation matches expected behavior", { - set.seed(1) +test_that("transform_scaled visual: all parameters side-by-side", { + skip_on_cran() + skip_if_no_fits() - # Create a normal prior - prior_list <- list(p1 = prior("normal", list(0, 1))) + fit_path <- file.path(temp_fits_dir, "fit_formula_auto_scaled.RDS") + skip_if_not(file.exists(fit_path), "Pre-fitted model not available") - # Apply linear transformation: a + b*x with a=0, b=0.5 - # This should compress the distribution by half - vdiffr::expect_doppelganger("plot-normal-lin-compress", function() { - plot_prior_list(prior_list, - transformation = "lin", - transformation_arguments = list(a = 0, b = 0.5)) + fit <- readRDS(fit_path) + + samples_scaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = TRUE) + samples_unscaled <- as_mixed_posteriors(fit, parameters = c("mu_intercept", "mu_x_cont1", "mu_x_cont2"), + transform_scaled = FALSE) + + # Visual test: 3x2 grid showing all parameters + vdiffr::expect_doppelganger("transform-scaled-all-params-grid", function() { + par(mfrow = c(3, 2), mar = c(4, 4, 2, 1)) + + # Row 1: Intercept + plot_posterior(samples_unscaled, "mu_intercept", prior = TRUE, main = "Intercept (Scaled)", dots_prior = list(col = "grey")) + plot_posterior(samples_scaled, "mu_intercept", prior = TRUE, main = "Intercept (Original)", dots_prior = list(col = "grey")) + + # Row 2: x_cont1 + plot_posterior(samples_unscaled, "mu_x_cont1", prior = TRUE, main = "x_cont1 (Scaled)", dots_prior = list(col = "grey")) + plot_posterior(samples_scaled, "mu_x_cont1", prior = TRUE, main = "x_cont1 (Original)", dots_prior = list(col = "grey")) + + # Row 3: x_cont2 + plot_posterior(samples_unscaled, "mu_x_cont2", prior = TRUE, main = "x_cont2 (Scaled)", dots_prior = list(col = "grey")) + plot_posterior(samples_scaled, "mu_x_cont2", prior = TRUE, main = "x_cont2 (Original)", dots_prior = list(col = "grey")) }) +}) - # Apply linear transformation with offset: a + b*x with a=2, b=0.5 - # This should compress and shift - vdiffr::expect_doppelganger("plot-normal-lin-shift-compress", function() { - plot_prior_list(prior_list, - transformation = "lin", - transformation_arguments = list(a = 2, b = 0.5)) + +test_that("transform_scaled visual: dual parameter regression with log(intercept)", { + skip_on_cran() + skip_if_no_fits() + + fit_path <- file.path(temp_fits_dir, "fit_dual_param_regression.RDS") + fit <- readRDS(fit_path) + + # Get available mu parameters (those with formula_scale applied) + params <- names(attr(fit, "prior_list")) + sigma_params <- params[grepl("^log_sigma_", params)] + + samples_scaled <- as_mixed_posteriors(fit, parameters = sigma_params, transform_scaled = TRUE) + samples_unscaled <- as_mixed_posteriors(fit, parameters = sigma_params, transform_scaled = FALSE) + + # Visual test: intercept for dual-parameter model + vdiffr::expect_doppelganger("transform-scaled-dual-param-intercept", function() { + par(mfrow = c(2, 2)) + plot_posterior(samples_unscaled, "log_sigma_intercept", prior = TRUE, main = "Dual: Intercept (Scaled)", dots_prior = list(col = "grey"), xlim = c(0, 1)) + plot_posterior(samples_scaled, "log_sigma_intercept", prior = TRUE, main = "Dual: Intercept (Original)", dots_prior = list(col = "grey"), xlim = c(0, 1)) + plot_posterior(samples_unscaled, "log_sigma_x_sigma", prior = TRUE, main = "Dual: Slope (Scaled)", dots_prior = list(col = "grey"), xlim = c(-1, 1)) + plot_posterior(samples_scaled, "log_sigma_x_sigma", prior = TRUE, main = "Dual: Slope (Original)", dots_prior = list(col = "grey"), xlim = c(-1, 1)) }) }) +