Merge 6d5a936 into 352e94c

IndrajeetPatil · Oct 25, 2020 · 7c99ca9 · 7c99ca9
2 parents 352e94c + 6d5a936
commit 7c99ca9
Show file tree

Hide file tree

Showing 25 changed files with 606 additions and 255 deletions.
diff --git a/API b/API
@@ -5,9 +5,10 @@
 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.value, bf.prior = 0.707, prior.type = quote(italic("r")["Cauchy"]^"JZS"), estimate.type = quote(delta), estimate, estimate.LB, estimate.UB, 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_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, 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, ...)
 meta_data_check(data)

diff --git a/DESCRIPTION b/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,

diff --git a/NAMESPACE b/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)

diff --git a/R/bf_contingency_tab.R b/R/bf_contingency_tab.R
@@ -24,7 +24,8 @@
 #'   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
@@ -106,22 +107,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 ----------------------------
@@ -175,35 +174,33 @@ bf_contingency_tab <- function(data,
     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
+    # 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.concentration[[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(

diff --git a/R/bf_expr_template.R b/R/bf_expr_template.R
@@ -0,0 +1,71 @@
+#' @title Expression template for Bayes Factor results
+#' @name bf_expr_template
+#'
+#' @param bf.value Numeric value corresponding to Bayes Factor.
+#' @param prior.type A character that specifies the prior type.
+#' @param estimate.type A character that specifies the relevant effect size.
+#' @param estimate,estimate.LB,estimate.UB Values of posterior estimates and
+#'   their credible intervals.
+#' @param ... Currently ignored.
+#' @inheritParams bf_expr
+#' @inheritParams bf_ttest
+#'
+#' @export
+
+bf_expr_template <- function(top.text,
+                             bf.value,
+                             bf.prior = 0.707,
+                             prior.type = quote(italic("r")["Cauchy"]^"JZS"),
+                             estimate.type = quote(delta),
+                             estimate,
+                             estimate.LB,
+                             estimate.UB,
+                             centrality = "median",
+                             conf.level = 0.95,
+                             conf.method = "HDI",
+                             k = 2L,
+                             ...) {
+  # prepare the Bayes Factor message
+  bf01_expr <-
+    substitute(
+      atop(
+        displaystyle(top.text),
+        expr = paste(
+          "log"["e"],
+          "(BF"["01"],
+          ") = ",
+          bf,
+          ", ",
+          widehat(italic(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 = bf.value, 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
+}
diff --git a/R/bf_meta_random.R b/R/bf_meta_random.R
@@ -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, ...)
   )
 }
 

diff --git a/R/global_vars.R b/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