Merge pull request #9 from IndrajeetPatil/bf_expr_template

initialize refactoring

API

@@ -5,11 +5,12 @@
 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)), k = 2L, conf.level = 0.95, 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)), k = 2L, conf.level = 0.95, output = "dataframe", top.text = NULL, ...)
-bf_oneway_anova(data, x, y, subject.id = NULL, bf.prior = 0.707, top.text = NULL, output = "dataframe", paired = FALSE, k = 2L, ...)
-bf_ttest(data, x, y = NULL, subject.id = NULL, test.value = 0, paired = FALSE, bf.prior = 0.707, top.text = NULL, output = "dataframe", k = 2L, ...)
+bf_meta(data, d = prior("norm", c(mean = 0, sd = 0.3)), tau = prior("invgamma", c(shape = 1, scale = 0.15)), 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)), 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, ...)
 meta_data_check(data)
 
 ## Reexported objects

DESCRIPTION

@@ -21,8 +21,6 @@ URL: https://indrajeetpatil.github.io/tidyBF/,
     https://github.com/IndrajeetPatil/tidyBF
 BugReports: https://github.com/IndrajeetPatil/tidyBF/issues
 Remotes:  
-    easystats/insight,
-    easystats/bayestestR,
     easystats/parameters,
     easystats/performance,
     easystats/effectsize,
@@ -40,8 +38,8 @@ Imports:
     BayesFactor (>= 0.9.12-4.3),
     bayestestR (>= 0.7.5),
     dplyr,
-    effectsize (>= 0.3.9.009),
-    insight (>= 0.10.1),
+    effectsize (>= 0.4.0),
+    insight (>= 0.10.0),
     ipmisc (>= 4.1.0),
     lme4,
     metaBMA,

NAMESPACE

@@ -11,6 +11,7 @@ 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)
@@ -32,7 +33,6 @@ importFrom(dplyr,rename)
 importFrom(dplyr,rename_with)
 importFrom(dplyr,select)
 importFrom(dplyr,starts_with)
-importFrom(dplyr,tibble)
 importFrom(effectsize,effectsize)
 importFrom(insight,standardize_names)
 importFrom(ipmisc,"%$%")
@@ -60,6 +60,8 @@ importFrom(rlang,ensym)
 importFrom(rlang,expr)
 importFrom(rlang,new_formula)
 importFrom(rlang,quo_is_null)
+importFrom(stats,dmultinom)
 importFrom(stats,na.omit)
+importFrom(stats,rgamma)
 importFrom(tidyr,drop_na)
 importFrom(tidyr,uncount)

R/bf_contingency_tab.R

@@ -24,11 +24,13 @@
 #'   This means if there are two levels this will be `ratio = c(0.5,0.5)` or if
 #'   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 (Default).
+#'   if each row represents a single observation.
+#' @inheritParams bf_expr
 #'
 #' @importFrom BayesFactor contingencyTableBF logMeanExpLogs
-#' @importFrom dplyr pull select rename mutate tibble
+#' @importFrom dplyr pull select rename mutate
 #' @importFrom tidyr uncount drop_na
+#' @importFrom stats dmultinom rgamma
 #'
 #' @seealso \code{\link{bf_corr_test}}, \code{\link{bf_oneway_anova}},
 #' \code{\link{bf_ttest}}
@@ -106,22 +108,20 @@ bf_contingency_tab <- function(data,
     # dropping unused levels
     data %<>% dplyr::mutate(.data = ., {{ y }} := droplevels(as.factor({{ y }})))
 
-    # extracting results from Bayesian test and creating a dataframe
-    df <-
-      bf_extractor(
-        BayesFactor::contingencyTableBF(
-          x = table(data %>% dplyr::pull({{ x }}), data %>% dplyr::pull({{ y }})),
-          sampleType = sampling.plan,
-          fixedMargin = fixed.margin,
-          priorConcentration = prior.concentration
-        )
-      ) %>%
-      dplyr::mutate(
-        .data = .,
-        sampling.plan = sampling.plan,
-        fixed.margin = fixed.margin,
-        prior.concentration = prior.concentration
+    # Bayes Factor object
+    bf_object <-
+      BayesFactor::contingencyTableBF(
+        x = table(data %>% dplyr::pull({{ x }}), data %>% dplyr::pull({{ y }})),
+        sampleType = sampling.plan,
+        fixedMargin = fixed.margin,
+        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, ...)
   }
 
   # ---------------------------- goodness of fit ----------------------------
@@ -174,36 +174,34 @@ bf_contingency_tab <- function(data,
     # computing Bayes Factor and formatting the results
     df <-
       tibble(bf10 = exp(pr_y_h1 - pr_y_h0)) %>%
-      dplyr::mutate(log_e_bf10 = log(bf10), prior.concentration = prior.concentration)
-  }
-
-  # ========================= top.text preparation =============================
-
-  # final expression
-  bf01_expr <-
-    substitute(
-      atop(
-        displaystyle(top.text),
-        expr = paste(
-          "log"["e"],
-          "(BF"["01"],
-          ") = ",
-          bf,
-          ", ",
-          italic("a")["Gunel-Dickey"],
-          " = ",
-          a
+      dplyr::mutate(log_e_bf10 = log(bf10), prior.scale = prior.concentration)
+
+    # final expression
+    bf01_expr <-
+      substitute(
+        atop(
+          displaystyle(top.text),
+          expr = paste(
+            "log"["e"],
+            "(BF"["01"],
+            ") = ",
+            bf,
+            ", ",
+            italic("a")["Gunel-Dickey"],
+            " = ",
+            a
+          )
+        ),
+        env = list(
+          top.text = top.text,
+          bf = specify_decimal_p(x = -log(df$bf10[[1]]), k = k),
+          a = specify_decimal_p(x = df$prior.scale[[1]], k = k)
         )
-      ),
-      env = list(
-        top.text = top.text,
-        bf = specify_decimal_p(x = -log(df$bf10[[1]]), k = k),
-        a = specify_decimal_p(x = df$prior.concentration[[1]], k = k)
       )
-    )
 
-  # the final expression
-  if (is.null(top.text)) bf01_expr <- bf01_expr$expr
+    # the final expression
+    if (is.null(top.text)) bf01_expr <- bf01_expr$expr
+  }
 
   # return the expression or the dataframe
   switch(

R/bf_expr_template.R

@@ -0,0 +1,79 @@
+#' @title Expression template for Bayes Factor results
+#' @name bf_expr_template
+#'
+#' @param prior.type A character that specifies the prior type.
+#' @param estimate.type A character that specifies the relevant effect size.
+#' @param estimate.df Dataframe containing estimates and their credible
+#'   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_ttest
+#'
+#' @export
+
+bf_expr_template <- function(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,
+                             ...) {
+  # extracting estimate values
+  if ("r2" %in% names(estimate.df)) {
+    # for ANOVA designs
+    c(estimate, estimate.LB, estimate.UB) %<-%
+      c(estimate.df$r2[[1]], estimate.df$r2.conf.low[[1]], estimate.df$r2.conf.high[[1]])
+  } else {
+    # for non-ANOVA designs
+    c(estimate, estimate.LB, estimate.UB) %<-%
+      c(estimate.df$estimate[[1]], estimate.df$conf.low[[1]], estimate.df$conf.high[[1]])
+  }
+
+  # prepare the Bayes Factor message
+  bf01_expr <-
+    substitute(
+      atop(
+        displaystyle(top.text),
+        expr = paste(
+          "log"["e"],
+          "(BF"["01"],
+          ") = ",
+          bf,
+          ", ",
+          widehat(estimate.type)[centrality]^"posterior",
+          " = ",
+          estimate,
+          ", CI"[conf.level]^conf.method,
+          " [",
+          estimate.LB,
+          ", ",
+          estimate.UB,
+          "]",
+          ", ",
+          prior.type,
+          " = ",
+          bf.prior
+        )
+      ),
+      env = list(
+        top.text = top.text,
+        estimate.type = estimate.type,
+        centrality = centrality,
+        conf.level = paste0(conf.level * 100, "%"),
+        conf.method = toupper(conf.method),
+        bf = specify_decimal_p(x = -log(estimate.df$bf10[[1]]), k = k),
+        estimate = specify_decimal_p(x = estimate, k = k),
+        estimate.LB = specify_decimal_p(x = estimate.LB, k = k),
+        estimate.UB = specify_decimal_p(x = estimate.UB, k = k),
+        prior.type = prior.type,
+        bf.prior = specify_decimal_p(x = bf.prior, k = k)
+      )
+    )
+
+  # return the final expression
+  if (is.null(top.text)) bf01_expr$expr else bf01_expr
+}

R/bf_meta_random.R

@@ -1,8 +1,6 @@
 #' @title Bayes factor for random-effects meta-analysis
 #' @name bf_meta_random
 #'
-#' @importFrom metaBMA meta_random prior
-#'
 #' @param data A dataframe. It **must** contain columns named `estimate` (effect
 #'   sizes or outcomes)  and `std.error` (corresponding standard errors). These
 #'   two columns will be used for `y`  and `SE` arguments in
@@ -12,6 +10,8 @@
 #' @inheritParams metaBMA::meta_random
 #' @inheritDotParams metaBMA::meta_random -y -SE -ci
 #'
+#' @importFrom metaBMA meta_random prior
+#'
 #' @examples
 #'
 #' \donttest{
@@ -61,7 +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)),
                            k = 2L,
-                           conf.level = 0.95,
                            output = "dataframe",
                            top.text = NULL,
                            ...) {
@@ -72,7 +71,7 @@ bf_meta_random <- function(data,
   #----------------------- meta-analysis -------------------------------
 
   # extracting results from random-effects meta-analysis
-  mod <-
+  bf_object <-
     metaBMA::meta_random(
       y = data$estimate,
       SE = data$std.error,
@@ -82,57 +81,11 @@ bf_meta_random <- function(data,
       ...
     )
 
-  #----------------------- preparing top.text -------------------------------
-
-  # creating a dataframe with posterior estimates
-  df <-
-    as_tibble(mod$estimates, rownames = "term") %>%
-    dplyr::mutate(.data = ., bf10 = mod$BF["random_H1", "random_H0"])
-
-  # prepare the Bayes factor message
-  bf01_expr <-
-    substitute(
-      atop(displaystyle(top.text),
-        expr = paste(
-          "log"["e"],
-          "(BF"["01"],
-          ") = ",
-          bf,
-          ", ",
-          widehat(italic(delta))["mean"]^"posterior",
-          " = ",
-          estimate,
-          ", CI"[conf.level]^"HDI",
-          " [",
-          estimate.LB,
-          ", ",
-          estimate.UB,
-          "]",
-          ", ",
-          italic("r")["Cauchy"]^"JZS",
-          " = ",
-          bf.prior
-        )
-      ),
-      env = list(
-        top.text = top.text,
-        bf = specify_decimal_p(x = -log(df$bf10[[1]]), k = k),
-        conf.level = paste0(conf.level * 100, "%"),
-        estimate = specify_decimal_p(x = df$mean[[1]], k = k),
-        estimate.LB = specify_decimal_p(x = df$hpd95_lower[[1]], k = k),
-        estimate.UB = specify_decimal_p(x = df$hpd95_upper[[1]], k = k),
-        bf.prior = specify_decimal_p(x = mod$jzs$rscale_discrete[[1]], k = k)
-      )
-    )
-
-  # the final expression
-  if (is.null(top.text)) bf01_expr <- bf01_expr$expr
-
   # return the text results or the dataframe with results
   switch(
     EXPR = output,
-    "dataframe" = df,
-    bf01_expr
+    "dataframe" = bf_extractor(bf_object),
+    bf_expr(bf_object, k = k, top.text = top.text, ...)
   )
 }
 

R/bf_oneway_anova.R

@@ -55,10 +55,10 @@ bf_oneway_anova <- function(data,
                             x,
                             y,
                             subject.id = NULL,
+                            paired = FALSE,
                             bf.prior = 0.707,
                             top.text = NULL,
                             output = "dataframe",
-                            paired = FALSE,
                             k = 2L,
                             ...) {
   # make sure both quoted and unquoted arguments are allowed

R/bf_ttest.R

@@ -70,8 +70,8 @@ bf_ttest <- function(data,
                      x,
                      y = NULL,
                      subject.id = NULL,
-                     test.value = 0,
                      paired = FALSE,
+                     test.value = 0,
                      bf.prior = 0.707,
                      top.text = NULL,
                      output = "dataframe",

R/global_vars.R

@@ -10,7 +10,10 @@ utils::globalVariables(
     "estimate",
     "estimate.LB",
     "estimate.UB",
-    "term"
+    "term",
+    "conf.level",
+    "hpd95_lower",
+    "hpd95_upper"
   ),
   package = "tidyBF",
   add = FALSE