new version

app_docker/app.R

@@ -49,7 +49,7 @@ library(rlang)
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'25.7.2'
+app_version <- function()'25.8.1'
 
 
 ########
@@ -2338,7 +2338,10 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
 #' @param data list of ggplot2 objects
 #' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
 #' @param title panel title
-#' @param ... ignored for argument overflow
+#' @param guides passed to patchwork::wrap_plots()
+#' @param axes passed to patchwork::wrap_plots()
+#' @param axis_titles passed to patchwork::wrap_plots()
+#' @param ... passed to patchwork::wrap_plots()
 #'
 #' @returns list of ggplot2 objects
 #' @export
@@ -2347,6 +2350,9 @@ wrap_plot_list <- function(data,
                            tag_levels = NULL,
                            title = NULL,
                            axis.font.family = NULL,
+                           guides = "collect",
+                           axes = "collect",
+                           axis_titles = "collect",
                            ...) {
   if (ggplot2::is_ggplot(data[[1]])) {
     if (length(data) > 1) {
@@ -2362,9 +2368,10 @@ wrap_plot_list <- function(data,
         })() |>
         align_axes() |>
         patchwork::wrap_plots(
-          guides = "collect",
-          axes = "collect",
-          axis_titles = "collect"
+          guides = guides,
+          axes = axes,
+          axis_titles = axis_titles,
+          ...
         )
       if (!is.null(tag_levels)) {
         out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
@@ -2383,13 +2390,17 @@ wrap_plot_list <- function(data,
     cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
   }
 
-  if (inherits(x = out, what = "patchwork")) {
-    out &
-      ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
-  } else {
-    out +
-      ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
+  if (!is.null(axis.font.family)) {
+    if (inherits(x = out, what = "patchwork")) {
+      out <- out &
+        ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
+    } else {
+      out <- out +
+        ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
+    }
   }
+
+  out
 }
 
 
@@ -2400,7 +2411,7 @@ wrap_plot_list <- function(data,
 #' @returns list of ggplot2 objects
 #' @export
 #'
-align_axes <- function(...) {
+align_axes <- function(..., x.axis = TRUE, y.axis = TRUE) {
   # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
   # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
   if (ggplot2::is_ggplot(..1)) {
@@ -2418,7 +2429,16 @@ align_axes <- function(...) {
   xr <- clean_common_axis(p, "x")
 
   suppressWarnings({
-    p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
+    purrr::map(p, \(.x){
+      out <- .x
+      if (isTRUE(x.axis)) {
+        out <- out + ggplot2::xlim(xr)
+      }
+      if (isTRUE(y.axis)) {
+        out <- out + ggplot2::ylim(yr)
+      }
+      out
+    })
   })
 }
 
@@ -4026,7 +4046,7 @@ simple_snake <- function(data){
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.7.2-250722'
+hosted_version <- function()'v25.8.1-250808'
 
 
 ########
@@ -5015,6 +5035,7 @@ ggeulerr <- function(
 #'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 #' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
 #' mtcars |> plot_euler("vs", "am", seed = 1)
+#' mtcars |> plot_euler("vs", "am", "cyl", seed = 1)
 plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   set.seed(seed = seed)
   if (!is.null(ter)) {
@@ -5029,10 +5050,9 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
       na.omit() |>
       plot_euler_single()
   })
-
-  # names(out)
+# browser()
   wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}"))
-  # patchwork::wrap_plots(out, guides = "collect")
+  # patchwork::wrap_plots(out)
 }
 
 #' Easily plot single euler diagrams
@@ -5062,8 +5082,8 @@ plot_euler_single <- function(data) {
       legend.position = "none",
       # panel.grid.major = element_blank(),
       # panel.grid.minor = element_blank(),
-      # axis.text.y = element_blank(),
-      # axis.title.y = element_blank(),
+      axis.text.y = ggplot2::element_blank(),
+      axis.title.y = ggplot2::element_blank(),
       text = ggplot2::element_text(size = 20),
       axis.text = ggplot2::element_blank(),
       # plot.title = element_blank(),
@@ -5087,6 +5107,7 @@ plot_euler_single <- function(data) {
 #'
 #' @examples
 #' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+#' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 #' mtcars |> plot_hbars(pri = "carb", sec = NULL)
 plot_hbars <- function(data, pri, sec, ter = NULL) {
   out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)
@@ -5496,17 +5517,20 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
     ds <- list(data)
   }
 
-  out <- lapply(ds, \(.ds){
-    rempsyc::nice_violin(
-      data = .ds,
-      group = sec,
-      response = pri,
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
-    )
-  })
+  # browser()
+  suppressWarnings({
+    out <- lapply(ds, \(.ds){
+      rempsyc::nice_violin(
+        data = .ds,
+        group = sec,
+        response = pri,
+        xtitle = get_label(data, var = sec),
+        ytitle = get_label(data, var = pri)
+      )
+    })
 
-  wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}"))
+    wrap_plot_list(out, title = glue::glue("Grouped by {get_label(data,ter)}"))
+  })
   # patchwork::wrap_plots(out,guides = "collect")
 }