text_performance is now checked and tested

easystats · Oct 26, 2020 · d01996b · d01996b
1 parent e841ed5
commit d01996b
Show file tree

Hide file tree

Showing 7 changed files with 171 additions and 43 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -237,6 +237,7 @@ export(report_table)
 export(report_text)
 export(text_concatenate)
 export(text_fullstop)
+export(text_lastchar)
 export(text_paste)
 export(text_remove)
 export(text_wrap)

diff --git a/R/format_text.R b/R/format_text.R
@@ -9,6 +9,7 @@
 #' @inheritParams data_rename
 #' @param sep Separator.
 #' @param last Last separator.
+#' @param n The number of characters to find.
 #' @param ... Other arguments to be passed to or from other functions.
 #'
 #' @return A character string.
@@ -19,6 +20,9 @@
 #' # Add full stop if missing
 #' text_fullstop(c("something", "something else."))
 #'
+#' # Find last characters
+#' text_lastchar(c("ABC", "DEF"), n=2)
+#'
 #' # Smart concatenation
 #' text_concatenate(c("First", "Second", "Last"))
 #'
@@ -40,12 +44,14 @@ format_text <- function(text, sep = ", ", last = " and ", width = NULL, ...) {
 #' @rdname format_text
 #' @export
 text_fullstop <- function(text) {
-  text[!.text_lastchar(text) %in% c(".", ":", ",", ";", "!", "?")] <- paste0(text[.text_lastchar(text) != "."], ".")
+  text[!text_lastchar(text) %in% c(".", ":", ",", ";", "!", "?")] <- paste0(text[text_lastchar(text) != "."], ".")
   text
 }
 
-#' @keywords internal
-.text_lastchar <- function(text, n = 1) {
+
+#' @rdname format_text
+#' @export
+text_lastchar <- function(text, n = 1) {
   sapply(text, function(xx) {
     substr(xx, (nchar(xx) - n + 1), nchar(xx))
   })

diff --git a/R/report_parameters.R b/R/report_parameters.R
@@ -40,6 +40,12 @@
 #'   model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
 #'   report_parameters(model)
 #' }
+#'
+#' # Bayesian models
+#' if(require("rstanarm")){
+#'   model <- stan_glm(Sepal.Length ~ Species, data = iris, refresh=0, iter=600)
+#'   report_parameters(model)
+#' }
 #' @export
 report_parameters <- function(x, table = NULL, ...) {
   UseMethod("report_parameters")

diff --git a/R/report_performance.R b/R/report_performance.R
@@ -80,8 +80,8 @@ print.report_performance <- function(x, ...) {
   text <- ""
   text_full <- ""
 
-  # R2 linear models ----
-  if ("R2" %in% names(performance) && info$is_linear) {
+  # R2
+  if ("R2" %in% names(performance)) {
     r2 <- attributes(performance)$r2
 
     text <- paste0(
@@ -90,34 +90,38 @@ print.report_performance <- function(x, ...) {
       " (R2 = ",
       insight::format_value(performance$R2)
     )
-    text_full <- tryCatch(
-      {
-        paste0(
-          "The model explains a ",
-          effectsize::interpret_p(r2$p),
-          " and ",
-          effectsize::interpret_r2(performance$R2, ...),
-          " proportion of variance (R2 = ",
-          insight::format_value(performance$R2),
-          ", F(",
-          insight::format_value(r2$df, protect_integers = TRUE),
-          ", ",
-          insight::format_value(r2$df_residual, protect_integers = TRUE),
-          ") = ",
-          insight::format_value(r2$`F`),
-          ", ",
-          insight::format_p(r2$p)
-        )
-      },
-      error = function(e) {
-        NULL
-      }
-    )
 
-    if (is.null(text_full)) {
+    # Frequentist
+    if(all(c("p", "df", "df_residual") %in% names(r2))){
+      text_full <- paste0(
+            "The model explains a ",
+            effectsize::interpret_p(r2$p),
+            " and ",
+            effectsize::interpret_r2(performance$R2, ...),
+            " proportion of variance (R2 = ",
+            insight::format_value(performance$R2),
+            ", F(",
+            insight::format_value(r2$df, protect_integers = TRUE),
+            ", ",
+            insight::format_value(r2$df_residual, protect_integers = TRUE),
+            ") = ",
+            insight::format_value(r2$`F`),
+            ", ",
+            insight::format_p(r2$p)
+          )
+    } else{
       text_full <- text
     }
 
+    if ("CI" %in% names(r2)) {
+      text_full <- paste0(text_full,
+                          ", ",
+                          insight::format_ci(r2$CI$R2_Bayes$CI_low,
+                                             r2$CI$R2_Bayes$CI_high,
+                                             r2$CI$R2_Bayes$CI / 100))
+    }
+
+
     if ("R2_adjusted" %in% names(performance)) {
       text <- paste0(
         text, ", adj. R2 = ",
@@ -130,15 +134,17 @@ print.report_performance <- function(x, ...) {
         ")"
       )
     } else {
-      text_full <- paste0(text_full, ")")
+      if(text_lastchar(text_full) != ")") text_full <- paste0(text_full, ")")
+      if(text_lastchar(text) != ")") text <- paste0(text, ")")
     }
   }
 
+
   # Tjur's R2
   if ("R2_Tjur" %in% names(performance)) {
     text <- text_full <- paste0(
       "The model's explanatory power is ",
-      effectsize::interpret_r2(performance$R2_Tjur, rules = "cohen1988"),
+      effectsize::interpret_r2(performance$R2_Tjur, ...),
       " (Tjur's R2 = ",
       insight::format_value(performance$R2_Tjur),
       ")"
@@ -149,7 +155,7 @@ print.report_performance <- function(x, ...) {
   if ("R2_Nagelkerke" %in% names(performance)) {
     text <- text_full <- paste0(
       "The model's explanatory power is ",
-      effectsize::interpret_r2(performance$R2_Nagelkerke, rules = "cohen1988"),
+      effectsize::interpret_r2(performance$R2_Nagelkerke, ...),
       " (Nagelkerke's R2 = ",
       insight::format_value(performance$R2_Nagelkerke),
       ")"
@@ -160,7 +166,7 @@ print.report_performance <- function(x, ...) {
   if ("R2_CoxSnell" %in% names(performance)) {
     text <- text_full <- paste0(
       "The model's explanatory power is ",
-      effectsize::interpret_r2(performance$R2_CoxSnell, rules = "cohen1988"),
+      effectsize::interpret_r2(performance$R2_CoxSnell, ...),
       " (R2_CoxSnell's R2 = ",
       insight::format_value(performance$R2_CoxSnell),
       ")"
@@ -171,7 +177,7 @@ print.report_performance <- function(x, ...) {
   if ("R2_McFadden" %in% names(performance)) {
     text <- text_full <- paste0(
       "The model's explanatory power is ",
-      effectsize::interpret_r2(performance$R2_McFadden, rules = "cohen1988"),
+      effectsize::interpret_r2(performance$R2_McFadden, ...),
       " (McFadden's R2 = ",
       insight::format_value(performance$R2_McFadden),
       ")"
@@ -180,9 +186,9 @@ print.report_performance <- function(x, ...) {
 
   # R2 Conditional
   if ("R2_conditional" %in% names(performance) && !is.na(performance$R2_conditional)) {
-    text <- paste0(
+    text <- text_full <- paste0(
       "The model's total explanatory power is ",
-      effectsize::interpret_r2(performance$R2_conditional, rules = "cohen1988"),
+      effectsize::interpret_r2(performance$R2_conditional, ...),
       " (conditional R2 = ",
       insight::format_value(performance$R2_conditional),
       ")"
@@ -192,19 +198,31 @@ print.report_performance <- function(x, ...) {
   # R2 marginal
   if ("R2_marginal" %in% names(performance)) {
     if (text == "") {
-      text <- "The model's explanatory power"
+      text <- text_full <- "The model's explanatory power"
       of <- ""
     } else {
       text <- paste0(text, " and the part")
+      text_full <- paste0(text_full, " and the part")
       of <- "of "
     }
-    text <- text_full <- paste0(
-      text,
-      " related to the",
-      " fixed effects alone (marginal R2) is ",
+    text_r2marginal <- paste0(
+      " related to the fixed effects alone (marginal R2) is ",
       of,
-      insight::format_value(performance$R2_marginal)
-    )
+      insight::format_value(performance$R2_marginal))
+    text <- paste0(text, text_r2marginal)
+
+    if(!is.null(attributes(performance)$r2_bayes$CI$R2_Bayes_marginal)){
+      r2 <- attributes(performance)$r2_bayes$CI$R2_Bayes_marginal
+      text_full <- paste0(text_full,
+                          text_r2marginal,
+                          " (",
+                          insight::format_ci(r2$CI_low,
+                                             r2$CI_high,
+                                             r2$CI / 100),
+                          ")")
+    } else{
+      text_full <- paste0(text_full, text_r2marginal)
+    }
   }
 
   list(text_full=text_full, text=text)

diff --git a/man/format_text.Rd b/man/format_text.Rd
diff --git a/man/report_parameters.Rd b/man/report_parameters.Rd
diff --git a/tests/testthat/test-report_performance.R b/tests/testthat/test-report_performance.R
@@ -0,0 +1,83 @@
+if (require("testthat") && require("report")) {
+  testthat::test_that("report_performance", {
+    set.seed(123)
+
+    # Linear
+    x <- lm(Sepal.Length ~ Petal.Length * Species, data = iris)
+    testthat::expect_equal(
+      as.character(report_performance(x)),
+      "The model explains a significant and substantial proportion of variance (R2 = 0.84, F(5, 144) = 151.71, p < .001, adj. R2 = 0.83)"
+    )
+    testthat::expect_equal(
+      as.character(summary(report_performance(x))),
+      "The model's explanatory power is substantial (R2 = 0.84, adj. R2 = 0.83)"
+    )
+
+    # GLM
+    x <- glm(vs ~ disp, data = mtcars, family = "binomial")
+    testthat::expect_equal(
+      as.character(report_performance(x)),
+      "The model's explanatory power is substantial (Tjur's R2 = 0.53)"
+    )
+    testthat::expect_equal(
+      as.character(summary(report_performance(x))),
+      "The model's explanatory power is substantial (Tjur's R2 = 0.53)"
+    )
+
+    # Mixed models
+    if (require("lme4")){
+      x <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
+      testthat::expect_equal(
+        as.character(report_performance(x)),
+        "The model's total explanatory power is substantial (conditional R2 = 0.97) and the part related to the fixed effects alone (marginal R2) is of 0.66"
+      )
+      testthat::expect_equal(
+        as.character(summary(report_performance(x))),
+        "The model's total explanatory power is substantial (conditional R2 = 0.97) and the part related to the fixed effects alone (marginal R2) is of 0.66"
+      )
+
+      x <- lme4::glmer(vs ~ mpg + (1|cyl), data=mtcars, family="binomial")
+      testthat::expect_equal(
+        as.character(report_performance(x)),
+        "The model's total explanatory power is substantial (conditional R2 = 0.59) and the part related to the fixed effects alone (marginal R2) is of 0.13"
+      )
+      testthat::expect_equal(
+        as.character(summary(report_performance(x))),
+        "The model's total explanatory power is substantial (conditional R2 = 0.59) and the part related to the fixed effects alone (marginal R2) is of 0.13"
+      )
+    }
+
+    # Bayesian
+    if (require("rstanarm")){
+      x <- stan_glm(Sepal.Length ~ Species, data = iris, refresh=0, iter=600, seed=333)
+      testthat::expect_equal(
+        as.character(report_performance(x)),
+        "The model's explanatory power is substantial (R2 = 0.62, 89% CI [0.55, 0.68], adj. R2 = 0.60)"
+      )
+      testthat::expect_equal(
+        as.character(summary(report_performance(x))),
+        "The model's explanatory power is substantial (R2 = 0.62, adj. R2 = 0.60)"
+      )
+
+      x <- stan_glm(vs ~ disp, data = mtcars, family = "binomial", refresh=0, iter=800, seed=333)
+      testthat::expect_equal(
+        as.character(report_performance(x)),
+        "The model's explanatory power is substantial (R2 = 0.54, 89% CI [0.34, 0.75])"
+      )
+      testthat::expect_equal(
+        as.character(summary(report_performance(x))),
+        "The model's explanatory power is substantial (R2 = 0.54)"
+      )
+
+      x <- stan_lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris, refresh=0, iter=600, seed=333)
+      testthat::expect_equal(
+        as.character(report_performance(x)),
+        "The model's explanatory power is substantial (R2 = 0.83, 89% CI [0.80, 0.86], adj. R2 = 0.83) and the part related to the fixed effects alone (marginal R2) is of 0.95 (89% CI [0.94, 0.97])"
+      )
+      testthat::expect_equal(
+        as.character(summary(report_performance(x))),
+        "The model's explanatory power is substantial (R2 = 0.83, adj. R2 = 0.83) and the part related to the fixed effects alone (marginal R2) is of 0.95"
+      )
+    }
+  })
+}