lintrs, news, desc

easystats · Dec 1, 2023 · f444f76 · f444f76
1 parent 00ba19f
commit f444f76
Show file tree

Hide file tree

Showing 6 changed files with 85 additions and 56 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.1
+Version: 0.8.1.1
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# see 0.8.2
+
+## Minor Changes
+
+* `plot.n_factors()` now shows a dashed line over the bars, indicating the
+  cumulate explained variance by the number of factors.
+
 # see 0.8.1
 
 ## Major Changes

diff --git a/R/geom_binomdensity.R b/R/geom_binomdensity.R
@@ -62,7 +62,7 @@ geom_binomdensity <- function(data,
 
   # Other parameters
   data$.side <- ifelse(data[[y]] == y_levels[1], "top", "bottom")
-  data$.justification <- as.numeric(!(data[[y]] == y_levels[1]))
+  data$.justification <- as.numeric(data[[y]] != y_levels[1])
   data$.scale <- .geom_binomdensity_scale(data, x, y, scale)
 
   # ggdist geom

diff --git a/R/geom_from_list.R b/R/geom_from_list.R
@@ -114,58 +114,68 @@
 #' @export
 geom_from_list <- function(x, ...) {
   # Additional parameters ------------------------------------------------------
-  args <- x[!names(x) %in% c("geom", "aes", "data", "width", "height", "position", "show.legend")]
+  arguments <- x[!names(x) %in% c("geom", "aes", "data", "width", "height", "position", "show.legend")]
 
   if (is.null(x$geom)) {
     return(NULL)
   }
 
   if (inherits(x$geom, "function")) {
-    return(do.call(x$geom, args))
+    return(do.call(x$geom, args = arguments))
   }
 
   if (x$geom %in% c("density_2d", "density_2d_filled", "density_2d_polygon")) {
-    if (!"contour" %in% names(args)) args$contour <- TRUE
-    if (!"contour_var" %in% names(args)) args$contour_var <- "density"
+    if (!"contour" %in% names(arguments)) arguments$contour <- TRUE
+    if (!"contour_var" %in% names(arguments)) arguments$contour_var <- "density"
   }
 
   # If they are not geoms, return immediately
   if (x$geom == "labs") {
-    return(do.call(ggplot2::labs, args))
+    return(do.call(ggplot2::labs, args = arguments))
   }
   if (x$geom == "guides") {
-    return(do.call(ggplot2::guides, args))
+    return(do.call(ggplot2::guides, args = arguments))
   }
   if (x$geom == "coord_flip") {
-    return(do.call(ggplot2::coord_flip, args))
+    return(do.call(ggplot2::coord_flip, args = arguments))
   }
   if (x$geom == "facet_wrap") {
-    return(do.call(ggplot2::facet_wrap, args))
+    return(do.call(ggplot2::facet_wrap, args = arguments))
   }
   if (x$geom == "facet_grid") {
-    return(do.call(ggplot2::facet_grid, args))
+    return(do.call(ggplot2::facet_grid, args = arguments))
   }
   if (x$geom == "smooth") {
-    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 (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    if (!"method" %in% names(arguments)) {
+      arguments$method <- "loess"
+    }
+    if (!"formula" %in% names(arguments)) {
+      arguments$formula <- "y ~ x"
+    }
+    return(do.call(ggplot2::geom_smooth, args = arguments))
   }
 
   if (startsWith(x$geom, "scale_") || startsWith(x$geom, "theme") || startsWith(x$geom, "see_")) {
-    return(do.call(x$geom, args))
+    return(do.call(x$geom, args = arguments))
   }
 
   if (startsWith(x$geom, "ggside::")) {
     insight::check_if_installed("ggside")
-    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 (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    return(do.call(eval(parse(text = x$geom)), args = arguments))
   }
 
   if (startsWith(x$geom, "ggraph::")) {
     insight::check_if_installed("ggraph")
-    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 (!is.null(x$aes)) {
+      arguments$mapping <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
+    }
+    return(do.call(eval(parse(text = x$geom)), args = arguments))
   }
 
   # Default parameters
@@ -212,7 +222,7 @@ geom_from_list <- function(x, ...) {
 
   # Aesthetics
   if ("aes" %in% names(x)) {
-    aes_list <- do.call(ggplot2::aes, lapply(x$aes, .str_to_sym))
+    aes_list <- do.call(ggplot2::aes, args = lapply(x$aes, .str_to_sym))
   } else {
     aes_list <- NULL
   }
@@ -231,7 +241,7 @@ geom_from_list <- function(x, ...) {
     geom = x$geom,
     mapping = aes_list,
     data = x$data,
-    params = args,
+    params = arguments,
     show.legend = show.legend,
     ...
   )

diff --git a/R/plot.n_factors.R b/R/plot.n_factors.R
@@ -3,43 +3,47 @@ data_plot.n_factors <- function(x, data = NULL, type = "bar", ...) {
   s1 <- summary(x)
 
   if ("n_Factors" %in% names(x)) {
-    var <- "n_Factors"
+    variable <- "n_Factors"
     lab <- "factors"
   } else {
-    var <- "n_Clusters"
+    variable <- "n_Clusters"
     lab <- "clusters"
   }
 
-  s2 <- data.frame(n_Methods = rep(0, max(x[[var]])))
+  s2 <- data.frame(n_Methods = rep(0, max(x[[variable]])))
 
   if (type == "line") {
-    s1[[var]] <- as.factor(s1[[var]])
-    s2[[var]] <- factor(1:max(x[[var]]))
+    s1[[variable]] <- as.factor(s1[[variable]])
+    s2[[variable]] <- factor(1:max(x[[variable]]))
   } else {
-    s2[[var]] <- 1:max(x[[var]])
+    s2[[variable]] <- 1:max(x[[variable]])
   }
 
-  if("Variance_Cumulative" %in% names(s1)){
+  if ("Variance_Cumulative" %in% names(s1)) {
     s2$Variance_Cumulative <- NA
   }
 
-  dataplot <- rbind(s1, s2[!s2[[var]] %in% s1[[var]], ])
+  dataplot <- rbind(s1, s2[!s2[[variable]] %in% s1[[variable]], ])
 
   # Add Variance explained
-  if("Variance_Explained" %in% names(attributes(x))){
+  if ("Variance_Explained" %in% names(attributes(x))) {
     dataplot$Variance_Cumulative <- NULL  # Remove column and re add
-    dataplot <- merge(dataplot, attributes(x)$Variance_Explained[, c("n_Factors", "Variance_Cumulative")], by = "n_Factors")
+    dataplot <- merge(
+      dataplot,
+      attributes(x)$Variance_Explained[, c("n_Factors", "Variance_Cumulative")],
+      by = "n_Factors"
+    )
   }
 
   if (type == "line") {
-    dataplot$x <- factor(dataplot[[var]], levels = rev(sort(levels(dataplot[[var]]))))
+    dataplot$x <- factor(dataplot[[variable]], levels = rev(sort(levels(dataplot[[variable]]))))
     dataplot$group <- "0"
     dataplot$group[which.max(dataplot$n_Methods)] <- "1"
   } else if (type == "area") {
-    dataplot$x <- dataplot[[var]]
+    dataplot$x <- dataplot[[variable]]
   } else {
-    dataplot <- dataplot[order(dataplot[[var]]), ]
-    dataplot$x <- dataplot[[var]]
+    dataplot <- dataplot[order(dataplot[[variable]]), ]
+    dataplot$x <- dataplot[[variable]]
     dataplot$fill <- "Not-optimal"
     dataplot$fill[which.max(dataplot$n_Methods)] <- "Optimal"
   }
@@ -54,23 +58,24 @@ data_plot.n_factors <- function(x, data = NULL, type = "bar", ...) {
   # Inverse xlab and ylab for line plot
   if (type == "line") {
     attr(dataplot, "info") <- list(
-      "ylab" = paste("Number of", lab),
-      "xlab" = axis_lab
+      ylab = paste("Number of", lab),
+      xlab = axis_lab
     )
   } else {
     attr(dataplot, "info") <- list(
-      "xlab" = paste("Number of", lab),
-      "ylab" = axis_lab
+      xlab = paste("Number of", lab),
+      ylab = axis_lab
     )
   }
   # Title
 
   attr(dataplot, "info")$title <-  paste("How many", lab, "to retain")
   attr(dataplot, "info")$subtitle <- paste0("Number of ", lab, " considered optimal by various algorithm")
-  if("Variance_Cumulative" %in% names(dataplot) && type != "line"){
+  if ("Variance_Cumulative" %in% names(dataplot) && type != "line") {
     attr(dataplot, "info")$subtitle <- paste0(
       attr(dataplot, "info")$subtitle,
-      ". The dashed line represent the cumulative percentage of variance explained")
+      ". The dashed line represent the cumulative percentage of variance explained"
+    )
   }
 
   class(dataplot) <- unique(c("data_plot", "see_n_factors", class(dataplot)))
@@ -124,8 +129,8 @@ plot.see_n_factors <- function(x,
 
   if (missing(size)) {
     size <- switch(type,
-      "bar" = 0.7,
-      "line" = 1,
+      bar = 0.7,
+      line = 1,
       1
     )
   }
@@ -168,11 +173,18 @@ plot.see_n_factors <- function(x,
   }
 
   # Add variance explained
-  if("Variance_Cumulative" %in% names(x)) {
+  if ("Variance_Cumulative" %in% names(x)) {
     x$Varex_scaled <- x$Variance_Cumulative * max(x$y)
     p <- p +
-      geom_line(data=x, aes(x = .data$x, y = .data$Varex_scaled, group=1), linetype="dashed") +
-      scale_y_continuous(labels = .percents, sec.axis = sec_axis(~ . / max(x$y), name = "% of variance explained", labels = .percents))
+      geom_line(
+        data = x,
+        aes(x = .data$x, y = .data$Varex_scaled, group = 1),
+        linetype = "dashed"
+      ) +
+      scale_y_continuous(
+        labels = .percents,
+        sec.axis = sec_axis(~ . / max(x$y), name = "% of variance explained", labels = .percents)
+      )
   } else {
     p <- p + scale_y_continuous(labels = .percents)
   }

diff --git a/R/plot.parameters_brms_meta.R b/R/plot.parameters_brms_meta.R
@@ -59,11 +59,11 @@ data_plot.parameters_brms_meta <- function(x, data = NULL, normalize_height = TR
 
   attr(dataplot, "summary") <- summary
   attr(dataplot, "info") <- list(
-    "xlab" = "Standardized Mean Difference",
-    "ylab" = NULL,
-    "legend_fill" = NULL,
-    "legend_color" = NULL,
-    "title" = "Bayesian Meta-Analysis"
+    xlab = "Standardized Mean Difference",
+    ylab = NULL,
+    legend_fill = NULL,
+    legend_color = NULL,
+    title = "Bayesian Meta-Analysis"
   )
 
   class(dataplot) <- unique(c("data_plot", "see_parameters_brms_meta", class(dataplot)))
@@ -212,12 +212,12 @@ plot.see_parameters_brms_meta <- function(x,
     theme_lucid() +
     ggplot2::scale_y_discrete() +
     ggplot2::scale_fill_manual(values = c(
-      "Study" = unname(metro_colors("light blue")),
-      "Overall" = unname(metro_colors("amber"))
+      Study = unname(metro_colors("light blue")),
+      Overall = unname(metro_colors("amber"))
     )) +
     ggplot2::scale_colour_manual(values = c(
-      "Study" = unname(metro_colors("light blue")),
-      "Overall" = unname(metro_colors("amber"))
+      Study = unname(metro_colors("light blue")),
+      Overall = unname(metro_colors("amber"))
     )) +
     ggplot2::guides(fill = "none", colour = "none") +
     add_plot_attributes(x)