From cff21406bbd3e0b7988ab01d1e5079b3235ca211 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:19:55 +0200 Subject: [PATCH 1/6] feat: passes additional arguments in `wrap_plots_list()` to `patchwork::wrap_plots()` and allows specification of axes to align in `align_axes()` --- R/data_plots.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/data_plots.R b/R/data_plots.R index a751e609..6347ff07 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -764,7 +764,8 @@ wrap_plot_list <- function(data, patchwork::wrap_plots( guides = "collect", axes = "collect", - axis_titles = "collect" + axis_titles = "collect", + ... ) if (!is.null(tag_levels)) { out <- out + patchwork::plot_annotation(tag_levels = tag_levels) @@ -800,7 +801,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)) { @@ -818,7 +819,17 @@ align_axes <- function(...) { xr <- clean_common_axis(p, "x") suppressWarnings({ - p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr)) + p |> + 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 + }) }) } From d700658f5c3f582452fd0a0c2eafe003d50fa696 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:20:11 +0200 Subject: [PATCH 2/6] rendering docs --- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/app_version.R | 2 +- R/hosted_version.R | 2 +- R/sysdata.rda | Bin 2734 -> 2775 bytes SESSION.md | 10 ++++++++-- inst/apps/FreesearchR/app.R | 4 ++-- man/align_axes.Rd | 2 +- 8 files changed, 15 insertions(+), 9 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index d2716009..7600d6d2 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.7.2 +version: 25.7.3 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 002733c6..90d672ea 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.7.2 +Version: 25.7.3 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/R/app_version.R b/R/app_version.R index 6a80b530..8583a072 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.7.2' +app_version <- function()'25.7.3' diff --git a/R/hosted_version.R b/R/hosted_version.R index 4ae8ba6e..58b72621 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.7.2-250722' +hosted_version <- function()'v25.7.3-250808' diff --git a/R/sysdata.rda b/R/sysdata.rda index e1ebbdcc4b6c5acc518e8b4c5bfc128b48a90505..b17ce24a9a058a9bb8b9bb3e4b982989bc3af017 100644 GIT binary patch literal 2775 zcmV;|3MlnLT4*^jL0KkKS!LNC=l~k_|HA+OXazw3|KNXb-@w2B|L{Nn0RRXA;0#|I zj>`*&fxuFcpcDZ4-~a#s4jPz%5ugc>5Hd!S)jU!9nj_GjP&68PMu6D_RX@b1=~Mk8 zp3Jwq!|DVnE(I*rh`pAKpLJPN>MZ!G|M%gbkir;%0~13)$RyH8gp<_T zH5wWK000000MGyc8C1{!0iXZ?000000001qNvWxclhafThSUeCkN^Mx4FDK`WWg+M zCFKn)`9@r6;$SHP!I!uZqmgRY_Ntu2is!#qy`Yfy|ur*Tqm{zl#;Xtkkl>d zPPMo5tE7Noh^mgXK>Tj}c$eL~{)+U~HpOrHV+3z_S#T*@dNssH`x$}AFC>D$;{-3N z;bFmg2$AT-G6?OV+YXPMK|XA%Bj?>syxiL*3^6Vs86t7G6jkJx6YQ-7CLJeFa|c@} z;m0^;Bv8w}Dv;e0V-(FBDZ;}Nq{-G0mRZ?}ZD70Z*W>>O+UJjit0`>BwbzyTUy>Zn z0v=07CT5h8B207^0yJA3vbOaVYGTZ!8R~lVLUA+`o>*c)gobR=bdLUXXGjKtMiUq* z1fOJCLZ}Tgh}~dvq^#7YK!c6Cu1*FtE8l-}QuUih4O$jVGvC&nE;Em7!sWgb?BkpU zkq!ao2gSuzIhQiARKXsuTFr-rg_O)?inbiVs52*Y&dX7BIvc(Ucwm@m>>;>|V&zW* zPYjqw_%|6-l!n&MZya74n>VvA0_ntMA+f#{H5s+S@-Qv5>gs8|F_1>(k~wIdhmJN| zyu$AcOWx(E&bcHYkV-JeP(PU49$YfdHMDhh^~03nIV@Zy}7xz>dZiQA_%6) zs-po=2?hj&gb)#AQ7I4wL-!C-Tv9qIBYGBLj;Kf94 zF2_X1$q5MtAhBYQ6oP`NMFt>Q%NdcGRd3T=I38W6F83ZhQ*3w4lW7Bmxk^a9XYybK?7Uu zgQ^N+RWpOG2BZyyLye}{!wr*2pmkGM5^13)SvaZ*txV{#sI{RmDW<5f2_Xz&!CEF} zNwor1)F_ii?tzS!49~DeZj=ML3b81RNQXI2cTaJY<)R@B$AYr5Rz(#U(25&5xfPqo zh9cUdyIZ!xkP}NQAn(JYBJ6@otamBm)bOV!$s|(|R?H|5g}?(ru*4DxIvH$aAY`*j z*is~g3oc0AQOQU~>jAN?XlNz7Ad#6$I8@V-jt#E3?Y4#?jYQVC=8_T#L_I__5zsoQ zdSHUnZ6YBDtS+G9bz*6iLIJ6mWK&5wM517pu(@u;9J1umh6=X;g))*t33%Ja)wQ(7 z9Ad$t1+b_s3n=NJiQKun)3aqMX&W;LP%5(OB$_Zr&Q6dc(;T7C^Dj%D{qC0+GM>HHNcQ7$%`jZhxbqNIQSVDscstXR?1F4;C zte9GimQsStJ8x@-(sU&0Vc6_&q|A# z$xbvcLC%LX`AGo#5C|V;fYCSZ@R&m^3kX`FNGwQ-IL@tV2_TXWVwoUFHV|Z4(N4>l z8sf6bQm3Ins;;eL1VIC4DNT<)i&16_}Cb>M)mQ<~x5Lo~g5VlE@p>o5E zHI^bN=B62CqNwdf7NU4rQAss7Oi57heeSO|{dT+aYgsvI*|t`#Ei5R2q{b1>TF!}< zX2$p&|IODGH!TvDv3D#r4J6HJ80wX^w$%kEKE&I~y>s&GLJ*&y?aqoZ5Z*xq9)VSL zgFMGQ?Ww@60VNJsbe@s91rYqtT#>~l4_YoDf(k5jr^`-YTW#}#2q5)!1cC@Xcs6#? zA~jKWegnYqhOKKA^!)!{-T02LK+9KQI@Pz&;qrYK-A604y{=dt8+PWrBUyj^{;w zT0P3O+!e%2f7y?ovKiwQ<4uT*pyfj6X5AmO88j4}v_l5hpkm16#ktKmR7Ti^8IA@y zj3?gdmq>p^0jbk%B?1N6R04I}H6GKy5`C~sTNr{HNUo>4=33a}_`w?$OC2o^2)5gB zxcXn4#t?&kleVWt!>%bYY$#XB`fuZI=F55dzOFsE&jJ=lN%;>i8)&PDNMH(m%OSf| z^KF3#y72(=snA@axHB_}KSi@lT53Yv31gXz2_|d`L-F+S3yg;9rw4WNdDE~-fW9Zu z2Mc)!bTH!Q@_1YL!?G)tjeo$0cd*(j<$aVAF#*?bRZ9dd69lhJ7))z1NOLRf8NhCp z%(vvWyxQpW=it%5nHq^%W~$SUCSGnBqCz2J+Ll)&6mgwS@5BcZt9s!$aeXf4++_Dk z`)U}$=tju9XO}iWPuM~)ixefWwl2b|$FeXX9DyRE2cC_%xmbuL)h#3=SyXN`*OOHI z`S16^x!kT0V-BxrpdmYjZsbfjCW|$YD?$))h4@&K8JRFSL24jNG|6X%1`n0)djqOk z{p7_F0wO@B$ko@d);mxlTD6&t`!ZRQe!`lE5>>i2lLNGYf@Bd@s3l{(gVn^Go}{jw zjPCdC#8w5`9%bNH#o78v@Yujbd7fA32h?LhzE2|#c3!MKaq7@UTnc2bU5Q`Jb1w+c z?-lg+(*AC{9ipLIDw*`dY%B-@_i?mJL^{7L-L72%T3H}h6|7+Hrl{y~ZKRrM2m;;1 zM-6vN&QDjkl+uvRW;sJ9c>P>%)A zl#;iT2MH~or_H0T)tZrOrLV@^zTDnAc^N zB34lCqD1zJBUu;*Fb`Y3Q%ji8<1%?EL<}xhF>J1B#dbB240B^^o39*isST-uxmv8x zg)j5l8e3KDSjLKW!jTa|jecwkdD_DDtyy5n_;pLcSPN7@&6_zab_^@+%Bpzm-RPZ! zE@D$rUje4M&wo#@I72C7S`}2S$kh$*uDWazyq9urUS%P|lZ}xAB%EsBek*ZViqlgj dI!3om8O^ZVfts}{B~F3=7ji{7P>^NW9_V$d2gLvY literal 2734 zcmV;f3Q_e!T4*^jL0KkKS-qkTG5{Jsf5QL&Xazw3|KNXb-@w2B|L{NnKmZ5<;0!+- zju5-l4g!?fKqydr_tJnA`T)>|rXU0WN#!#l3{z?~Pial+2=tz(qyT7Up!G9A)lbPi zCLy4N+L{0wXaE`j0077h02-bkNlFHrQ^^3)>Hrvk#Lxf$00s#(k|HBbC#j><00000 z4FCWJfuIQ05HvIari}mqXaE3c003wJ2$YI?n8 z36!CQ42ASky6B>%krhoDsEV%t-om6rYN&xs@X3U4 zhT|%7klNYHPOQw)-psfQ(}>DLV|-N9Z1GnX7BuIInoNc=2;8#nA4fkoH%r6v5R1bS z_nKpmHbul+yY}YK3@WFA#j8Nt+L6Q%NdcI+HiG&CcUT6N$XxqQy61#lbkT@ZG}Wr#DR~GHZRXbwNyOrf_w@ zjc5r3fr$xdK@5o!wRLVvA`Y@KWD{DM(O^Zb34u*DMSw{NV-5<@Gcrx660V^{nm2SB zj6ux#BxdPAJCRudL}ElvRZi*dGMuzQ8I_fllCmhM#)MGW&B(0YJTVs49opTt6o8sp zSqFcXjEk~Kb&lmcTAnG%7EY;%t7a4j#lQnWu*4DxIvH;v10|YP!kHmL%eq5%W(-PuG% zt7%$XfeeNewIzeuDG)v+_@{%aDmX;2q{}eKq&2N(hsSd$e1CKn)F2E&1|W{4L2boE zT9lB(8pRh$RVRPm=;3#B0~U@^%(n|Rfe14&Mwx8LlycPsY)afoiq1(nL^CfosRTKb zQ*B6QOHxo^q(p|UWVZcDh@(1z1nIDa1`$*i9b^usbT|eUqa~D}vd*u!!)ZF~I}AE{ zcya5Nl~UT;rAkJvrMp_@Az4gkVe3edCqmwhRhsBzry3WW>Y>X%SU^6;LIL(@4HJHx zhCs^#!WO7d76cI+j;(d5NF;;UrYI5(LE5}4t}861Dtc53s_ND-L=ZM&)RkC= zI}VFvSR?k@?n0zTdpNRGndJAJhT`u@baRPYHpa4 zq2G3S`FH4Rzb>_tlTOXDwP|T#LWYxnJXoz&BK009tGjo&W?v2HKZqs+lvr1rPut9bZHM0wLFnw49iQbP`e<@;I-}tzy2fpWXKU1Bawz zo3EWJ>+tFFeM|4D%I)UYEDmISpF@^|`^1)rp)vh-+R=}QUQ5Otp;#4(YKWquNKBfR z!fDWJm7k1tkoYubKn;#6_2*(zz0a-Z)@x@tw)Tt5$WIDOmC{Ri+b#T8(3CDUU_eo3hP>LZpJ&2;&zhq^hHi zQOgVM2jVeGM0@JNY-QJ=Pd`;kyr3F8oSu6e)l}We&_{2(pM}IR!Z=m2$hwC5i;a2Y z{ou)F4)hG}y+8`6M(U|s~*c0A$ zvJeD1$gHQ|V=HWM{2+~rugb8{l(!p2r^@Y*7s3ttj>;Vu4#=d%kf^Sc^4+bQTP?@s z_3Pb)?;%`rpP2LUvZY!=Lhw`XSq-_SZy@H{9vn?{JqY#eI2Ac9nP5sX+6e~}7m`fa z6o=#M)Gmn)v^~9>+;w(^i2f(Z29@s+W$4{{BqA0pp=D}8 zM;XxWcmU#6FI*=LA62%OUM52oS>zSk#Sx>S$=bAy5$%w3AgCgwsgh!nW+R$HID$n+ z4?LS`Z>gK{sgEzutjwiv$ zJD{uF(MJOhT>?5Td*qb7m^Wy)exF88yEbM;o>o+;jH{9~#=&c^T~AQ3kVuuS%^*k_ zZ9yUyx^Z=Erur(Xq)G|-Z&RrcHNfVCKsDjkjZ>n;CS(9$F$7bj2>8{F1j}Rt9NQYq zwZ7@0wJ%os)rsj%z7@u+=(&r+r8}skL{O=(*ub})jP@;9-nsPQE{eQZq6Td0)nl|@ zPj)m_=hY&a$ULmU}0=m+X!3##k0bMO3*Op}Ex4S5TG2yHjfR6o!>fHN*&# oX1gqdV3260Wfd->=eT?T`^XB`u&|*3&L86LNT&)C7qmgfKt-7awEzGB diff --git a/SESSION.md b/SESSION.md index 1fa73679..835dc041 100644 --- a/SESSION.md +++ b/SESSION.md @@ -15,7 +15,7 @@ |rstudio |2025.05.0+496 Mariposa Orchid (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |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) | |commonmark |2.0.0 |2025-07-07 |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) | |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) | @@ -87,16 +88,19 @@ |foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | |foreign |0.8-90 |2025-03-31 |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) | |gdtools |0.4.2 |2025-03-27 |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) | |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) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |ggridges |0.5.6 |2024-01-23 |CRAN (R 4.4.0) | |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) | |gridExtra |2.3 |2017-09-09 |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) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) | |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) | |insight |1.3.1 |2025-06-30 |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) | |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | |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) | |testthat |3.2.3 |2025-01-13 |CRAN (R 4.4.1) | |textshaping |1.0.1 |2025-05-01 |CRAN (R 4.4.1) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 41ec0153..4ec133e7 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/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.7.3' ######## @@ -4026,7 +4026,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.7.3-250808' ######## diff --git a/man/align_axes.Rd b/man/align_axes.Rd index 01a43a3b..2a8ab279 100644 --- a/man/align_axes.Rd +++ b/man/align_axes.Rd @@ -4,7 +4,7 @@ \alias{align_axes} \title{Aligns axes between plots} \usage{ -align_axes(...) +align_axes(..., x.axis = TRUE, y.axis = TRUE) } \arguments{ \item{...}{ggplot2 objects or list of ggplot2 objects} From 46db0bd5e44d5f97b5491aeda3936d14b626dbc2 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:47:30 +0200 Subject: [PATCH 3/6] feat: even more arguments available when using wrap_plot_list --- R/data_plots.R | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/R/data_plots.R b/R/data_plots.R index 6347ff07..f5b0def3 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -738,7 +738,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 @@ -747,6 +750,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) { @@ -762,9 +768,9 @@ 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)) { @@ -784,13 +790,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 } @@ -801,7 +811,7 @@ wrap_plot_list <- function(data, #' @returns list of ggplot2 objects #' @export #' -align_axes <- function(...,x.axis=TRUE,y.axis=TRUE) { +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)) { @@ -819,13 +829,12 @@ align_axes <- function(...,x.axis=TRUE,y.axis=TRUE) { xr <- clean_common_axis(p, "x") suppressWarnings({ - p |> - purrr::map(p, \(.x){ + purrr::map(p, \(.x){ out <- .x - if (isTRUE(x.axis)){ + if (isTRUE(x.axis)) { out <- out + ggplot2::xlim(xr) } - if (isTRUE(y.axis)){ + if (isTRUE(y.axis)) { out <- out + ggplot2::ylim(yr) } out From ca65bca2f86ea09c459929d3e4822e1679e689a3 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:47:55 +0200 Subject: [PATCH 4/6] feat: suppress warnings when plotting violin plots --- R/plot_violin.R | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/R/plot_violin.R b/R/plot_violin.R index 02fbcf11..10ddd8ad 100644 --- a/R/plot_violin.R +++ b/R/plot_violin.R @@ -14,16 +14,19 @@ 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") } From 62b5d7a6682167b34e928b598053184b7c48b0ef Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:49:09 +0200 Subject: [PATCH 5/6] fefat: fixed Euler plotting without axis text --- R/plot_euler.R | 10 +++++----- R/plot_hbar.R | 1 + man/data-plots.Rd | 1 + man/plot_euler.Rd | 1 + man/wrap_plot_list.Rd | 11 ++++++++++- 5 files changed, 18 insertions(+), 6 deletions(-) diff --git a/R/plot_euler.R b/R/plot_euler.R index fc840495..e1e48aa8 100644 --- a/R/plot_euler.R +++ b/R/plot_euler.R @@ -76,6 +76,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)) { @@ -90,10 +91,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 @@ -123,8 +123,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(), diff --git a/R/plot_hbar.R b/R/plot_hbar.R index deac70c0..5e13a8e6 100644 --- a/R/plot_hbar.R +++ b/R/plot_hbar.R @@ -7,6 +7,7 @@ #' #' @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) diff --git a/man/data-plots.Rd b/man/data-plots.Rd index 9a612c1d..cf0cfff2 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -111,6 +111,7 @@ 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 = "cyl", ter="am") mtcars |> plot_hbars(pri = "carb", sec = NULL) mtcars |> default_parsing() |> diff --git a/man/plot_euler.Rd b/man/plot_euler.Rd index 2785047a..b4bc1b2d 100644 --- a/man/plot_euler.Rd +++ b/man/plot_euler.Rd @@ -31,4 +31,5 @@ data.frame( 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) } diff --git a/man/wrap_plot_list.Rd b/man/wrap_plot_list.Rd index bc291dfb..2a6e8d62 100644 --- a/man/wrap_plot_list.Rd +++ b/man/wrap_plot_list.Rd @@ -9,6 +9,9 @@ wrap_plot_list( tag_levels = NULL, title = NULL, axis.font.family = NULL, + guides = "collect", + axes = "collect", + axis_titles = "collect", ... ) } @@ -19,7 +22,13 @@ wrap_plot_list( \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{ list of ggplot2 objects From 7fceb96a839113e94d4c0ad612b686c36317957f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Fri, 8 Aug 2025 11:49:18 +0200 Subject: [PATCH 6/6] version bump --- DESCRIPTION | 2 +- NEWS.md | 7 ++++++- inst/apps/FreesearchR/app.R | 42 ++++++++++++++++++++++++------------- 3 files changed, 35 insertions(+), 16 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90d672ea..7276ef66 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.7.3 +Version: 25.8.1 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 04658d41..fa4f8232 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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 +# 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 - *FIX* refining hiding drop downs. All JavaScript is now in separate file. Coded with GAI help from claude.ai. diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 4ec133e7..8d19c831 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -2364,7 +2364,8 @@ wrap_plot_list <- function(data, patchwork::wrap_plots( guides = "collect", axes = "collect", - axis_titles = "collect" + axis_titles = "collect", + ... ) if (!is.null(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 #' @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 +2419,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 + }) }) } @@ -5029,7 +5039,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) { na.omit() |> plot_euler_single() }) - +# browser() # names(out) wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}")) # patchwork::wrap_plots(out, guides = "collect") @@ -5087,6 +5097,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 +5507,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") }