From c7b879f458c116801c43ac3cfb9db1c62c141d89 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 27 Jun 2025 11:11:01 +0200 Subject: [PATCH] layout --- CITATION.cff | 2 +- DESCRIPTION | 2 +- NEWS.md | 6 +++ R/app_version.R | 2 +- R/data_plots.R | 54 ++++++++++++++++++------ R/hosted_version.R | 2 +- R/sysdata.rda | Bin 2817 -> 2716 bytes SESSION.md | 22 +++------- inst/apps/FreesearchR/app.R | 81 +++++++++++++++++++++++++++--------- man/data-plots.Rd | 13 ++++-- man/wrap_plot_list.Rd | 12 +++++- 11 files changed, 139 insertions(+), 57 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index dd55e2e..2a3ec2e 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -9,7 +9,7 @@ type: software license: AGPL-3.0-or-later title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers with publication ready output' -version: 25.6.3 +version: 25.6.4 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 439b731..d602b0a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR 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( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NEWS.md b/NEWS.md index a92e676..fd59113 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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 - *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. diff --git a/R/app_version.R b/R/app_version.R index 440e842..151c116 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.6.3' +app_version <- function()'25.6.4' diff --git a/R/data_plots.R b/R/data_plots.R index ba56697..bed502f 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -337,7 +337,14 @@ data_visuals_server <- function(id, ) 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)})") @@ -393,13 +400,12 @@ data_visuals_server <- function(id, paste0("plot.", input$plot_type) }), content = function(file) { - if (inherits(rv$plot,"patchwork")){ + if (inherits(rv$plot, "patchwork")) { plot <- rv$plot - } else if (inherits(rv$plot,"ggplot")){ + } else if (inherits(rv$plot, "ggplot")) { plot <- rv$plot - }else { + } else { plot <- rv$plot[[1]] - } # browser() 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( 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 } @@ -731,11 +737,17 @@ 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 #' #' @returns list of ggplot2 objects #' @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 (length(data) > 1) { out <- data |> @@ -749,17 +761,35 @@ wrap_plot_list <- function(data, tag_levels = NULL) { } })() |> 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)) { 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 { - out <- data + out <- data[[1]] } } else { 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)) + } } diff --git a/R/hosted_version.R b/R/hosted_version.R index 8e4a70d..17d0c52 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.6.3-250626' +hosted_version <- function()'v25.6.4-250627' diff --git a/R/sysdata.rda b/R/sysdata.rda index 83be4d5d48b3b9ef967620a1a1b06904b859a0ad..ff32e166cfd696d44fbdc0565882b45cc432567d 100644 GIT binary patch literal 2716 zcmV;N3S;#`T4*^jL0KkKSzrx_#Q+(u|HS|QXazw3|KNXb-@w2B|L{Nn00;;H;0zxZ zIgP7v;PjqaR=@`#LizAL6jDH{95pcn#4-qE(UCPaKvdZeMKeUg05p1xC#mV_L8<6W zQ&jQ<^*tj|wNE7cl-i93j0ngK2nG{PG%(da2%1$*3`0QECYk_Z88kFB0}u>A(V>Kz zNRcP18!0^iA%wsHAjYPeFie9?OaL^g>NL=30gwOy05kvq01W^E5>rtbC#I*VriO-q zX{LrC000_#nhco$$$DJlCPIwhF_@?eT9FjL6;$bRs8L=Yz4G7$Zn%aY9_FS^Owcd} z4h^mz1BxfY37$!60-=n*u{Lk9N+bBs(Z#*~!N1!Z|9=gz{Qpd|3?9k* z3W!h6rKF|_-|iFq=owoGO6zPgOHfi&L1;1$p&$QJbG33ULyjPPcadFYRRSN+PgSC% zOiVSpqXf8At=zG)B!=El7A~YKC@RJ#D_2K?lxZ;`A<~=~Yth7dl^VZopV0EW58m0$ zwd_nW)1>MNb}Wm;j>`Jg!=r0jt3pVu8t2a^eqR0>?8W9fo}K&$0!Epq3EN?v$XLX0 zNJHZaQDD90HJa84?r2#s&R&Gh z#+*4IW~|>&Uk&R~14W(#VRbpC-c)SdTUarqH?^(JpzbMz&8^A?#MG+I-Z4m%3ZybH zcV3HxSthm#RkbBWp~O2$v=n^a>vM7G-bxv>4ef7lPh@Lkk&{Ksd73eD6(mE;bk*J! zL)un%apjhtQWp^GiX+>LuUFVkeS7K0y40^Dd=?S2IA_>_fl5$TL=+UEO;uppx}A|c z4)g^?>WCsSKmd?nNJu~hMnMvy2#9{*s5)^(0`8=vJ9tDLPmWVxOaaq^C~E5J@^+={ zUfl=^4l^Db4$>+pip52WD4?)dMTn761%e{MK|w)6ECFD~3PnT}MUhd0gVV?7oAW0M zFQ80hQ9J>*-Pd{HjaDw1wQBLj-lbxjNmBX^lN~kI%-h23IKstKY?N6fSpgAtlF_O{ zE49Ft7YrzcNSi7ho3j&1U5w+4k0xoG=e}8`xG|xet}spSGj-v>3BVUTIfBzB5Uh!7D*g!Yb)g3fBsVZJrqgrAgF5 z8!SI?hK~Yf&h+{~VPvEJ}?kS7ofj7*r{Ucd{}t?CZ=kvpmr^u%kJlduMu%6WFR5 zU@GOX7EAQB4N?@NRU*;=RV5-O176kxqX4L+i_oql8=x$YTTc-#2D*!Cwl~wjDk`q2 zMlvG=4WP25s>f*d>EGKRh`&9rB2*RRoFOYFbk~Q}UM;O_WkpUic?}4R7|4tT0T{#% zErGi##t;Id6cNvb(H$iab11=`M&2J?#IFxTy%s&ISleof0a+j{B(@nGuU zlw4)nVx_BC-`{G z78)j)U298KFqKtRRZ=o8E6aPWS_bAp5O;U?c64=(ybvG@pj?{)o^!s|&%nIGS-D-( zT_o}gV)&whq>WLV_UHlx0Xk`HJcD0qjC;ImX zpu85zTp>GZag*85Gq%%}9|&gw{~9*ZroURgze_2^cOAs?(u*ZXh*P6QD^Y~JSE^*k zn45No{){QE@@e@GBhUigCk6WN3-Psya>0-4S}A_-aZP#aaB5EDe~L zXef_exRuO#);l#_U_TM5D-h=-McHYD^6;%!7D2skPb^&3Nx7*sC~oc--9@*KELE&F z;CJTBjLy)6I6M%_sE;Zt$9mrLE|$zqkqR>#%s^WnoZbDN0~4M#!omf{r;Zkm;q5!M z6H0KP5Xr}7f31t0HGC*WMOWi+XiA%|(P`VQ!rCb3>^mxPLBos^kz?dq;&fxbP0ik3 zud7a1LgE!!kAV6-XIiWw0dOeqVmh3Q$s|MR5+J-?*I8_mUwFfZVr}HajHNPm@%RJWF4X%eyY#V_Bzf!4AR~cE^k{>X`MfaU6brRR% z9~0wBW}Ozo+h;@X#?bcRz+-$VM!EU^ezrVE)ih83$EcO1<-h*j&gMcA`mvM3&1i%Q4|eA z3nJvnjwlmT!w0>a@T~#`0Clyb)Q#*JbTcPcURg4h`pu{|nr@e^^xRZnnDkX@7)W-I zdbB4esU<#4>-)0QD+26Kd3Y7jb{>+U_^=UNXR__1>M^uu8VJLkuJ4una1hL(O7%%8 z@Hm%q>N`bT{kGf9*59;MTPmdbU$yf<7nXJi#D@=#$89c!GS#tRS+SS7fU7Y1wJ^et z0Jmn*w{$y6%KJ%8Mr_9kaum6uS@iVM(#2(J)9p&Enz0WXN&SmxRrKy|HVIy_xU8&dUfnzf#F+ub-y z@~Y-)lAVD>h@U3AVo=)|@~v9$T2tS~J?gw%q6TckMUF!F`Zde;VY|XID>#|8c}~3s z+_0-YpIg_^YO+W;F4f5QL&Xazw3|KNXb-@w2B|L{Nn0DuSq;0&LA zZYe^?d;`H1c2Efl4tNhh2!fP6H8KE0L7_5gZA}Iw(W#oI^)vv`1T#qTn@P5yYIy-9 zOhHZPk?FMpX`lcNGynhqJwc(yhJm9@jWlVH7?>ac8UsLSkQfsnNu-34H4T)HQ%y7g z27!MBms~_kxeP+o~NNQ8Ug5oKmY&$ z8fX9jVwQ6gOru2%##&PMrByJ9fbsS<%OU_@o`B*)LUF-^{C>|v9S|M|uUx-)sv_GG zDUx24sAdd06QzcsY!D1^Kn37H54K-swqIwy9^AY8$=>hRK~L^9cu>ZuSm+vujSEdh zBW19cwZq)^+at%h65MENg^v>PL&=g0!+9l~)k(E%S)l{c*6M0*AQ1jIXA(s_rh74% zg5l-Lc+9-xBs;rP+W{gjL1#sr)zdu7QCNF5VN{? zPU{Te(%`7>&c6Q+m%$_^b-Z>vz1yWvc{1xOBH576Yb}%-JSpg$>7%qPiObAqNz0Q~ zY8cU%XsWLUMs!+6LJwcC;$bDs04!oLP7`#vM7}RMMLutQR2ZA3vwkIKSV?* zW*ZVh6-B#M_YnFqL{vpsu~saK5n?hbf+SUuMIeYpPz41R z3PvC(j8Iht0Y&ikJGH-}9EqfCVw+^CPiBzEO><^# z;_Nwvixk@?+*INfIm>TO_f1}P(U9LaW*1a>qgu?X4=veBwoQjk+c#ZeB+EmZ{IFmhDJ425Z5rh^P;%0xX>?4A zCQ^fP_{K02yg49@T-IJCAaG?;Of0d@s#jBs4Vq&)#DNQW)KfCt7fvXSHoDe>7HKQl zD(p9$y2QG{<{6uH+M3@lDPA(0b2`;DBdc=eX6c1`aOm zn6x{o5Fll-cS1yhNHHXW$pREDw^p{>OPX-zZ%x(R4is?6B6Ak=2vDYg?9j;-cR`;9 z>Y2$mMWc@GFxEG^rh5NNO-%RaZEWk|Hv=p~N@>B>fu=(e50Z`xZMMs8zzJc6wUVfN zg9HzCJ=5bl5mRisB3X>WYRwqPrYqjX;j=AlRu3NFfsqI+6+wuSaS7mrJJ?Cctg)xV~^yIQI^6|qA^3938g=5-<^$!G^50z9l;-DLM0^@}Z z15_ml)kp;(1yIteWI8v`h(e;04^oWtEL+4_4~uz$z-PsaVL27#l%h zSt_yGK6^b|WDy1ZcD)j?N2@rHsWZb~w{dvZw%aOOSK5|;EE%ToSHO#&iX~2?-#ve+*-wGqQEO8Qb?c!SYSC}*)+LgBCpEIE;8*g zRBc+u-;tQIXsN_m4E6obQ@^h+voC(GleU%FR?@AOE>Mlm>*tq7`Ddm6Zo5v*sFkX4 zu+*Ain$oOv*4s+4Ql#om$lAovp$Jp_PqSZ9zKB8<(vJoaZq7H)B@Tz0NZGliS7VsL z&->VcmK(QEDzpef6?&4p+qq?wUe;DDz1ZC{^1Vi0CEF%ddDDCF<+02rQIWfzbx znqCvpXv}=)b>!zAYkR>Bq*e;ORxY+e|K;gq5j?9538|P`Ej~A5;WxdXA=yhx4IL0o z0>{X%i?Zg{%^4nJ@A@_Bof9EkGNa5qJFJo|ArUZCb*P4!r#BF5Ee;JPHT{Wlu{V`j zDS2K6;o8B?z>Nfq zF-1x1yvwt7=}X`gETu(iUW0`cx0T>DkyDjqDTc4DoEdyv*xh9!_qil%gL*tTE#i+! z2s$f3Erqh0%9`A`JcKX=ltJ!1nQ3pWDG}(7Q4px9HkxzZ#CAVt9p7XdvgB)+g|o(( z5yi?j*KCMcZp)`9kTDd4@@{QIdN3;i@IiFlhg{sqE*!ORD~aFbF@Q;7jYl2Mb(tg0 zaP7wKkm={&z8Js0binF3<6HcNW`z(MYLu z(0r%0^@M<}HLyk`H~(0-K0xa$@lZyqSetjT2O|)%smmw47MrqY&q(1;mzoOlfD z1a^+zmA6H!tG3ZI7pC0D4C^gM^GO{~MB2el^I17$xu5FrT>o1n|5o= zi#)87C>d82u*M?R%~Em&gpm?Pw=jVuF4+XYDl4lOS2NAUw`^^9;y2#d)zCI6eKH~d z_3PEv+;Jk3I2Le0g+|4xbx@sETNd!PhFHbrti{wM*qNiAv|xLxx5->3I&NC8k{ht1 zL{F0)io%?BFTF^@YE2!x 1) { out <- data |> @@ -2349,17 +2361,35 @@ wrap_plot_list <- function(data, tag_levels = NULL) { } })() |> 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)) { 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 { - out <- data + out <- data[[1]] } } else { 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 ######## -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) #' +#' @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 #' @export #' #' @name data-plots #' #' @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 |> #' default_parsing() |> #' 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)) { ds <- split(data, data[ter]) } 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 #' mtcars |> plot_box_single("mpg") #' mtcars |> plot_box_single("mpg","cyl") +#' gtsummary::trial |> plot_box_single("age","trt") plot_box_single <- function(data, pri, sec=NULL, seed = 2103) { 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) + ## THis could be optional in future 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() + viridis::scale_fill_viridis(discrete = discrete, option = "D") + # ggplot2::theme_void() + @@ -4983,7 +5026,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) { }) # 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") } @@ -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") } diff --git a/man/data-plots.Rd b/man/data-plots.Rd index 6a42b99..9a612c1 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -22,7 +22,7 @@ data_visuals_server(id, data, ...) 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) @@ -41,9 +41,9 @@ plot_violin(data, pri, sec, ter = NULL) \arguments{ \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)} @@ -99,12 +99,17 @@ Beatiful violin plot } \examples{ 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 |> default_parsing() |> 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","cyl") +gtsummary::trial |> plot_box_single("age","trt") mtcars |> plot_hbars(pri = "carb", sec = "cyl") mtcars |> plot_hbars(pri = "carb", sec = NULL) mtcars |> diff --git a/man/wrap_plot_list.Rd b/man/wrap_plot_list.Rd index d1e8fd1..bc291df 100644 --- a/man/wrap_plot_list.Rd +++ b/man/wrap_plot_list.Rd @@ -4,12 +4,22 @@ \alias{wrap_plot_list} \title{Wrapping} \usage{ -wrap_plot_list(data, tag_levels = NULL) +wrap_plot_list( + data, + tag_levels = NULL, + title = NULL, + axis.font.family = NULL, + ... +) } \arguments{ \item{data}{list of ggplot2 objects} \item{tag_levels}{passed to patchwork::plot_annotation if given. Default is NULL} + +\item{title}{panel title} + +\item{...}{ignored for argument overflow} } \value{ list of ggplot2 objects