From dcf2e738f23e41f56c047c06b9f67fd1ddbe091c Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Fri, 17 Jan 2020 22:38:48 +0100 Subject: [PATCH] minor edits --- .travis.yml | 2 +- API | 5 +++- R/helpers_bf_tests.R | 61 +++++++++++++++++++------------------------- 3 files changed, 31 insertions(+), 37 deletions(-) diff --git a/.travis.yml b/.travis.yml index 5515e1b5..e41b0829 100644 --- a/.travis.yml +++ b/.travis.yml @@ -143,7 +143,7 @@ jobs: before_install: - mkdir -p ~/.R/ - - echo "CXX14 = g++-7 -fPIC -flto=2" >> ~/.R/Makevars + - echo "CXX14 = g++-7 -fPIC" >> ~/.R/Makevars - echo "CXX14FLAGS = -mtune=native -march=native -Wno-unused-variable -Wno-unused-function -Wno-unused-local-typedefs -Wno-ignored-attributes -Wno-deprecated-declarations -Wno-attributes -O3" >> ~/.R/Makevars after_success: diff --git a/API b/API index 5fe91881..550a6daa 100644 --- a/API +++ b/API @@ -2,14 +2,17 @@ bf_contingency_tab(data, x, y = NULL, counts = NULL, ratio = NULL, sampling.plan bf_corr_test(data, x, y, bf.prior = 0.707, caption = NULL, output = "null", k = 2, ...) bf_expr(bf.df, k = 2, output = "null", caption = NULL, ...) bf_extractor(bf.object, ...) +bf_meta(data, d = prior, norm, c(mean = 0, sd = 0.3), tau = prior, invgamma, c(shape = 1, scale = 0.15), k = 2, caption = NULL, messages = TRUE, ...) bf_oneway_anova(data, x, y, bf.prior = 0.707, caption = NULL, output = "null", paired = FALSE, k = 2, ...) bf_ttest(data, x, y = NULL, test.value = 0, paired = FALSE, bf.prior = 0.707, caption = NULL, output = "null", k = 2, ...) expr_anova_bayes(data, x, y, paired = FALSE, bf.prior = 0.707, k = 2, ...) expr_anova_nonparametric(data, x, y, paired = FALSE, conf.type = "perc", conf.level = 0.95, k = 2, nboot = 100, stat.title = NULL, messages = TRUE, ...) expr_anova_parametric(data, x, y, paired = FALSE, effsize.type = "unbiased", partial = TRUE, conf.level = 0.95, nboot = 100, var.equal = FALSE, sphericity.correction = TRUE, k = 2, stat.title = NULL, messages = TRUE, ...) expr_anova_robust(data, x, y, paired = FALSE, tr = 0.1, nboot = 100, conf.level = 0.95, conf.type = "norm", k = 2, stat.title = NULL, messages = TRUE, ...) -expr_contingency_tab(data, x, y = NULL, counts = NULL, ratio = NULL, nboot = 100, paired = FALSE, stat.title = NULL, legend.title = NULL, conf.level = 0.95, conf.type = "norm", bias.correct = FALSE, k = 2, messages = TRUE, ...) +expr_contingency_tab(data, x, y = NULL, counts = NULL, ratio = NULL, nboot = 100, paired = FALSE, stat.title = NULL, legend.title = NULL, conf.level = 0.95, conf.type = "norm", bias.correct = TRUE, k = 2, messages = TRUE, ...) expr_corr_test(data, x, y, nboot = 100, beta = 0.1, type = "pearson", bf.prior = 0.707, conf.level = 0.95, conf.type = "norm", k = 2, stat.title = NULL, messages = TRUE, ...) +expr_meta_parametric(data, conf.level = 0.95, k = 2, messages = FALSE, output = "subtitle", caption = NULL, ...) +expr_meta_robust(data, random = "mixture", k = 2, messages = FALSE, ...) expr_t_bayes(data, x, y, bf.prior = 0.707, paired = FALSE, k = 2, ...) expr_t_nonparametric(data, x, y, paired = FALSE, k = 2, conf.level = 0.95, conf.type = "norm", nboot = 100, stat.title = NULL, messages = TRUE, ...) expr_t_onesample(data, x, type = "parametric", test.value = 0, bf.prior = 0.707, robust.estimator = "onestep", effsize.type = "g", effsize.noncentral = TRUE, conf.level = 0.95, conf.type = "norm", nboot = 100, k = 2, stat.title = NULL, messages = TRUE, ...) diff --git a/R/helpers_bf_tests.R b/R/helpers_bf_tests.R index 12c33007..d2a94146 100644 --- a/R/helpers_bf_tests.R +++ b/R/helpers_bf_tests.R @@ -22,28 +22,15 @@ # function body bf_extractor <- function(bf.object, ...) { - - # preparing the dataframe - bf_df <- - BayesFactor::extractBF( - x = bf.object, - logbf = FALSE, - onlybf = FALSE - ) %>% + BayesFactor::extractBF( + x = bf.object, + logbf = FALSE, + onlybf = FALSE + ) %>% tibble::as_tibble(.) %>% dplyr::select(.data = ., -time, -code) %>% dplyr::rename(.data = ., bf10 = bf) %>% - dplyr::mutate( - .data = ., - bf01 = 1 / bf10, - log_e_bf10 = log(bf10), - log_e_bf01 = -1 * log_e_bf10, - log_10_bf10 = log10(bf10), - log_10_bf01 = -1 * log_10_bf10 - ) - - # return the dataframe with Bayes Factors - return(bf_df) + bf_formatter(.) } #' @title Prepare caption with expression for Bayes Factor results @@ -257,7 +244,7 @@ bf_corr_test <- function(data, #' #' @importFrom BayesFactor contingencyTableBF logMeanExpLogs #' @importFrom stats dmultinom rgamma -#' @importFrom dplyr pull select rename mutate +#' @importFrom dplyr pull select rename mutate tibble #' @importFrom tidyr uncount drop_na #' #' @seealso \code{\link{bf_corr_test}}, \code{\link{bf_oneway_anova}}, @@ -418,7 +405,7 @@ bf_contingency_tab <- function(data, # estimate log prob of data under null with Monte Carlo M <- 100000 - # `rdirichlet` function + # `rdirichlet` function from `MCMCpack` rdirichlet_int <- function(n, alpha) { l <- length(alpha) x <- matrix(stats::rgamma(l * n, alpha), ncol = l, byrow = TRUE) @@ -439,21 +426,10 @@ bf_contingency_tab <- function(data, # estimate log prob of data under alternative pr_y_h1 <- BayesFactor::logMeanExpLogs(tmp_pr_h1) - # computing Bayes Factor - bf_10 <- exp(pr_y_h1 - pr_y_h0) - - # dataframe with results + # computing Bayes Factor and formatting the results bf_results <- - tibble::enframe(bf_10) %>% - dplyr::select(.data = ., bf10 = value) %>% - dplyr::mutate( - .data = ., - bf01 = 1 / bf10, - log_e_bf10 = log(bf10), - log_e_bf01 = -1 * log_e_bf10, - log_10_bf10 = log10(bf10), - log_10_bf01 = -1 * log_10_bf10 - ) %>% + dplyr::tibble(bf10 = exp(pr_y_h1 - pr_y_h0)) %>% + bf_formatter(.) %>% dplyr::mutate(.data = ., prior.concentration = prior.concentration) } @@ -873,6 +849,7 @@ bf_oneway_anova <- function(data, #' @title Bayes factor message for random-effects meta-analysis #' @name bf_meta +#' #' @importFrom metaBMA meta_random prior #' #' @inherit metaBMA::meta_random return Description @@ -991,3 +968,17 @@ bf_meta <- function(data, # return the caption return(bf_text) } + +#' @noRd +#' @keywords internal + +bf_formatter <- function(data) { + dplyr::mutate( + .data = data, + bf01 = 1 / bf10, + log_e_bf10 = log(bf10), + log_e_bf01 = -1 * log_e_bf10, + log_10_bf10 = log10(bf10), + log_10_bf01 = -1 * log_10_bf10 + ) +}