andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 01:49:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

layout
Some checks failed
pkgdown.yaml / pkgdown (push) Has been cancelled
Details

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-06-27 11:11:01 +02:00
parent c6f42a5640
commit c7b879f458
No known key found for this signature in database
11 changed files with 139 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
CITATION.cff
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.6.3 version: 25.6.4
doi: 10.5281/zenodo.14527429 doi: 10.5281/zenodo.14527429
identifiers: identifiers:
- type: url - type: url

2
DESCRIPTION
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.6.3 Version: 25.6.4
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")),

6
NEWS.md
View file

@ -1,3 +1,9 @@
# FreesearchR 25.6.4
The app is now also published as a docker container. See the README for instructions. It is mainly to use for hosting the app. Work is ongoing to publish a true standalone app, preferably for both Windows and MacOS.
- *FIX* improved plot labels.
# FreesearchR 25.6.3 # FreesearchR 25.6.3
- *NEW* Introducing more options to evaluate missing observations. Inspired by the [visdat()] function from the {visdat} package, a specialised function has been introduced to easily visualise data classes and missing observations in the data set. This highly increases the options to visually get an overview of the data and to assess the pattern of missing data. Also under Evaluate, a comparison module has been introduced to compare the distribution of observations across variables depending on the missing vs non-missing in a specified variable. - *NEW* Introducing more options to evaluate missing observations. Inspired by the [visdat()] function from the {visdat} package, a specialised function has been introduced to easily visualise data classes and missing observations in the data set. This highly increases the options to visually get an overview of the data and to assess the pattern of missing data. Also under Evaluate, a comparison module has been introduced to compare the distribution of observations across variables depending on the missing vs non-missing in a specified variable.

2
R/app_version.R
View file

@ -1 +1 @@
app_version <- function()'25.6.3' app_version <- function()'25.6.4'

54
R/data_plots.R
View file

@ -337,7 +337,14 @@ data_visuals_server <- function(id,
) )
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", { shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- rlang::exec(create_plot, !!!append_list(data(), parameters, "data")) rv$plot <- rlang::exec(
create_plot,
!!!append_list(
data(),
parameters,
"data"
)
)
}) })
rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})") rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})")
@ -393,13 +400,12 @@ data_visuals_server <- function(id,
paste0("plot.", input$plot_type) paste0("plot.", input$plot_type)
}), }),
content = function(file) { content = function(file) {
if (inherits(rv$plot,"patchwork")){ if (inherits(rv$plot, "patchwork")) {
plot <- rv$plot plot <- rv$plot
} else if (inherits(rv$plot,"ggplot")){ } else if (inherits(rv$plot, "ggplot")) {
plot <- rv$plot plot <- rv$plot
}else { } else {
plot <- rv$plot[[1]] plot <- rv$plot[[1]]
} }
# browser() # browser()
shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", { shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
@ -659,12 +665,12 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
out <- do.call( out <- do.call(
type, type,
modifyList(parameters,list(data=data)) modifyList(parameters, list(data = data))
) )
code <- rlang::call2(type,!!!parameters,.ns = "FreesearchR") code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
attr(out,"code") <- code attr(out, "code") <- code
out out
} }
@ -731,11 +737,17 @@ 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 ... ignored for argument overflow
#' #'
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @export
#' #'
wrap_plot_list <- function(data, tag_levels = NULL) { wrap_plot_list <- function(data,
tag_levels = NULL,
title = NULL,
axis.font.family=NULL,
...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
out <- data |> out <- data |>
@ -749,17 +761,35 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
} }
})() |> })() |>
align_axes() |> align_axes() |>
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect") patchwork::wrap_plots(
guides = "collect",
axes = "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)
} }
if (!is.null(title)) {
out <- out +
patchwork::plot_annotation(
title = title,
theme = ggplot2::theme(plot.title = ggplot2::element_text(size = 25))
)
}
} else { } else {
out <- data out <- data[[1]]
} }
} else { } else {
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects") cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
} }
out
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))
}
} }

2
R/hosted_version.R
View file

@ -1 +1 @@
hosted_version <- function()'v25.6.3-250626' hosted_version <- function()'v25.6.4-250627'

BIN
R/sysdata.rda
View file

Binary file not shown.

22
SESSION.md
View file

@ -11,11 +11,11 @@
|collate |en_US.UTF-8 | |collate |en_US.UTF-8 |
|ctype |en_US.UTF-8 | |ctype |en_US.UTF-8 |
|tz |Europe/Copenhagen | |tz |Europe/Copenhagen |
|date |2025-06-26 | |date |2025-06-27 |
|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.6.3.250626 | |FreesearchR |25.6.4.250627 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -26,8 +26,6 @@
|apexcharter |0.4.4 |2024-09-06 |CRAN (R 4.4.1) | |apexcharter |0.4.4 |2024-09-06 |CRAN (R 4.4.1) |
|askpass |1.2.1 |2024-10-04 |CRAN (R 4.4.1) | |askpass |1.2.1 |2024-10-04 |CRAN (R 4.4.1) |
|assertthat |0.2.1 |2019-03-21 |CRAN (R 4.4.1) | |assertthat |0.2.1 |2019-03-21 |CRAN (R 4.4.1) |
|attachment |0.4.5 |2025-03-14 |CRAN (R 4.4.1) |
|attempt |0.3.1 |2020-05-03 |CRAN (R 4.4.1) |
|backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) | |backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) |
|base64enc |0.1-3 |2015-07-28 |CRAN (R 4.4.1) | |base64enc |0.1-3 |2015-07-28 |CRAN (R 4.4.1) |
|bayestestR |0.15.3 |2025-04-28 |CRAN (R 4.4.1) | |bayestestR |0.15.3 |2025-04-28 |CRAN (R 4.4.1) |
@ -45,7 +43,6 @@
|cardx |0.2.4 |2025-04-12 |CRAN (R 4.4.1) | |cardx |0.2.4 |2025-04-12 |CRAN (R 4.4.1) |
|caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) | |caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) |
|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) |
|cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) |
|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) |
|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) |
|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) |
@ -55,7 +52,6 @@
|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 |1.9.5 |2025-03-17 |CRAN (R 4.4.1) | |commonmark |1.9.5 |2025-03-17 |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) |
|curl |6.2.2 |2025-03-24 |CRAN (R 4.4.1) |
|data.table |1.17.0 |2025-02-22 |CRAN (R 4.4.1) | |data.table |1.17.0 |2025-02-22 |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) |
|datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) | |datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) |
@ -64,7 +60,6 @@
|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | |devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) |
|DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) | |DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) |
|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | |digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) |
|dockerfiler |0.2.5 |2025-05-07 |CRAN (R 4.4.1) |
|doParallel |1.0.17 |2022-02-07 |CRAN (R 4.4.0) | |doParallel |1.0.17 |2022-02-07 |CRAN (R 4.4.0) |
|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | |dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) |
|DT |0.33 |2024-04-04 |CRAN (R 4.4.0) | |DT |0.33 |2024-04-04 |CRAN (R 4.4.0) |
@ -87,7 +82,7 @@
|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.6.3 |NA |NA | |FreesearchR |25.6.4 |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.3 |2022-07-05 |CRAN (R 4.4.1) | |generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) |
@ -115,7 +110,6 @@
|iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) | |iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) |
|jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) |
|jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) |
|jsonvalidate |1.5.0 |2025-02-07 |CRAN (R 4.4.1) |
|KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) |
|keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) | |keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) |
|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | |knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) |
@ -123,11 +117,9 @@
|later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) | |later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) |
|lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) |
|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) |
|litedown |0.7 |2025-04-08 |CRAN (R 4.4.1) |
|lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) |
|lubridate |1.9.4 |2024-12-08 |CRAN (R 4.4.1) | |lubridate |1.9.4 |2024-12-08 |CRAN (R 4.4.1) |
|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | |magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) |
|markdown |2.0 |2025-03-23 |CRAN (R 4.4.1) |
|MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) |
|Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) | |Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) |
|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | |memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) |
@ -142,7 +134,6 @@
|opdisDownsampling |1.0.1 |2024-04-15 |CRAN (R 4.4.0) | |opdisDownsampling |1.0.1 |2024-04-15 |CRAN (R 4.4.0) |
|openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) | |openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) |
|openxlsx2 |1.15 |2025-04-25 |CRAN (R 4.4.1) | |openxlsx2 |1.15 |2025-04-25 |CRAN (R 4.4.1) |
|pak |0.8.0.2 |2025-04-08 |CRAN (R 4.4.1) |
|parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) | |parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) |
|patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) |
|pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.4.1) | |pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.4.1) |
@ -171,7 +162,6 @@
|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) |
|ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) | |ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) |
|rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) | |rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) |
|rappdirs |0.3.3 |2021-01-31 |CRAN (R 4.4.1) |
|rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) |
|RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) |
|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) |
@ -202,7 +192,6 @@
|see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) | |see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) |
|sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) | |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) |
|shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) | |shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) |
|shiny2docker |0.0.2 |2025-02-09 |CRAN (R 4.4.1) |
|shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | |shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) |
|shinyjs |2.1.0 |2021-12-23 |CRAN (R 4.4.0) | |shinyjs |2.1.0 |2021-12-23 |CRAN (R 4.4.0) |
|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) |
@ -224,11 +213,11 @@
|tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) | |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) |
|urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) | |urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) |
|usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | |usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) |
|utf8 |1.2.4 |2023-10-22 |CRAN (R 4.4.1) |
|uuid |1.2-1 |2024-07-29 |CRAN (R 4.4.1) | |uuid |1.2-1 |2024-07-29 |CRAN (R 4.4.1) |
|V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) |
|vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) |
|viridis |0.6.5 |2024-01-29 |CRAN (R 4.4.0) |
|viridisLite |0.4.2 |2023-05-02 |CRAN (R 4.4.1) | |viridisLite |0.4.2 |2023-05-02 |CRAN (R 4.4.1) |
|visdat |0.6.0 |NA |NA |
|vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) | |vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) |
|withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) | |withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) |
|writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) | |writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) |
@ -236,5 +225,4 @@
|xml2 |1.3.8 |2025-03-14 |CRAN (R 4.4.1) | |xml2 |1.3.8 |2025-03-14 |CRAN (R 4.4.1) |
|xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) | |xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) |
|yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) | |yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) |
|yesno |0.1.3 |2024-07-26 |CRAN (R 4.4.1) |
|zip |2.3.2 |2025-02-01 |CRAN (R 4.4.1) | |zip |2.3.2 |2025-02-01 |CRAN (R 4.4.1) |

81
inst/apps/FreesearchR/app.R
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.6.3' app_version <- function()'25.6.4'
######## ########
@ -1937,7 +1937,14 @@ data_visuals_server <- function(id,
) )
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", { shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- rlang::exec(create_plot, !!!append_list(data(), parameters, "data")) rv$plot <- rlang::exec(
create_plot,
!!!append_list(
data(),
parameters,
"data"
)
)
}) })
rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})") rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})")
@ -1993,13 +2000,12 @@ data_visuals_server <- function(id,
paste0("plot.", input$plot_type) paste0("plot.", input$plot_type)
}), }),
content = function(file) { content = function(file) {
if (inherits(rv$plot,"patchwork")){ if (inherits(rv$plot, "patchwork")) {
plot <- rv$plot plot <- rv$plot
} else if (inherits(rv$plot,"ggplot")){ } else if (inherits(rv$plot, "ggplot")) {
plot <- rv$plot plot <- rv$plot
}else { } else {
plot <- rv$plot[[1]] plot <- rv$plot[[1]]
} }
# browser() # browser()
shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", { shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
@ -2259,12 +2265,12 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
out <- do.call( out <- do.call(
type, type,
modifyList(parameters,list(data=data)) modifyList(parameters, list(data = data))
) )
code <- rlang::call2(type,!!!parameters,.ns = "FreesearchR") code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
attr(out,"code") <- code attr(out, "code") <- code
out out
} }
@ -2331,11 +2337,17 @@ 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 ... ignored for argument overflow
#' #'
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @export
#' #'
wrap_plot_list <- function(data, tag_levels = NULL) { wrap_plot_list <- function(data,
tag_levels = NULL,
title = NULL,
axis.font.family=NULL,
...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
out <- data |> out <- data |>
@ -2349,17 +2361,35 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
} }
})() |> })() |>
align_axes() |> align_axes() |>
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect") patchwork::wrap_plots(
guides = "collect",
axes = "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)
} }
if (!is.null(title)) {
out <- out +
patchwork::plot_annotation(
title = title,
theme = ggplot2::theme(plot.title = ggplot2::element_text(size = 25))
)
}
} else { } else {
out <- data out <- data[[1]]
} }
} else { } else {
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects") cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
} }
out
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))
}
} }
@ -3996,7 +4026,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.6.3-250626' hosted_version <- function()'v25.6.4-250627'
######## ########
@ -4805,17 +4835,27 @@ missing_demo_app()
#' Beautiful box plot(s) #' Beautiful box plot(s)
#' #'
#' @param data data frame
#' @param pri primary variable
#' @param sec secondary variable
#' @param ter tertiary variable
#' @param ... passed on to wrap_plot_list
#'
#' @returns ggplot2 object #' @returns ggplot2 object
#' @export #' @export
#' #'
#' @name data-plots #' @name data-plots
#' #'
#' @examples #' @examples
#' mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear") #' mtcars |> plot_box(pri = "mpg", sec = "gear")
#' mtcars |> plot_box(pri = "mpg", sec="cyl")
#' mtcars |> #' mtcars |>
#' default_parsing() |> #' default_parsing() |>
#' plot_box(pri = "mpg", sec = "cyl", ter = "gear") #' plot_box(pri = "mpg", sec = "cyl", ter = "gear")
plot_box <- function(data, pri, sec, ter = NULL) { #' mtcars |>
#' default_parsing() |>
#' plot_box(pri = "mpg", sec = "cyl", ter = "gear",axis.font.family="mono")
plot_box <- function(data, pri, sec, ter = NULL,...) {
if (!is.null(ter)) { if (!is.null(ter)) {
ds <- split(data, data[ter]) ds <- split(data, data[ter])
} else { } else {
@ -4830,7 +4870,7 @@ plot_box <- function(data, pri, sec, ter = NULL) {
) )
}) })
wrap_plot_list(out) wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}"),...)
} }
@ -4846,6 +4886,7 @@ plot_box <- function(data, pri, sec, ter = NULL) {
#' @examples #' @examples
#' mtcars |> plot_box_single("mpg") #' mtcars |> plot_box_single("mpg")
#' mtcars |> plot_box_single("mpg","cyl") #' mtcars |> plot_box_single("mpg","cyl")
#' gtsummary::trial |> plot_box_single("age","trt")
plot_box_single <- function(data, pri, sec=NULL, seed = 2103) { plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
set.seed(seed) set.seed(seed)
@ -4861,6 +4902,8 @@ plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) + ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
## THis could be optional in future ## THis could be optional in future
ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9, width = 0.1, height = .2) + ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9, width = 0.1, height = .2) +
ggplot2::xlab(get_label(data,pri))+
ggplot2::ylab(get_label(data,sec)) +
ggplot2::coord_flip() + ggplot2::coord_flip() +
viridis::scale_fill_viridis(discrete = discrete, option = "D") + viridis::scale_fill_viridis(discrete = discrete, option = "D") +
# ggplot2::theme_void() + # ggplot2::theme_void() +
@ -4983,7 +5026,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
}) })
# names(out) # names(out)
wrap_plot_list(out) 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")
} }
@ -5458,7 +5501,7 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
) )
}) })
wrap_plot_list(out) 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")
} }

13
man/data-plots.Rd
View file

@ -22,7 +22,7 @@ data_visuals_server(id, data, ...)
create_plot(data, type, pri, sec, ter = NULL, ...) create_plot(data, type, pri, sec, ter = NULL, ...)
plot_box(data, pri, sec, ter = NULL) plot_box(data, pri, sec, ter = NULL, ...)
plot_box_single(data, pri, sec = NULL, seed = 2103) plot_box_single(data, pri, sec = NULL, seed = 2103)
@ -41,9 +41,9 @@ plot_violin(data, pri, sec, ter = NULL)
\arguments{ \arguments{
\item{id}{Module id. (Use 'ns("id")')} \item{id}{Module id. (Use 'ns("id")')}
\item{...}{ignored for now} \item{...}{passed on to wrap_plot_list}
\item{data}{data.frame} \item{data}{data frame}
\item{type}{plot type (derived from possible_plots() and matches custom function)} \item{type}{plot type (derived from possible_plots() and matches custom function)}
@ -99,12 +99,17 @@ Beatiful violin plot
} }
\examples{ \examples{
create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes() create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear") mtcars |> plot_box(pri = "mpg", sec = "gear")
mtcars |> plot_box(pri = "mpg", sec="cyl")
mtcars |> mtcars |>
default_parsing() |> default_parsing() |>
plot_box(pri = "mpg", sec = "cyl", ter = "gear") plot_box(pri = "mpg", sec = "cyl", ter = "gear")
mtcars |>
default_parsing() |>
plot_box(pri = "mpg", sec = "cyl", ter = "gear",axis.font.family="mono")
mtcars |> plot_box_single("mpg") mtcars |> plot_box_single("mpg")
mtcars |> plot_box_single("mpg","cyl") mtcars |> plot_box_single("mpg","cyl")
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 = NULL) mtcars |> plot_hbars(pri = "carb", sec = NULL)
mtcars |> mtcars |>

12
man/wrap_plot_list.Rd
View file

@ -4,12 +4,22 @@
\alias{wrap_plot_list} \alias{wrap_plot_list}
\title{Wrapping} \title{Wrapping}
\usage{ \usage{
wrap_plot_list(data, tag_levels = NULL) wrap_plot_list(
data,
tag_levels = NULL,
title = NULL,
axis.font.family = NULL,
...
)
} }
\arguments{ \arguments{
\item{data}{list of ggplot2 objects} \item{data}{list of ggplot2 objects}
\item{tag_levels}{passed to patchwork::plot_annotation if given. Default is NULL} \item{tag_levels}{passed to patchwork::plot_annotation if given. Default is NULL}
\item{title}{panel title}
\item{...}{ignored for argument overflow}
} }
\value{ \value{
list of ggplot2 objects list of ggplot2 objects