Compare commits

...

6 commits

16 changed files with 112 additions and 52 deletions

View file

@ -9,7 +9,7 @@ type: software
license: AGPL-3.0-or-later license: AGPL-3.0-or-later
title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers
with publication ready output' with publication ready output'
version: 25.7.2 version: 25.7.3
doi: 10.5281/zenodo.14527429 doi: 10.5281/zenodo.14527429
identifiers: identifiers:
- type: url - type: url

View file

@ -1,6 +1,6 @@
Package: FreesearchR Package: FreesearchR
Title: A free and open-source browser based data analysis tool for researchers with publication ready output Title: A free and open-source browser based data analysis tool for researchers with publication ready output
Version: 25.7.2 Version: 25.8.1
Authors@R: c( Authors@R: c(
person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7559-1154")), comment = c(ORCID = "0000-0002-7559-1154")),

View file

@ -1,7 +1,12 @@
# FreesearchR 25.7.3 - DEV # FreesearchR 25.8.2 - DEV
- *NEW* preparing to automatically only show relevant tabs to simplify interface. NOT IMPLEMENTED YET - *NEW* preparing to automatically only show relevant tabs to simplify interface. NOT IMPLEMENTED YET
# FreesearchR 25.8.1
- *NEW* improved the use of `wrap_plot_list()` to pass on additional arguments to `patchwork::wrap_plots()` and allowed to specify axes to align in `align_axes()`.
- *FIX* fixed axis text printed in Euler diagrams
# FreesearchR 25.7.2 # FreesearchR 25.7.2
- *FIX* refining hiding drop downs. All JavaScript is now in separate file. Coded with GAI help from claude.ai. - *FIX* refining hiding drop downs. All JavaScript is now in separate file. Coded with GAI help from claude.ai.

View file

@ -1 +1 @@
app_version <- function()'25.7.2' app_version <- function()'25.7.3'

View file

@ -738,7 +738,10 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
#' @param data list of ggplot2 objects #' @param data list of ggplot2 objects
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL #' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
#' @param title panel title #' @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 #' @returns list of ggplot2 objects
#' @export #' @export
@ -747,6 +750,9 @@ wrap_plot_list <- function(data,
tag_levels = NULL, tag_levels = NULL,
title = NULL, title = NULL,
axis.font.family = NULL, axis.font.family = NULL,
guides = "collect",
axes = "collect",
axis_titles = "collect",
...) { ...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
@ -762,9 +768,10 @@ wrap_plot_list <- function(data,
})() |> })() |>
align_axes() |> align_axes() |>
patchwork::wrap_plots( patchwork::wrap_plots(
guides = "collect", guides = guides,
axes = "collect", axes = axes,
axis_titles = "collect" axis_titles = axis_titles,
...
) )
if (!is.null(tag_levels)) { if (!is.null(tag_levels)) {
out <- out + patchwork::plot_annotation(tag_levels = tag_levels) out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
@ -783,15 +790,19 @@ wrap_plot_list <- function(data,
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects") cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
} }
if (!is.null(axis.font.family)) {
if (inherits(x = out, what = "patchwork")) { if (inherits(x = out, what = "patchwork")) {
out & out <- out &
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family)) ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
} else { } else {
out + out <- out +
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family)) ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
} }
} }
out
}
#' Aligns axes between plots #' Aligns axes between plots
#' #'
@ -800,7 +811,7 @@ wrap_plot_list <- function(data,
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @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://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -818,7 +829,16 @@ align_axes <- function(...) {
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ 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
})
}) })
} }

View file

@ -1 +1 @@
hosted_version <- function()'v25.7.2-250722' hosted_version <- function()'v25.7.3-250808'

View file

@ -76,6 +76,7 @@ ggeulerr <- function(
#' D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE) #' D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
#' ) |> plot_euler("A", c("B", "C"), "D", seed = 4) #' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
#' mtcars |> plot_euler("vs", "am", seed = 1) #' 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) { plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
set.seed(seed = seed) set.seed(seed = seed)
if (!is.null(ter)) { if (!is.null(ter)) {
@ -90,10 +91,9 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
na.omit() |> na.omit() |>
plot_euler_single() plot_euler_single()
}) })
# browser()
# names(out)
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") # patchwork::wrap_plots(out)
} }
#' Easily plot single euler diagrams #' Easily plot single euler diagrams
@ -123,8 +123,8 @@ plot_euler_single <- function(data) {
legend.position = "none", legend.position = "none",
# panel.grid.major = element_blank(), # panel.grid.major = element_blank(),
# panel.grid.minor = element_blank(), # panel.grid.minor = element_blank(),
# axis.text.y = element_blank(), axis.text.y = ggplot2::element_blank(),
# axis.title.y = element_blank(), axis.title.y = ggplot2::element_blank(),
text = ggplot2::element_text(size = 20), text = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_blank(), axis.text = ggplot2::element_blank(),
# plot.title = element_blank(), # plot.title = element_blank(),

View file

@ -7,6 +7,7 @@
#' #'
#' @examples #' @examples
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl") #' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
#' mtcars |> plot_hbars(pri = "carb", sec = NULL) #' mtcars |> plot_hbars(pri = "carb", sec = NULL)
plot_hbars <- function(data, pri, sec, ter = NULL) { plot_hbars <- function(data, pri, sec, ter = NULL) {
out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter) out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)

View file

@ -14,6 +14,8 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
ds <- list(data) ds <- list(data)
} }
# browser()
suppressWarnings({
out <- lapply(ds, \(.ds){ out <- lapply(ds, \(.ds){
rempsyc::nice_violin( rempsyc::nice_violin(
data = .ds, data = .ds,
@ -25,5 +27,6 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
}) })
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") # patchwork::wrap_plots(out,guides = "collect")
} }

Binary file not shown.

View file

@ -15,7 +15,7 @@
|rstudio |2025.05.0+496 Mariposa Orchid (desktop) | |rstudio |2025.05.0+496 Mariposa Orchid (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|quarto |1.7.30 @ /usr/local/bin/quarto | |quarto |1.7.30 @ /usr/local/bin/quarto |
|FreesearchR |25.7.2.250722 | |FreesearchR |25.7.3.250722 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -55,6 +55,7 @@
|colorspace |2.1-1 |2024-07-26 |CRAN (R 4.4.1) | |colorspace |2.1-1 |2024-07-26 |CRAN (R 4.4.1) |
|commonmark |2.0.0 |2025-07-07 |CRAN (R 4.4.1) | |commonmark |2.0.0 |2025-07-07 |CRAN (R 4.4.1) |
|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | |crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) |
|credentials |2.0.2 |2024-10-04 |CRAN (R 4.4.1) |
|curl |6.4.0 |2025-06-22 |CRAN (R 4.4.1) | |curl |6.4.0 |2025-06-22 |CRAN (R 4.4.1) |
|data.table |1.17.8 |2025-07-10 |CRAN (R 4.4.1) | |data.table |1.17.8 |2025-07-10 |CRAN (R 4.4.1) |
|datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) | |datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) |
@ -87,16 +88,19 @@
|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | |foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) |
|foreign |0.8-90 |2025-03-31 |CRAN (R 4.4.1) | |foreign |0.8-90 |2025-03-31 |CRAN (R 4.4.1) |
|Formula |1.2-5 |2023-02-24 |CRAN (R 4.4.1) | |Formula |1.2-5 |2023-02-24 |CRAN (R 4.4.1) |
|FreesearchR |25.7.2 |NA |NA | |FreesearchR |25.7.3 |NA |NA |
|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) |
|gdtools |0.4.2 |2025-03-27 |CRAN (R 4.4.1) | |gdtools |0.4.2 |2025-03-27 |CRAN (R 4.4.1) |
|generics |0.1.4 |2025-05-09 |CRAN (R 4.4.1) | |generics |0.1.4 |2025-05-09 |CRAN (R 4.4.1) |
|gert |2.1.5 |2025-03-25 |CRAN (R 4.4.1) |
|ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.4.0) | |ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.4.0) |
|ggcorrplot |0.1.4.1 |2023-09-05 |CRAN (R 4.4.0) | |ggcorrplot |0.1.4.1 |2023-09-05 |CRAN (R 4.4.0) |
|ggforce |0.5.0 |2025-06-18 |CRAN (R 4.4.1) | |ggforce |0.5.0 |2025-06-18 |CRAN (R 4.4.1) |
|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) |
|ggridges |0.5.6 |2024-01-23 |CRAN (R 4.4.0) | |ggridges |0.5.6 |2024-01-23 |CRAN (R 4.4.0) |
|ggstats |0.10.0 |2025-07-02 |CRAN (R 4.4.1) | |ggstats |0.10.0 |2025-07-02 |CRAN (R 4.4.1) |
|gh |1.5.0 |2025-05-26 |CRAN (R 4.4.1) |
|gitcreds |0.1.2 |2022-09-08 |CRAN (R 4.4.1) |
|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) |
|gridExtra |2.3 |2017-09-09 |CRAN (R 4.4.1) | |gridExtra |2.3 |2017-09-09 |CRAN (R 4.4.1) |
|gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) |
@ -110,6 +114,7 @@
|htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) | |htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) |
|htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) |
|httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) |
|httr2 |1.2.1 |2025-07-22 |CRAN (R 4.4.1) |
|IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) |
|insight |1.3.1 |2025-06-30 |CRAN (R 4.4.1) | |insight |1.3.1 |2025-06-30 |CRAN (R 4.4.1) |
|iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) | |iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) |
@ -205,6 +210,7 @@
|shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) | |shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) |
|stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) |
|stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) | |stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) |
|sys |3.4.3 |2024-10-04 |CRAN (R 4.4.1) |
|systemfonts |1.2.3 |2025-04-30 |CRAN (R 4.4.1) | |systemfonts |1.2.3 |2025-04-30 |CRAN (R 4.4.1) |
|testthat |3.2.3 |2025-01-13 |CRAN (R 4.4.1) | |testthat |3.2.3 |2025-01-13 |CRAN (R 4.4.1) |
|textshaping |1.0.1 |2025-05-01 |CRAN (R 4.4.1) | |textshaping |1.0.1 |2025-05-01 |CRAN (R 4.4.1) |

View file

@ -49,7 +49,7 @@ library(rlang)
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'25.7.2' app_version <- function()'25.7.3'
######## ########
@ -2364,7 +2364,8 @@ wrap_plot_list <- function(data,
patchwork::wrap_plots( patchwork::wrap_plots(
guides = "collect", guides = "collect",
axes = "collect", axes = "collect",
axis_titles = "collect" axis_titles = "collect",
...
) )
if (!is.null(tag_levels)) { if (!is.null(tag_levels)) {
out <- out + patchwork::plot_annotation(tag_levels = tag_levels) out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
@ -2400,7 +2401,7 @@ wrap_plot_list <- function(data,
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @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://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -2418,7 +2419,16 @@ align_axes <- function(...) {
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ 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 +4036,7 @@ simple_snake <- function(data){
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
######## ########
hosted_version <- function()'v25.7.2-250722' hosted_version <- function()'v25.7.3-250808'
######## ########
@ -5029,7 +5039,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
na.omit() |> na.omit() |>
plot_euler_single() plot_euler_single()
}) })
# browser()
# names(out) # names(out)
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") # patchwork::wrap_plots(out, guides = "collect")
@ -5087,6 +5097,7 @@ plot_euler_single <- function(data) {
#' #'
#' @examples #' @examples
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl") #' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
#' mtcars |> plot_hbars(pri = "carb", sec = NULL) #' mtcars |> plot_hbars(pri = "carb", sec = NULL)
plot_hbars <- function(data, pri, sec, ter = NULL) { plot_hbars <- function(data, pri, sec, ter = NULL) {
out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter) out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)
@ -5496,6 +5507,8 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
ds <- list(data) ds <- list(data)
} }
# browser()
suppressWarnings({
out <- lapply(ds, \(.ds){ out <- lapply(ds, \(.ds){
rempsyc::nice_violin( rempsyc::nice_violin(
data = .ds, data = .ds,
@ -5507,6 +5520,7 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
}) })
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") # patchwork::wrap_plots(out,guides = "collect")
} }

View file

@ -4,7 +4,7 @@
\alias{align_axes} \alias{align_axes}
\title{Aligns axes between plots} \title{Aligns axes between plots}
\usage{ \usage{
align_axes(...) align_axes(..., x.axis = TRUE, y.axis = TRUE)
} }
\arguments{ \arguments{
\item{...}{ggplot2 objects or list of ggplot2 objects} \item{...}{ggplot2 objects or list of ggplot2 objects}

View file

@ -111,6 +111,7 @@ mtcars |> plot_box_single("mpg")
mtcars |> plot_box_single("mpg","cyl") mtcars |> plot_box_single("mpg","cyl")
gtsummary::trial |> plot_box_single("age","trt") gtsummary::trial |> plot_box_single("age","trt")
mtcars |> plot_hbars(pri = "carb", sec = "cyl") mtcars |> plot_hbars(pri = "carb", sec = "cyl")
mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
mtcars |> plot_hbars(pri = "carb", sec = NULL) mtcars |> plot_hbars(pri = "carb", sec = NULL)
mtcars |> mtcars |>
default_parsing() |> default_parsing() |>

View file

@ -31,4 +31,5 @@ data.frame(
D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE) D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
) |> plot_euler("A", c("B", "C"), "D", seed = 4) ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
mtcars |> plot_euler("vs", "am", seed = 1) mtcars |> plot_euler("vs", "am", seed = 1)
mtcars |> plot_euler("vs", "am", "cyl", seed = 1)
} }

View file

@ -9,6 +9,9 @@ wrap_plot_list(
tag_levels = NULL, tag_levels = NULL,
title = NULL, title = NULL,
axis.font.family = NULL, axis.font.family = NULL,
guides = "collect",
axes = "collect",
axis_titles = "collect",
... ...
) )
} }
@ -19,7 +22,13 @@ wrap_plot_list(
\item{title}{panel title} \item{title}{panel title}
\item{...}{ignored for argument overflow} \item{guides}{passed to patchwork::wrap_plots()}
\item{axes}{passed to patchwork::wrap_plots()}
\item{axis_titles}{passed to patchwork::wrap_plots()}
\item{...}{passed to patchwork::wrap_plots()}
} }
\value{ \value{
list of ggplot2 objects list of ggplot2 objects