refactoring with switch in templates

IndrajeetPatil · Jan 12, 2021 · 1a38d39 · 1a38d39
1 parent ffce43c
commit 1a38d39
Show file tree

Hide file tree

Showing 29 changed files with 91 additions and 60 deletions.
diff --git a/API b/API
@@ -4,7 +4,7 @@
 
 bf_contingency_tab(data, x, y = NULL, counts = NULL, ratio = NULL, sampling.plan = "indepMulti", fixed.margin = "rows", prior.concentration = 1, top.text = NULL, output = "dataframe", k = 2L, ...)
 bf_corr_test(data, x, y, bf.prior = 0.707, ...)
-bf_expr_template(top.text, prior.type = quote(italic("r")["Cauchy"]^"JZS"), estimate.type = quote(delta), estimate.df, centrality = "median", conf.level = 0.95, conf.method = "HDI", k = 2L, ...)
+bf_expr_template(top.text, estimate.df, prior.type = NULL, estimate.type = NULL, centrality = "median", conf.level = 0.95, conf.method = "HDI", k = 2L, ...)
 bf_extractor(bf.object, conf.method = "hdi", centrality = "median", conf.level = 0.95, k = 2L, top.text = NULL, output = "dataframe", ...)
 bf_meta_random(data, metaBMA.args = list(), ...)
 bf_oneway_anova(data, x, y = NULL, subject.id = NULL, paired = FALSE, test.value = 0, bf.prior = 0.707, ...)

diff --git a/NAMESPACE b/NAMESPACE
@@ -19,12 +19,12 @@ importFrom(BayesFactor,correlationBF)
 importFrom(BayesFactor,logMeanExpLogs)
 importFrom(BayesFactor,ttestBF)
 importFrom(dplyr,filter)
+importFrom(dplyr,matches)
 importFrom(dplyr,mutate)
 importFrom(dplyr,pull)
 importFrom(dplyr,rename)
 importFrom(dplyr,rename_with)
 importFrom(dplyr,select)
-importFrom(dplyr,starts_with)
 importFrom(effectsize,effectsize)
 importFrom(insight,standardize_names)
 importFrom(ipmisc,"%$%")

diff --git a/R/bf_expr_template.R b/R/bf_expr_template.R
@@ -15,9 +15,9 @@
 #' @export
 
 bf_expr_template <- function(top.text,
-                             prior.type = quote(italic("r")["Cauchy"]^"JZS"),
-                             estimate.type = quote(delta),
                              estimate.df,
+                             prior.type = NULL,
+                             estimate.type = NULL,
                              centrality = "median",
                              conf.level = 0.95,
                              conf.method = "HDI",
@@ -34,6 +34,10 @@ bf_expr_template <- function(top.text,
       c(estimate.df$estimate[[1]], estimate.df$conf.low[[1]], estimate.df$conf.high[[1]])
   }
 
+  # if expression elements are `NULL`
+  if (is.null(prior.type)) prior.type <- prior_type_switch(estimate.df$method[[1]])
+  if (is.null(estimate.type)) estimate.type <- estimate_type_switch(estimate.df$method[[1]])
+
   # prepare the Bayes Factor message
   bf01_expr <-
     substitute(
@@ -78,3 +82,29 @@ bf_expr_template <- function(top.text,
   # return the final expression
   if (is.null(top.text)) bf01_expr$expr else bf01_expr
 }
+
+
+#' @noRd
+
+prior_type_switch <- function(method) {
+  switch(
+    method,
+    "Bayesian contingency tabs analysis" = quote(italic("a")["Gunel-Dickey"]),
+    quote(italic("r")["Cauchy"]^"JZS")
+  )
+}
+
+
+#' @noRd
+
+estimate_type_switch <- function(method) {
+  switch(
+    method,
+    "Bayesian contingency tabs analysis" = quote(italic("V")),
+    "Bayesian correlation analysis" = quote(italic(rho)),
+    "Bayesian meta-analysis using 'metaBMA'" = ,
+    "Bayesian t-test" = quote(italic(delta)),
+    "Bayes factors for linear models" = quote(italic(R^"2")),
+    quote(italic(delta))
+  )
+}
diff --git a/R/bf_ttest.R b/R/bf_ttest.R
@@ -136,22 +136,22 @@ bf_ttest <- function(data,
     # relevant arguments for `BayesFactor` t-test
     if (test.type == "t") {
       .f <- BayesFactor::ttestBF
-      if (paired) args <- list(x = data[[2]], y = data[[3]], rscale = bf.prior, paired = paired)
-      if (!paired) args <- list(formula = rlang::new_formula(y, x), rscale = bf.prior, paired = paired)
+      if (paired) .f.args <- list(x = data[[2]], y = data[[3]], rscale = bf.prior, paired = paired)
+      if (!paired) .f.args <- list(formula = rlang::new_formula(y, x), rscale = bf.prior, paired = paired)
     }
 
     # relevant arguments for `BayesFactor` one-way ANOVA
     if (test.type == "anova") {
       .f <- BayesFactor::anovaBF
       if (paired) {
-        args <- list(
+        .f.args <- list(
           formula = rlang::new_formula(rlang::enexpr(y), rlang::expr(!!rlang::enexpr(x) + rowid)),
           whichRandom = "rowid",
           rscaleFixed = bf.prior,
           rscaleRandom = 1
         )
       }
-      if (!paired) args <- list(formula = rlang::new_formula(y, x), rscaleFixed = bf.prior)
+      if (!paired) .f.args <- list(formula = rlang::new_formula(y, x), rscaleFixed = bf.prior)
     }
 
     # creating a `BayesFactor` object
@@ -160,7 +160,7 @@ bf_ttest <- function(data,
         .fn = .f,
         data = as.data.frame(data),
         progress = FALSE,
-        !!!args
+        !!!.f.args
       )
   }
 

diff --git a/R/global_vars.R b/R/global_vars.R
@@ -6,7 +6,7 @@ utils::globalVariables(
     "bf10",
     "rowid",
     "bf.prior",
-    "component",
+    "r2.component",
     "estimate",
     "estimate.LB",
     "estimate.UB",

diff --git a/R/helpers_bf_tests.R b/R/helpers_bf_tests.R
@@ -20,7 +20,7 @@
 #' @param ... Additional arguments passed to
 #'   [parameters::model_parameters.BFBayesFactor()].
 #'
-#' @importFrom dplyr mutate filter rename rename_with starts_with
+#' @importFrom dplyr mutate filter rename rename_with matches
 #' @importFrom insight standardize_names
 #' @importFrom performance r2_bayes
 #' @importFrom tidyr fill
@@ -75,57 +75,38 @@ bf_extractor <- function(bf.object,
     tidyr::fill(data = ., dplyr::matches("^prior|^bf"), .direction = "updown") %>%
     dplyr::mutate(log_e_bf10 = log(bf10))
 
-  # expression parameter defaults
-  c(prior.type, estimate.type) %<-% c(quote(italic("r")["Cauchy"]^"JZS"), quote(italic(delta)))
+  # ------------------------ ANOVA designs ------------------------------
 
-  # ------------------------ BayesFactor ---------------------------------
-
-  if (grepl("BFBayesFactor", class(bf.object)[[1]], fixed = TRUE)) {
-
-    # ------------------------ ANOVA designs ------------------------------
-
-    if (class(bf.object@denominator)[[1]] == "BFlinearModel") {
+  if ("method" %in% names(df)) {
+    if (df$method[[1]] == "Bayes factors for linear models") {
       # dataframe with posterior estimates for R-squared
       df_r2 <-
         performance::r2_bayes(bf.object, average = TRUE, ci = conf.level) %>%
         as_tibble(.) %>%
         insight::standardize_names(data = ., style = "broom") %>%
-        dplyr::rename_with(.fn = ~ paste0("r2.", .x), .cols = dplyr::starts_with("conf"))
+        dplyr::rename_with(.fn = ~ paste0("r2.", .x), .cols = dplyr::matches("^conf|^comp"))
 
       # for within-subjects design, retain only marginal component
-      if ("component" %in% names(df_r2)) {
-        df_r2 %<>%
-          dplyr::filter(component == "conditional") %>%
-          dplyr::rename("r2.component" = "component")
-      }
+      if ("r2.component" %in% names(df_r2)) df_r2 %<>% dplyr::filter(r2.component == "conditional")
 
       # combine everything
       df %<>% dplyr::bind_cols(., df_r2)
 
       # for expression
-      c(centrality, conf.method, estimate.type) %<-% c("median", "hdi", quote(italic(R^"2")))
-    }
-
-    # ------------------------ correlation ------------------------------
-
-    if (class(bf.object@denominator)[[1]] == "BFcorrelation") {
-      estimate.type <- quote(italic(rho))
+      c(centrality, conf.method) %<-% c("median", "hdi")
     }
 
     # ------------------------ contingency tabs ------------------------------
 
-    if (class(bf.object@denominator)[[1]] == "BFcontingencyTable") {
+    if (df$method[[1]] == "Bayesian contingency tabs analysis") {
       df %<>% dplyr::filter(grepl("cramer", term, TRUE))
-      c(estimate.type, prior.type) %<-% c(quote(italic("V")), quote(italic("a")["Gunel-Dickey"]))
     }
   }
 
   # Bayes Factor expression
   bf_expr_01 <-
     bf_expr_template(
       top.text = top.text,
-      prior.type = prior.type,
-      estimate.type = estimate.type,
       estimate.df = df,
       centrality = centrality,
       conf.level = conf.level,

diff --git a/README.md b/README.md
@@ -9,7 +9,7 @@
 | [![CRAN Checks](https://cranchecks.info/badges/summary/tidyBF)](https://cran.r-project.org/web/checks/check_results_tidyBF.html)                      | [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/IndrajeetPatil/tidyBF?branch=master&svg=true)](https://ci.appveyor.com/project/IndrajeetPatil/tidyBF) | [![Weekly downloads badge](https://cranlogs.r-pkg.org/badges/last-week/tidyBF?color=blue)](https://CRAN.R-project.org/package=tidyBF)   | [![Forks](https://img.shields.io/badge/forks-1-blue.svg)](https://github.com/IndrajeetPatil/tidyBF/)                                                   | [![Features](https://img.shields.io/badge/features-tidyBF-orange.svg?colorB=2196F3)](https://indrajeetpatil.github.io/tidyBF/reference/index.html)         |
 | [![minimal R version](https://img.shields.io/badge/R%3E%3D-3.6.0-6666ff.svg)](https://cran.r-project.org/)                                            | [![lifecycle](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/)                                                                     | [![Monthly downloads badge](https://cranlogs.r-pkg.org/badges/last-month/tidyBF?color=blue)](https://CRAN.R-project.org/package=tidyBF) | [![Github Issues](https://img.shields.io/badge/issues-1-red.svg)](https://github.com/IndrajeetPatil/tidyBF/issues)                                     | [![vignettes](https://img.shields.io/badge/vignettes-0.4.2-orange.svg?colorB=FF5722)](https://indrajeetpatil.github.io/statsExpressions/articles/)         |
 | [![GitHub code size in bytes](https://img.shields.io/github/languages/code-size/IndrajeetPatil/tidyBF.svg)](https://github.com/IndrajeetPatil/tidyBF) | [![Coverage Status](https://coveralls.io/repos/github/IndrajeetPatil/tidyBF/badge.svg?branch=master)](https://coveralls.io/github/IndrajeetPatil/tidyBF?branch=master)             | [![Total downloads badge](https://cranlogs.r-pkg.org/badges/grand-total/tidyBF?color=blue)](https://CRAN.R-project.org/package=tidyBF)  | [![Github Stars](https://img.shields.io/github/stars/IndrajeetPatil/tidyBF.svg?style=social&label=Github)](https://github.com/IndrajeetPatil/tidyBF)   | [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.2074621.svg)](https://doi.org/10.5281/zenodo.2074621)                                                  |
-| [![Licence](https://img.shields.io/badge/licence-GPL--3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html)                                      | [![Codecov test coverage](https://codecov.io/gh/IndrajeetPatil/tidyBF/branch/master/graph/badge.svg)](https://codecov.io/gh/IndrajeetPatil/tidyBF?branch=master)                   | [![HitCount](https://hits.dwyl.com/IndrajeetPatil/tidyBF.svg)](https://hits.dwyl.com/IndrajeetPatil/tidyBF)                             | [![Last-changedate](https://img.shields.io/badge/last%20change-2021--01--09-yellowgreen.svg)](https://github.com/IndrajeetPatil/tidyBF/commits/master) | [![GitHub last commit](https://img.shields.io/github/last-commit/IndrajeetPatil/tidyBF.svg)](https://github.com/IndrajeetPatil/tidyBF/commits/master)      |
+| [![Licence](https://img.shields.io/badge/licence-GPL--3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html)                                      | [![Codecov test coverage](https://codecov.io/gh/IndrajeetPatil/tidyBF/branch/master/graph/badge.svg)](https://codecov.io/gh/IndrajeetPatil/tidyBF?branch=master)                   | [![HitCount](https://hits.dwyl.com/IndrajeetPatil/tidyBF.svg)](https://hits.dwyl.com/IndrajeetPatil/tidyBF)                             | [![Last-changedate](https://img.shields.io/badge/last%20change-2021--01--12-yellowgreen.svg)](https://github.com/IndrajeetPatil/tidyBF/commits/master) | [![GitHub last commit](https://img.shields.io/github/last-commit/IndrajeetPatil/tidyBF.svg)](https://github.com/IndrajeetPatil/tidyBF/commits/master)      |
 | [![status](https://tinyverse.netlify.com/badge/tidyBF)](https://CRAN.R-project.org/package=tidyBF)                                                    | [![R build status](https://github.com/IndrajeetPatil/tidyBF/workflows/R-CMD-check/badge.svg)](https://github.com/IndrajeetPatil/tidyBF)                                            | [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.png)](https://gitter.im/tidyBF/community)                                      | [![Project Status](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)                                           | [![contributions welcome](https://img.shields.io/badge/contributions-welcome-brightgreen.svg?style=flat)](https://github.com/IndrajeetPatil/tidyBF/issues) |
 
 # Overview <img src="man/figures/logo.png" align="right" width="240" />

diff --git a/codemeta.json b/codemeta.json
@@ -266,7 +266,7 @@
     "name": "Comprehensive R Archive Network (CRAN)",
     "url": "https://cran.r-project.org"
   },
-  "fileSize": "1721.176KB",
+  "fileSize": "1736.534KB",
   "citation": [
     {
       "@type": "ScholarlyArticle",

diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -2,7 +2,7 @@ pandoc: 2.11.3.2
 pkgdown: 1.6.1.9000
 pkgdown_sha: e5847476d79f08b4cdca0ed5cc55bf55fc18a161
 articles: {}
-last_built: 2021-01-09T18:06Z
+last_built: 2021-01-12T15:50Z
 urls:
   reference: https://indrajeetpatil.github.io/tidyBF//reference
   article: https://indrajeetpatil.github.io/tidyBF//articles

diff --git a/docs/reference/bf_expr_template.html b/docs/reference/bf_expr_template.html