Merge eef61d3 into e9f8f94

easystats · Feb 28, 2023 · d23ef23 · d23ef23
2 parents e9f8f94 + eef61d3
commit d23ef23
Show file tree

Hide file tree

Showing 63 changed files with 723 additions and 463 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -63,15 +63,20 @@ Depends:
     R (>= 3.6),
     stats
 Imports:
-    bayestestR (>= 0.13.0),
-    correlation (>= 0.8.3),
+    bayestestR (>= 0.13.0.6),
+    correlation (>= 0.8.3.1),
     datawizard (>= 0.6.4),
-    effectsize (>= 0.8.2),
+    effectsize (>= 0.8.3),
     ggplot2 (>= 3.4.0),
-    insight (>= 0.18.8),
+    insight (>= 0.19.0),
     modelbased (>= 0.8.5),
     parameters (>= 0.20.0),
     performance (>= 0.10.1)
+Remotes:
+    easystats/insight,
+    easystats/parameters,
+    easystats/correlation,
+    easystats/bayestestR
 Suggests:
     brms,
     curl,

diff --git a/R/coord_radar.R b/R/coord_radar.R
@@ -5,20 +5,18 @@
 #' @inheritParams ggplot2::coord_polar
 #' @param ... Other arguments to be passed to `ggproto`.
 #'
-#' @examples
+#' @examplesIf require("datawizard") && require("ggplot2")
 #' # Create a radar/spider chart with ggplot:
-#' if (require("datawizard") && require("ggplot2")) {
-#'   data(iris)
-#'   data <- aggregate(iris[-5], list(Species = iris$Species), mean)
-#'   data <- data_to_long(
-#'     data,
-#'     c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
-#'   )
+#' data(iris)
+#' data <- aggregate(iris[-5], list(Species = iris$Species), mean)
+#' data <- data_to_long(
+#'   data,
+#'   c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+#' )
 #'
-#'   ggplot(data, aes(x = name, y = value, color = Species, group = Species)) +
-#'     geom_polygon(fill = NA, linewidth = 2) +
-#'     coord_radar(start = -pi / 4)
-#' }
+#' ggplot(data, aes(x = name, y = value, color = Species, group = Species)) +
+#'   geom_polygon(fill = NA, linewidth = 2) +
+#'   coord_radar(start = -pi / 4)
 #' @export
 coord_radar <- function(theta = "x", start = 0, direction = 1, ...) {
   theta <- match.arg(theta, c("x", "y"))

diff --git a/R/data_plot.R b/R/data_plot.R
@@ -55,13 +55,13 @@
 #' library(bayestestR)
 #' library(rstanarm)
 #'
-#' model <<- stan_glm(
+#' model <<- suppressWarnings(stan_glm(
 #'   Sepal.Length ~ Petal.Width * Species,
 #'   data = iris,
 #'   chains = 2, iter = 200, refresh = 0
-#' )
+#' ))
 #'
-#' x <- rope(model)
+#' x <- rope(model, verbose = FALSE)
 #' plot(x)
 #'
 #' x <- hdi(model)
@@ -71,17 +71,17 @@
 #' x <- p_direction(data)
 #' plot(x)
 #'
-#' x <- p_direction(model)
+#' x <- p_direction(model, verbose = FALSE)
 #' plot(x)
 #'
-#' model <<- stan_glm(
+#' model <<- suppressWarnings(stan_glm(
 #'   mpg ~ wt + gear + cyl + disp,
 #'   chains = 2,
 #'   iter = 200,
 #'   refresh = 0,
 #'   data = mtcars
-#' )
-#' x <- equivalence_test(model)
+#' ))
+#' x <- equivalence_test(model, verbose = FALSE)
 #' plot(x)
 #' @export
 data_plot <- function(x, data = NULL, ...) {
@@ -104,11 +104,11 @@ data_plot <- function(x, data = NULL, ...) {
 #' library(see)
 #' library(ggplot2)
 #'
-#' model <- stan_glm(
+#' model <- suppressWarnings(stan_glm(
 #'   Sepal.Length ~ Petal.Width + Species + Sepal.Width,
 #'   data = iris,
 #'   chains = 2, iter = 200
-#' )
+#' ))
 #'
 #' result <- hdi(model, ci = c(0.5, 0.75, 0.9, 0.95))
 #' data <- data_plot(result, data = model)

diff --git a/R/geom_from_list.R b/R/geom_from_list.R
@@ -111,25 +111,6 @@
 #'   geom_from_list(list(aes = list(x = "Sepal.Length"), geom = "ggside::geom_xsidedensity")) +
 #'   geom_from_list(list(geom = "ggside::scale_xsidey_continuous", breaks = NULL))
 #'
-#' # Example 6 (ggraph) --------------------------
-#'
-#' @examplesIf require("tidygraph") && require("ggraph")
-#' library(tidygraph)
-#' library(ggraph)
-#'
-#' # Prepare graph
-#' nodes <- data.frame(name = c("Death", "Famine", "War", "Conquest"))
-#' edges <- data.frame(
-#'   from = c(1, 1, 1, 2, 3, 3, 4, 4, 4),
-#'   to = c(2, 3, 4, 1, 1, 2, 1, 2, 3)
-#' )
-#' data <- tidygraph::tbl_graph(nodes = nodes, edges = edges)
-#'
-#' ggraph(data, layout = "kk") +
-#'   geom_from_list(list(geom = "ggraph::geom_edge_arc")) +
-#'   geom_from_list(list(geom = "ggraph::geom_node_point", size = 10)) +
-#'   geom_from_list(list(geom = "ggraph::geom_node_label", aes = list(label = "name")))
-#'
 #' @export
 geom_from_list <- function(x, ...) {
   # Additional parameters ------------------------------------------------------
@@ -165,28 +146,25 @@ geom_from_list <- function(x, ...) {
     return(do.call(ggplot2::facet_grid, args))
   }
   if (x$geom == "smooth") {
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes)
+    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
     if (!"method" %in% names(args)) args$method <- "loess"
     if (!"formula" %in% names(args)) args$formula <- "y ~ x"
     return(do.call(ggplot2::geom_smooth, args))
   }
-  if (startsWith(x$geom, "scale_")) {
-    return(do.call(x$geom, args))
-  }
-  if (startsWith(x$geom, "theme")) {
-    return(do.call(x$geom, args))
-  }
-  if (startsWith(x$geom, "see_")) {
+
+  if (startsWith(x$geom, "scale_") || startsWith(x$geom, "theme") || startsWith(x$geom, "see_")) {
     return(do.call(x$geom, args))
   }
+
   if (startsWith(x$geom, "ggside::")) {
     insight::check_if_installed("ggside")
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes)
+    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
     return(do.call(eval(parse(text = x$geom)), args))
   }
+
   if (startsWith(x$geom, "ggraph::")) {
     insight::check_if_installed("ggraph")
-    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes_string, x$aes)
+    if (!is.null(x$aes)) args$mapping <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
     return(do.call(eval(parse(text = x$geom)), args))
   }
 
@@ -214,11 +192,11 @@ geom_from_list <- function(x, ...) {
   } else if (x$geom == "density_2d_polygon") {
     stat <- ggplot2::StatDensity2d
     x$geom <- "polygon"
-    if (!"fill" %in% names(x$aes)) x$aes$fill <- "..level.."
+    if (!"fill" %in% names(x$aes)) x$aes$fill <- quote(after_stat(level))
   } else if (x$geom == "density_2d_raster") {
     stat <- ggplot2::StatDensity2d
     x$geom <- "raster"
-    if (!"fill" %in% names(x$aes)) x$aes$fill <- "..density.."
+    if (!"fill" %in% names(x$aes)) x$aes$fill <- quote(after_stat(density))
   }
 
   # Position
@@ -234,7 +212,7 @@ geom_from_list <- function(x, ...) {
 
   # Aesthetics
   if ("aes" %in% names(x)) {
-    aes_list <- do.call(ggplot2::aes_string, x$aes)
+    aes_list <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
   } else {
     aes_list <- NULL
   }

diff --git a/R/plot.check_distribution.R b/R/plot.check_distribution.R
@@ -24,7 +24,8 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
   dat <- data.frame(
     x = factor(c(x$Distribution, x$Distribution), levels = rev(sort(unique(x$Distribution)))),
     y = c(x$p_Response, x$p_Residuals),
-    group = factor(c(rep("Response", length(x$p_Response)), rep("Residuals", length(x$p_Residuals))),
+    group = factor(
+      c(rep("Response", length(x$p_Response)), rep("Residuals", length(x$p_Residuals))),
       levels = c("Response", "Residuals")
     ),
     stringsAsFactors = FALSE
@@ -39,16 +40,25 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
   # default legend-position
   lp <- ifelse(isTRUE(panel), "right", "bottom")
 
-  p1 <- ggplot(dat, aes(
-    y = .data$x,
-    x = .data$y,
-    colour = .data$group
-  )) +
-    geom_linerange(aes(xmin = 0, xmax = .data$y),
+  p1 <- ggplot(
+    dat,
+    aes(
+      y = .data$x,
+      x = .data$y,
+      colour = .data$group
+    )
+  ) +
+    geom_linerange(
+      aes(xmin = 0, xmax = .data$y),
       position = position_dodge(0.4),
-      linewidth = 0.8
+      linewidth = 0.8,
+      na.rm = TRUE
+    ) +
+    geom_point(
+      size = size_point,
+      position = position_dodge(0.4),
+      na.rm = TRUE
     ) +
-    geom_point(size = size_point, position = position_dodge(0.4)) +
     labs(
       y = NULL,
       x = NULL,
@@ -91,7 +101,8 @@ plot.see_check_distribution <- function(x, size_point = 2, panel = TRUE, ...) {
   p3 <- ggplot(dat2, aes(x = .data$x)) +
     geom_histogram(
       fill = "#f44336", colour = bar_color,
-      binwidth = sqrt(length(vars(.data$x)))
+      binwidth = sqrt(length(vars(.data$x))),
+      na.rm = TRUE
     ) +
     labs(x = NULL, y = NULL, title = "Distribution of Response") +
     theme_lucid()
@@ -130,10 +141,29 @@ plot.see_check_distribution_numeric <- function(x,
   lp <- ifelse(isTRUE(panel), "right", "bottom")
 
   p1 <- ggplot(dat, aes(y = .data$x, x = .data$y)) +
-    geom_linerange(aes(xmin = 0, xmax = .data$y), position = position_dodge(0.4), linewidth = 0.8) +
-    geom_point(size = size_point, position = position_dodge(0.4)) +
-    labs(y = NULL, x = NULL, fill = NULL, colour = NULL, title = "Predicted Distribution of Vector") +
-    scale_x_continuous(labels = .percents, expand = c(0, 0), limits = c(0, max_y)) +
+    geom_linerange(
+      aes(xmin = 0, xmax = .data$y),
+      position = position_dodge(0.4),
+      linewidth = 0.8,
+      na.rm = TRUE
+    ) +
+    geom_point(
+      size = size_point,
+      position = position_dodge(0.4),
+      na.rm = TRUE
+    ) +
+    labs(
+      y = NULL,
+      x = NULL,
+      fill = NULL,
+      colour = NULL,
+      title = "Predicted Distribution of Vector"
+    ) +
+    scale_x_continuous(
+      labels = .percents,
+      expand = c(0, 0),
+      limits = c(0, max_y)
+    ) +
     theme_lucid(legend.position = lp)
 
   dat1 <- as.data.frame(stats::density(vec))
@@ -147,14 +177,15 @@ plot.see_check_distribution_numeric <- function(x,
   p3 <- ggplot(dat2, aes(x = .data$x)) +
     geom_histogram(
       colour = theme_lucid()$panel.background$fill,
-      binwidth = sqrt(length(vars(.data$x)))
+      binwidth = sqrt(length(vars(.data$x))),
+      na.rm = TRUE
     ) +
     labs(x = NULL, y = NULL, title = "Distribution of Vector") +
     theme_lucid()
 
   if (panel) {
     insight::check_if_installed("patchwork")
-    return(p1 / (p2 | p3) + patchwork::plot_layout(nrow = 2))
+    return(p1 / (p2 | p3) + patchwork::plot_layout(nrow = 2L))
   } else {
     return(list(p1, p2, p3))
   }

diff --git a/R/plot.check_homogeneity.R b/R/plot.check_homogeneity.R
@@ -60,15 +60,21 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) {
         ggrepel::geom_label_repel(
           aes(label = .data$group),
           y = 0, fill = "white",
-          data = data.frame(group = unique(dat$group)),
+          data = data.frame(
+            group = unique(dat$group),
+            stringsAsFactors = FALSE
+          ),
           direction = "y",
           segment.colour = NA
         )
       } else {
         geom_label(
           aes(label = .data$group),
           y = 0, fill = "white",
-          data = data.frame(group = unique(dat$group))
+          data = data.frame(
+            group = unique(dat$group),
+            stringsAsFactors = FALSE
+          )
         )
       }
   } else {
@@ -84,15 +90,21 @@ plot.see_check_homogeneity <- function(x, data = NULL, ...) {
         ggrepel::geom_label_repel(
           aes(label = .data$x),
           y = 0, fill = "white",
-          data = data.frame(x = unique(dat$x)),
+          data = data.frame(
+            x = unique(dat$x),
+            stringsAsFactors = FALSE
+          ),
           direction = "y",
           segment.colour = NA
         )
       } else {
         geom_label(
           aes(label = .data$x),
           y = 0, fill = "white",
-          data = data.frame(x = unique(dat$x))
+          data = data.frame(
+            x = unique(dat$x),
+            stringsAsFactors = FALSE
+          )
         )
       }
   }