Merge pull request #10 from IndrajeetPatil/remove_bf_expr

retire bf_expr; simplifies everything
IndrajeetPatil · Oct 28, 2020 · f429096 · f429096
2 parents 790ceb0 + aec8a5f
commit f429096
Show file tree

Hide file tree

Showing 41 changed files with 1,169 additions and 1,285 deletions.
diff --git a/API b/API
@@ -3,14 +3,12 @@
 ## Exported functions
 
 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, top.text = NULL, output = "dataframe", k = 2L, ...)
-bf_expr(bf.object, k = 2L, conf.level = 0.95, conf.method = "hdi", centrality = "median", top.text = NULL, anova.design = FALSE, ...)
-bf_expr_template(top.text, bf.prior = 0.707, 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_extractor(bf.object, conf.method = "hdi", centrality = "median", conf.level = 0.95, ...)
-bf_meta(data, d = prior("norm", c(mean = 0, sd = 0.3)), tau = prior("invgamma", c(shape = 1, scale = 0.15)), metaBMA.args = list(), k = 2L, output = "dataframe", top.text = NULL, ...)
-bf_meta_random(data, d = prior("norm", c(mean = 0, sd = 0.3)), tau = prior("invgamma", c(shape = 1, scale = 0.15)), metaBMA.args = list(), k = 2L, output = "dataframe", top.text = NULL, ...)
-bf_oneway_anova(data, x, y, subject.id = NULL, paired = FALSE, bf.prior = 0.707, top.text = NULL, output = "dataframe", k = 2L, ...)
-bf_ttest(data, x, y = NULL, subject.id = NULL, paired = FALSE, test.value = 0, bf.prior = 0.707, 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_extractor(bf.object, conf.method = "hdi", centrality = "median", conf.level = 0.95, k = 2L, top.text = NULL, output = "dataframe", ...)
+bf_meta_random(data, d = prior("norm", c(mean = 0, sd = 0.3)), tau = prior("invgamma", c(shape = 1, scale = 0.15)), metaBMA.args = list(), ...)
+bf_oneway_anova(data, x, y, subject.id = NULL, paired = FALSE, bf.prior = 0.707, ...)
+bf_ttest(data, x, y = NULL, subject.id = NULL, paired = FALSE, test.value = 0, bf.prior = 0.707, ...)
 meta_data_check(data)
 
 ## Reexported objects

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -35,7 +35,6 @@ Depends:
     R (>= 3.6.0)
 Imports: 
     BayesFactor,
-    bayestestR (>= 0.7.5),
     dplyr,
     effectsize (>= 0.4.0),
     insight (>= 0.10.0),

diff --git a/NAMESPACE b/NAMESPACE
@@ -10,10 +10,8 @@ export(":=")
 export(as_tibble)
 export(bf_contingency_tab)
 export(bf_corr_test)
-export(bf_expr)
 export(bf_expr_template)
 export(bf_extractor)
-export(bf_meta)
 export(bf_meta_random)
 export(bf_oneway_anova)
 export(bf_ttest)
@@ -25,15 +23,14 @@ importFrom(BayesFactor,contingencyTableBF)
 importFrom(BayesFactor,correlationBF)
 importFrom(BayesFactor,logMeanExpLogs)
 importFrom(BayesFactor,ttestBF)
-importFrom(bayestestR,describe_prior)
-importFrom(dplyr,bind_cols)
 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,get_priors)
 importFrom(insight,standardize_names)
 importFrom(ipmisc,"%$%")
 importFrom(ipmisc,"%<-%")

diff --git a/R/bf_contingency_tab.R b/R/bf_contingency_tab.R
@@ -25,7 +25,8 @@
 #'   there are four levels this will be `ratio = c(0.25,0.25,0.25,0.25)`, etc.
 #' @param counts A string naming a variable in data containing counts, or `NULL`
 #'   if each row represents a single observation.
-#' @inheritParams bf_expr
+#' @inheritParams bf_extractor
+#' @inheritDotParams bf_extractor -bf.object
 #'
 #' @importFrom BayesFactor contingencyTableBF logMeanExpLogs
 #' @importFrom dplyr pull select rename mutate
@@ -117,11 +118,8 @@ bf_contingency_tab <- function(data,
         priorConcentration = prior.concentration
       )
 
-    # extracting results from Bayesian test and creating a dataframe
-    df <- bf_extractor(bf_object)
-
     # Bayes Factor expression
-    bf01_expr <- bf_expr(bf_object, k = k, top.text = top.text, ...)
+    return(bf_extractor(bf_object, k = k, top.text = top.text, output = output, ...))
   }
 
   # ---------------------------- goodness of fit ----------------------------
@@ -201,12 +199,12 @@ bf_contingency_tab <- function(data,
 
     # the final expression
     if (is.null(top.text)) bf01_expr <- bf01_expr$expr
-  }
 
-  # return the expression or the dataframe
-  switch(
-    EXPR = output,
-    "dataframe" = df,
-    bf01_expr
-  )
+    # return the expression or the dataframe
+    return(switch(
+      EXPR = output,
+      "dataframe" = df,
+      bf01_expr
+    ))
+  }
 }
diff --git a/R/bf_corr_test.R b/R/bf_corr_test.R
@@ -9,8 +9,8 @@
 #'   (e.g., `"y"`) or as a bare expression (e.g, `y`).
 #' @param bf.prior A number between `0.5` and `2` (default `0.707`), the prior
 #'   width to use in calculating Bayes factors.
-#' @inheritParams bf_expr
 #' @inheritParams bf_ttest
+#' @inheritDotParams bf_extractor -bf.object
 #'
 #' @importFrom BayesFactor correlationBF
 #' @importFrom dplyr pull
@@ -47,9 +47,6 @@ bf_corr_test <- function(data,
                          x,
                          y,
                          bf.prior = 0.707,
-                         top.text = NULL,
-                         output = "dataframe",
-                         k = 2L,
                          ...) {
 
   # extracting results from Bayesian test and creating a dataframe
@@ -60,10 +57,6 @@ bf_corr_test <- function(data,
       rscale = bf.prior
     )
 
-  # return the text results or the dataframe with results
-  switch(
-    EXPR = output,
-    "dataframe" = bf_extractor(bf_object),
-    bf_expr(bf_object, k = k, top.text = top.text, ...)
-  )
+  # final return
+  bf_extractor(bf_object, ...)
 }
diff --git a/R/bf_expr_template.R b/R/bf_expr_template.R
@@ -7,13 +7,14 @@
 #'   intervals along with Bayes Factor value. The columns should be named as
 #'   `estimate`, `estimate.LB`, `estimate.UB`, and `bf10`.
 #' @param ... Currently ignored.
-#' @inheritParams bf_expr
+#' @inheritParams bf_extractor
 #' @inheritParams bf_ttest
 #'
+#' @importFrom ipmisc specify_decimal_p
+#'
 #' @export
 
 bf_expr_template <- function(top.text,
-                             bf.prior = 0.707,
                              prior.type = quote(italic("r")["Cauchy"]^"JZS"),
                              estimate.type = quote(delta),
                              estimate.df,
@@ -33,6 +34,9 @@ bf_expr_template <- function(top.text,
       c(estimate.df$estimate[[1]], estimate.df$conf.low[[1]], estimate.df$conf.high[[1]])
   }
 
+  # prior
+  bf.prior <- estimate.df$prior.scale[[1]]
+
   # prepare the Bayes Factor message
   bf01_expr <-
     substitute(

diff --git a/R/bf_meta_random.R b/R/bf_meta_random.R
@@ -5,12 +5,11 @@
 #'   sizes or outcomes)  and `std.error` (corresponding standard errors). These
 #'   two columns will be used for `y`  and `SE` arguments in
 #'   `metaBMA::meta_random`.
-#' @inheritParams bf_expr
 #' @inheritParams bf_ttest
 #' @inheritParams metaBMA::meta_random
 #' @param metaBMA.args A list of additional arguments to be passed to
 #'   `metaBMA::meta_random`.
-#' @param ... Additional arguments passed to `bf_expr`.
+#' @inheritDotParams bf_extractor -bf.object
 #'
 #' @importFrom metaBMA meta_random prior
 #' @importFrom rlang exec !!!
@@ -62,9 +61,6 @@ bf_meta_random <- function(data,
                            d = prior("norm", c(mean = 0, sd = 0.3)),
                            tau = prior("invgamma", c(shape = 1, scale = 0.15)),
                            metaBMA.args = list(),
-                           k = 2L,
-                           output = "dataframe",
-                           top.text = NULL,
                            ...) {
 
   # check the data contains needed column
@@ -83,18 +79,6 @@ bf_meta_random <- function(data,
       !!!metaBMA.args
     )
 
-  # return the text results or the dataframe with results
-  switch(
-    EXPR = output,
-    "dataframe" = bf_extractor(bf_object),
-    bf_expr(bf_object, k = k, top.text = top.text, ...)
-  )
+  # final return
+  bf_extractor(bf_object, ...)
 }
-
-# aliases -----------------------------------------------------------------
-
-#' @rdname bf_meta_random
-#' @aliases bf_meta_random
-#' @export
-
-bf_meta <- bf_meta_random
diff --git a/R/bf_oneway_anova.R b/R/bf_oneway_anova.R
@@ -8,7 +8,7 @@
 #'
 #' @importFrom BayesFactor anovaBF
 #' @importFrom dplyr mutate
-#' @importFrom rlang new_formula enexpr expr
+#' @importFrom rlang new_formula enexpr expr exec !!!
 #' @importFrom ipmisc long_to_wide_converter
 #' @importFrom lme4 nobars findbars
 #'
@@ -21,8 +21,8 @@
 #'   dataframe `data`.
 #' @inheritParams bf_ttest
 #' @inheritParams bf_corr_test
-#' @inheritParams bf_expr
 #' @inheritParams ipmisc::long_to_wide_converter
+#' @inheritDotParams bf_extractor -bf.object
 #'
 #' @seealso \code{\link{bf_contingency_tab}}, \code{\link{bf_corr_test}},
 #' \code{\link{bf_ttest}}
@@ -64,15 +64,10 @@ bf_oneway_anova <- function(data,
                             subject.id = NULL,
                             paired = FALSE,
                             bf.prior = 0.707,
-                            top.text = NULL,
-                            output = "dataframe",
-                            k = 2L,
                             ...) {
   # make sure both quoted and unquoted arguments are allowed
   c(x, y) %<-% c(rlang::ensym(x), rlang::ensym(y))
 
-  # ============================ data preparation ==========================
-
   # have a proper cleanup with NA removal
   data %<>%
     ipmisc::long_to_wide_converter(
@@ -82,47 +77,29 @@ bf_oneway_anova <- function(data,
       subject.id = {{ subject.id }},
       paired = paired,
       spread = FALSE
-    )
-
-  # ========================= within-subjects design ==========================
+    ) %>%
+    dplyr::mutate(.data = ., rowid = as.factor(rowid))
 
+  # relevant arguments
   if (isTRUE(paired)) {
-    # remove NAs
-    data %<>% dplyr::mutate(.data = ., rowid = as.factor(rowid))
-
-    # extracting results from Bayesian test (`y ~ x + id`) and creating a dataframe
-    bf_object <-
-      BayesFactor::anovaBF(
-        formula = rlang::new_formula(
-          {{ rlang::enexpr(y) }}, rlang::expr(!!rlang::enexpr(x) + rowid)
-        ),
-        data = as.data.frame(data),
-        whichRandom = "rowid",
-        rscaleFixed = bf.prior,
-        progress = FALSE,
-        rscaleRandom = 1
-      )
-  }
-
-  # ========================= between-subjects design =========================
-
-  if (isFALSE(paired)) {
-    # extracting results from Bayesian test and creating a dataframe
-    bf_object <-
-      BayesFactor::anovaBF(
-        formula = rlang::new_formula({{ y }}, {{ x }}),
-        data = as.data.frame(data),
-        rscaleFixed = bf.prior,
-        progress = FALSE
-      )
+    bf.args <- list(
+      formula = rlang::new_formula({{ rlang::enexpr(y) }}, rlang::expr(!!rlang::enexpr(x) + rowid)),
+      whichRandom = "rowid",
+      rscaleRandom = 1
+    )
   }
+  if (isFALSE(paired)) bf.args <- list(formula = rlang::new_formula({{ y }}, {{ x }}))
 
-  # ============================ return ==================================
+  # creating a BayesFactor object
+  bf_object <-
+    rlang::exec(
+      .fn = BayesFactor::anovaBF,
+      data = as.data.frame(data),
+      rscaleFixed = bf.prior,
+      progress = FALSE,
+      !!!bf.args
+    )
 
-  # return the text results or the dataframe with results
-  switch(
-    EXPR = output,
-    "dataframe" = bf_extractor(bf_object),
-    bf_expr(bf_object, k = k, top.text = top.text, anova.design = TRUE, ...)
-  )
+  # final return
+  bf_extractor(bf_object, ...)
 }
diff --git a/R/bf_ttest.R b/R/bf_ttest.R
@@ -7,17 +7,14 @@
 #' @param x Either the grouping variable from the dataframe `data` if it's a
 #'   two-sample *t*-test or a numeric variable if it's a one-sample *t*-test.
 #' @inheritParams bf_corr_test
-#' @inheritParams bf_expr
 #' @inheritParams bf_oneway_anova
 #' @param test.value A number specifying the value of the null hypothesis
 #'   (Default: `0`).
-#' @param output If `"expression"`, will return expression with statistical
-#'   details, while `"dataframe"` will return a dataframe containing the
-#'   results.
 #' @inheritParams ipmisc::long_to_wide_converter
+#' @inheritDotParams bf_extractor -bf.object
 #'
 #' @importFrom BayesFactor ttestBF
-#' @importFrom rlang quo_is_null new_formula ensym enquo
+#' @importFrom rlang quo_is_null new_formula ensym enquo exec !!!
 #' @importFrom stats na.omit
 #' @importFrom dplyr pull
 #' @importFrom ipmisc long_to_wide_converter
@@ -73,9 +70,6 @@ bf_ttest <- function(data,
                      paired = FALSE,
                      test.value = 0,
                      bf.prior = 0.707,
-                     top.text = NULL,
-                     output = "dataframe",
-                     k = 2L,
                      ...) {
 
   # make sure both quoted and unquoted arguments are allowed
@@ -107,39 +101,22 @@ bf_ttest <- function(data,
         spread = paired
       )
 
-    # within-subjects design
-    if (isTRUE(paired)) {
-      # extracting results from Bayesian test and creating a dataframe
-      bf_object <-
-        BayesFactor::ttestBF(
-          x = data[[2]],
-          y = data[[3]],
-          rscale = bf.prior,
-          paired = TRUE,
-          progress = FALSE
-        )
-    }
+    # relevant arguments
+    if (isTRUE(paired)) bf.args <- list(x = data[[2]], y = data[[3]])
+    if (isFALSE(paired)) bf.args <- list(formula = rlang::new_formula({{ y }}, {{ x }}))
 
-    # between-subjects design
-    if (isFALSE(paired)) {
-      # extracting results from Bayesian test and creating a dataframe
-      bf_object <-
-        BayesFactor::ttestBF(
-          formula = rlang::new_formula({{ y }}, {{ x }}),
-          data = as.data.frame(data),
-          rscale = bf.prior,
-          paired = FALSE,
-          progress = FALSE
-        )
-    }
+    # creating a BayesFactor object
+    bf_object <-
+      rlang::exec(
+        .fn = BayesFactor::ttestBF,
+        rscale = bf.prior,
+        paired = paired,
+        progress = FALSE,
+        data = as.data.frame(data),
+        !!!bf.args
+      )
   }
 
-  # -------------------------- return --------------------------
-
-  # return the text results or the dataframe with results
-  switch(
-    EXPR = output,
-    "dataframe" = bf_extractor(bf_object),
-    bf_expr(bf_object, k = k, top.text = top.text, ...)
-  )
+  # final return
+  bf_extractor(bf_object, ...)
 }