From 54ba126a8b95455509d4956c2f607fdd26057297 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 11:00:56 +0200 Subject: [PATCH 1/6] polish and move to new hosted address --- DESCRIPTION | 2 +- NEWS.md | 4 ++ R/app_version.R | 2 +- R/cut-variable-dates.R | 27 ++++++++-- R/sysdata.rda | Bin 2075 -> 2168 bytes README.md | 4 +- SESSION.md | 20 +++++--- inst/apps/FreesearchR/app.R | 47 ++++++++++++++---- .../shinyapps.io/agdamsbo/FreesearchR.dcf | 10 ++++ .../shinyapps.io/agdamsbo/freesearcheR.dcf | 2 +- inst/apps/FreesearchR/server.R | 16 ++++-- inst/apps/FreesearchR/ui.R | 2 +- inst/apps/FreesearchR/www/references.bib | 21 ++------ umami-page.html | 2 +- 14 files changed, 111 insertions(+), 48 deletions(-) create mode 100644 inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf diff --git a/DESCRIPTION b/DESCRIPTION index b3a06126..07d95898 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Browser Based Data Analysis -Version: 25.4.3 +Version: 25.4.4 Authors@R: person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")) diff --git a/NEWS.md b/NEWS.md index af77b755..69adfefd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# FreesearchR 25.4.4 + +Polishing and moved hosted app to new address to fully reflect name change: [https://agdamsbo.shinyapps.io/FreesearchR/](https://agdamsbo.shinyapps.io/FreesearchR/) + # FreesearchR 25.4.3 - *NEW*: Added a variables type filter to easily exclude unwanted types. This also includes having data type rather than data class in the summary table. Will evaluate. Types are a simpler, more practical version of the *R* data class to easy interpretation. diff --git a/R/app_version.R b/R/app_version.R index 1fbe1ecb..dd1a24fb 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'v25.4.3.250423' +app_version <- function()'v25.4.4.250424' diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index e18f6150..d3f95eb5 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -56,6 +56,7 @@ cut_var.hms <- function(x, breaks, ...) { #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") +#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W") cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { breaks_o <- breaks args <- list(...) @@ -126,7 +127,10 @@ cut_var.POSIXct <- cut_var.POSIXt #' @examples #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") -cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { +#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W") +cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) { + args <- list(...) + if ("format" %in% names(args)){ assertthat::assert_that(is.character(args$format)) out <- forcats::as_factor(format(x,format=args$format)) @@ -337,10 +341,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { variable <- req(input$variable) choices <- c( + # "fixed", # "quantile" ) - if ("hms" %in% class(data[[variable]])) { + if (any(c("hms","POSIXct") %in% class(data[[variable]]))) { choices <- c(choices, "hour") } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { choices <- c( @@ -348,6 +353,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { "day", "weekday", "week", + # "week_only", "month", "month_only", "quarter", @@ -372,6 +378,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ) } + choices <- unique(choices) + shinyWidgets::virtualSelectInput( inputId = session$ns("method"), label = i18n("Method:"), @@ -389,7 +397,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { req(input$n_breaks, input$method) if (input$method == "fixed") { req(input$fixed_brks) - if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { + if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = input$fixed_brks) list(var = f, brks = levels(f)) @@ -432,6 +440,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = "hour") list(var = f, brks = levels(f)) + # } else if (input$method %in% c("week_only")) { + # # As a proof of concept a single option to use "format" parameter + # # https://www.stat.berkeley.edu/~s133/dates.html + # f <- cut_var(data[[variable]], format = "%W") + # list(var = f, brks = levels(f)) } else { classInt::classIntervals( var = as.numeric(data[[variable]]), @@ -445,6 +458,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) + # plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) }) @@ -582,8 +596,13 @@ modal_cut_variable <- function(id, #' @importFrom graphics abline axis hist par plot.new plot.window -plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { +plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") { + if (is.vector(data)){ + x <- data + } else { x <- data[[column]] + + } x <- as.numeric(x) op <- par(mar = rep(1.5, 4)) on.exit(par(op)) diff --git a/R/sysdata.rda b/R/sysdata.rda index b9989b2e95b0cbe8d0189993fe14a9294bb7e72b..dc59c7af96bda7facb7e5704e083d03fc5ec030a 100644 GIT binary patch literal 2168 zcmV-;2#5DVT4*^jL0KkKS>J5gBLEXNf8hWBXaz!l|KNXXp1{BV|L{Nn0RRXA;0a$B zCmV->$TdkwqWkBfP*g&^H8BLyFwvkY6mr00D>q00000B|Rb}Q8tl~G|`|8fB*mh0002gplHx& zX`l@TfM^W>4FJdira;IdNTM-Q+f_W8G}A$%c$x%Zpa2B*Jv2thm}!bxz?x+lfWXqF zz3D^@aTE@&*12UxIX~?Jz$jY8GkAVmnwy#yIPlUFWk2uEWU7HYw0^=hkn*~6sbCSGQuQK? zh`on)00da#P!WR%XL5=Pt3Yy9%NS>eMF6tmqr1uiXFUaJpwUEvGEzZgXhytCy0f}I zIDHKGxt2*vt*s#W$ETYtW{Cg+YO!vrxD$?KCe^I4_=@nR8ME6K! zVDy()0rs;k&LYaUcL{8P85V}vy_HwZbmcWdK8G81F4;$r=Vxf*SD#I)zDL23&vVr| zD#;Yg6G7m?y=1ULLy9~so4P?0%N3eFK*2mg8G?kISS(1{k?hklpo`*AGazA>A|VAX z!QM==V+Gz7RcT^mE^+5MrecfqAu_Hr=T^2|O^&{<=k0tm*vEzPe)L^eVhXY%nWE;` z>RX>NfxQI)Ho;X0C<7qCkdTNdB#4DURY(7TD0H9*HrkYA;{-!%{NOu0@LiY!xNYp` z->h0*-AE{g4jE`1u!%}70wAEJA_`IZ+qf2(;u=kI*}KUlTSd8& z@q!9A!br(cG8vC8W#<_+tvs(SqvW@qAw< zHhVk;i8$bG`apw43C0N#W^p5ds>xoEIEI5H)D=yJ4I5&OY8*_~FE=?(dY8U*6;)*B zT)Q}lDU&i{+7aBDQ%S4J+!E%qOqF+c9ic7Mn>S>$H5}qCYU)h8io8sdSG^eyH;9-t zs<27&0!uStC4ljTQ#}6ytTB^q8FNy%^IsP)j3B?lC<`1wY$5mj&P`E znd612O2Wl3sU%3r-QZPSE+ELMUkH3hWw9J)Qb4Bk*s~z|Z&rol!U>=d5-1@7L!^~e z$tXMRhfS)q#)$ST(Zy}LxeJ$isw%1ytVwNHmaWJt43U&CBDs-d7-g1hg;6PKi<(p$ z)$P9ugJUwW)u0-P!UPDU!cZAv6h@i@p$hAD`Z_l%5M=fnY*DDP2?Zj%lv;x_MZEAc+9QO(0galES5^r9jE(W)uo^N~o=MXMuHx2%1OF z@ujqsAT0=1nvD@1CsjJq0HVKihe!xKLzfVtMKiI_HwehWBsF`?5J9Gdf1PiLRn}Un?y~h_Mj-(*6G{p-mlR??+``sKp z=FV(p9N`G6jiAG>OWb;p-t{Pi#86#jh+d^aNHz=)o^V7szMNmjXXFSV3x{`$8%_0y zqaHUDR^CO{E8Sgfp4oh1U=R=pS~yTbIiM&g4UyUbK|pN!L$5(Xt9)BmhYnks)+^!i z=^UIPbjd2O)&Aa@YTzI_^YZT)`6s}LhgZ)o!~T+qj4VJDR@wZ_B*;tQV@CP#{N&}u z-j7NW&(!r5#kx1v>IXAi@NUO$obZW@F2N^5sarWmr+)cKU3%B&ed+kzUHHq!iAZBN zpwwXX*q0Efs2wy$>gN^014kTWT>^}bo6aQ5Ek152D$;n;*C%w_K&ydUdc6|Fa{vo*;j3zb4!AJUn+h3+WqAoq<`mIPF7_;3Y?ffv~JQX2|Q zhx~9?U#6onLmdTvP#Iv{?M0G^oc zfUF2qTnXLyEArnwY#UYBU~(tV`dV|AsDdC_W_KCDux^hi@(6QWqT`hNt|<35cL-ej z`t!=V8Z*pd4a9i!f{a>kbhH+Wg$^;wCPUrR4fQb@idIHvq7J4!^(tdgt`qQC*Uo%! zw1g&Z;PX6Oun_X$aLkohxd8%!zrdpt3n4kT$gp7mi4A08&}XS2>Nm+d#%bLq1!aR5 zKsk^yNWIk>uXJ6|mFITOob+TUFu2`XCn4h1%o4{A%Ps{ObGU<>WH zXzl5_AmSCkkXOueWCv!Eo=e`+wd|f$CK8U@j=&TRh#1&aA;7NVUAL@gkhKjXxVo@{ zPl=fm?Y`UNHHF)EVvFO}?ba=5T4j5tG{*Zuk7hB|3*zB{JY0t9;^R$%Kr uD`NiGPlfSkF>AdGem790=yeyl+CM<`km$@X0}nJm@pmLsg$WJz&5|(NLG!Nw literal 2075 zcmV+$2;}!dT4*^jL0KkKSvW^pF#r-vf589$Xaz!l|KNXXp1{BV|L{No2m#;-{~NAF z$AQV@0niVh2htx{i1=!0pqULB0F6&X^c31t#Tq?88X5pJG#U?3YG6$e)Ws?6)YB%6 zih6+13?Kk#0D6I-YHWz8GzX{v0000000000Nu-ewquQpK8fX9;Pyhe`13&-)r9;vh zXvj1G0iXZ?003yvXaGc{(Noh=y(yDM)X)QHfW*iE27}ZMHj_gV*<*;B1rAskjQRmu z(GUxwAR4&niYF)P;=}|ju!bKm=O%_s1DqM$e;!UVnkMWL@=DMOLlJj+Y~7>5UQmt* z0w{E1HO+n5xT(RVkA}J&cvgP+ak~JX7W96zO;#7-;0>3{(PJ$}0Uw+G#M(wmRh1MH zNNR7gK%$x=9i7>Y6g#4*UFeg!Zd7J?Nci4t31MO#0f?g;8$s(B?bn_y`0en2JWzVG z55Yq#qKl*~D=jqX`;qxq9u=oxeR9{KTbD{CMrSf}ni9>3oC#`a!*%x# zIUS=Fjd461p13olxX!9lx=v^$C1bqo$VD*;7|Wxb3ZQ&9iNeH(2pErOY}= zP{k373QtK9DMU39&>1@zNrGU35)u-VnoNLrAZ~O0B?gBmBzLL78k^E@HFALwID?xl^o)zafD#@$OblYI_mZ?Tq`k~1I_&P>8U zp*VDC%+iOEa$y!`p@Ld!AVCyU4Iu6%DF6u&K@?*UE8Pc#XvSr$u48Tn`|jOh;%&0i zHMPMw>sh2u!Ph)*`t`hg>gww3?)L~C46#P4<>=kz@sd_%5~7>$aXqTYZFas!9NLpC{JsiRU zoVjF}hFjT9P1M;F(DCjufXJ{yY=uIu$o=6Y2X((z1nZS)j=JK8iAD4YiO*P9FNbY5&`;t(v=`Y05yEc zFKpyH$y-r%SnmpEV0{!3Jb@4a?k%z8Iv_*?@ zz^E;=LYgNCYiKZ(Y`(*4L@dZn{Whg9&OJNuc_Xq)`W=D#^Hv!@w9cTl=@u+~b~5>r zD<}`{7My7jt>b@7F;oOKO&BK9U6&`vq)~A=abr*3WCePoZT!X7QACpQ&E>&7ufJhv zM9@_v%&uBoqM?m9K~DkO4~+J64CGU6Ac!==n3dDtk5DXvk$KV_hT2ab^x5TYm=0!K zwUx6`D%-*9P-M~&nq6Aqw!4N4nd|NzJomZfN;je=sESf+XA2H_Zfz0787F#TQ{V#m z^vE4lV+XTM8k)B#Jh~;2%ys%0PloB=gZ^EfYYXwPVZ*o#6ovxeQt!k%b8oIz6S~$g zbkdw>uyw#P1)n$^Dy6D9Bpn$l_{5Ht?YyJ5dB`p4Ztgj*9+cv|#uhrgjw<6R)de+{ zyT!*5oEZ-v9UFa&QsI57W_uP{-J>p7j)nDGEItG3#?TgqH<2NpQg;uRX;@VeK;fAc zn$=W8u&igiXv=UMh#52_u+qXM+D?al-ridC7gs`2 zO0^x#qQJV79`)XWwfVKImwa{7?3@RDXrr+&=ITOwD%}ihV{K0ymn0sXY8rW4?8UJK z2^a=iUz=T4;JugRzDq>v#_N1Ev3_Op@_i*MwdK}vX$eG(OT{zd2ZckbY#hS6jfF!L zm!Dbc0F>lIX<-I975#X0yTw~o&e6EL=B>c437-91;;y&!?#Z9U-+u0eEs=z%HfL>1 zGuxDCwuuZ$1?+OJK-+Br;QaS3_fGrce%S0}%;z@)#Qx10isKTQ&jm(xu}50fQQ@Sb z=g3lvH&xj{gWUT{u{ut}I%e>h4eZ?Sg%v>r5|!q9yMl6`4@IiOws5TWW3*$FxpVjA z*`Pt#J!Z6Hof+UCw5o~je_SSF7+FDO)fwm~1yV)k(0ah`AYWRQ5~jKT7ji{7P>?uB FS}}SIyXpV{ diff --git a/README.md b/README.md index 87eb19c6..989d2ed4 100644 --- a/README.md +++ b/README.md @@ -4,12 +4,12 @@ [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429) [![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) -[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/freesearcheR/) +[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/) This package is the backbone of the ***FreesearchR***, a free and open-source browser based data exploration and analysis tool intended to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. -The ***FreesearchR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearcheR/). All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! +The ***FreesearchR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! ## Motivation diff --git a/SESSION.md b/SESSION.md index 674d463a..daccb88e 100644 --- a/SESSION.md +++ b/SESSION.md @@ -11,11 +11,11 @@ |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |Europe/Copenhagen | -|date |2025-04-23 | +|date |2025-04-24 | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.6.40 @ /usr/local/bin/quarto | -|FreesearchR |25.4.3.250423 | +|FreesearchR |25.4.4.250424 | -------------------------------------------------------------------------------- @@ -40,7 +40,7 @@ |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |cli |3.6.4 |2025-02-13 |CRAN (R 4.4.1) | -|clipr |0.8.0 |2022-02-22 |CRAN (R 4.4.1) | +|codetools |0.2-20 |2024-03-31 |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) | |correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | @@ -66,9 +66,11 @@ |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | |fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) | |forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | +|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | +|glmnet |4.1-8 |NA |NA | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | @@ -81,6 +83,7 @@ |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |insight |1.2.0 |2025-04-22 |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) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | @@ -90,7 +93,6 @@ |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | -|magick |2.8.6 |NA |NA | |magrittr |2.0.3 |2022-03-30 |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) | @@ -104,7 +106,6 @@ |nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | |openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) | |openxlsx2 |1.14 |2025-03-20 |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) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | @@ -112,7 +113,6 @@ |pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | |pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | |pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | -|pkgdown |2.1.1 |2024-09-17 |CRAN (R 4.4.1) | |pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | |profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | @@ -122,6 +122,7 @@ |purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | |quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | +|ragg |1.4.0 |2025-04-10 |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) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | @@ -130,6 +131,8 @@ |readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | |readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | |readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | +|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) | +|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) | |reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | |remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | |renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | @@ -144,11 +147,16 @@ |scales |1.3.0 |2023-11-28 |CRAN (R 4.4.0) | |see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) | |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) | +|shape |1.4.6.1 |NA |NA | |shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) | |shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | |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) | +|survival |3.8-3 |2024-12-17 |CRAN (R 4.4.1) | +|systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) | +|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) | |tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | |tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index b3606e63..33e02308 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -10,7 +10,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'v25.4.3.250423' +app_version <- function()'v25.4.4.250424' ######## @@ -556,6 +556,7 @@ cut_var.hms <- function(x, breaks, ...) { #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") +#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W") cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { breaks_o <- breaks args <- list(...) @@ -626,7 +627,10 @@ cut_var.POSIXct <- cut_var.POSIXt #' @examples #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") -cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { +#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W") +cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) { + args <- list(...) + if ("format" %in% names(args)){ assertthat::assert_that(is.character(args$format)) out <- forcats::as_factor(format(x,format=args$format)) @@ -837,10 +841,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { variable <- req(input$variable) choices <- c( + # "fixed", # "quantile" ) - if ("hms" %in% class(data[[variable]])) { + if (any(c("hms","POSIXct") %in% class(data[[variable]]))) { choices <- c(choices, "hour") } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { choices <- c( @@ -848,6 +853,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { "day", "weekday", "week", + # "week_only", "month", "month_only", "quarter", @@ -872,6 +878,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ) } + choices <- unique(choices) + shinyWidgets::virtualSelectInput( inputId = session$ns("method"), label = i18n("Method:"), @@ -889,7 +897,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { req(input$n_breaks, input$method) if (input$method == "fixed") { req(input$fixed_brks) - if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { + if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = input$fixed_brks) list(var = f, brks = levels(f)) @@ -932,6 +940,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = "hour") list(var = f, brks = levels(f)) + # } else if (input$method %in% c("week_only")) { + # # As a proof of concept a single option to use "format" parameter + # # https://www.stat.berkeley.edu/~s133/dates.html + # f <- cut_var(data[[variable]], format = "%W") + # list(var = f, brks = levels(f)) } else { classInt::classIntervals( var = as.numeric(data[[variable]]), @@ -945,6 +958,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) + # plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) }) @@ -1082,8 +1096,13 @@ modal_cut_variable <- function(id, #' @importFrom graphics abline axis hist par plot.new plot.window -plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { +plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") { + if (is.vector(data)){ + x <- data + } else { x <- data[[column]] + + } x <- as.numeric(x) op <- par(mar = rep(1.5, 4)) on.exit(par(op)) @@ -8739,7 +8758,7 @@ ui_elements <- list( shiny::tagList( lapply( paste0("code_", c( - "import", "data", "variables", "filter", "table1", "univariable", "multivariable" + "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable" )), \(.x)shiny::htmlOutput(outputId = .x) ) @@ -8861,7 +8880,8 @@ library(gtsummary) data(starwars) data(mtcars) -mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") +mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") +mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) data(trial) @@ -9018,8 +9038,11 @@ server <- function(input, output, session) { rv$data_original <- temp_data |> default_parsing() - rv$code$import_print <- list( - rv$code$import, + rv$code$import <- rv$code$import |> + expression_string(assign.str = "df <-") + + rv$code$format <- list( + "df", rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") ) |> @@ -9304,7 +9327,11 @@ server <- function(input, output, session) { # }) output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) + prismCodeBlock(paste0("#Data import\n", rv$code$import)) + }) + + output$code_import <- shiny::renderUI({ + prismCodeBlock(paste0("#Data import formatting\n", rv$code$format)) }) output$code_data <- shiny::renderUI({ diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf new file mode 100644 index 00000000..23eef6a3 --- /dev/null +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf @@ -0,0 +1,10 @@ +name: FreesearchR +title: +username: agdamsbo +account: agdamsbo +server: shinyapps.io +hostUrl: https://api.shinyapps.io/v1 +appId: 14600805 +bundleId: 10169595 +url: https://agdamsbo.shinyapps.io/FreesearchR/ +version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index f5bbfb79..dd1b9615 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 10164419 +bundleId: 10164589 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index 8f977371..ea8a2b74 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -32,7 +32,8 @@ library(gtsummary) data(starwars) data(mtcars) -mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") +mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") +mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) data(trial) @@ -189,8 +190,11 @@ server <- function(input, output, session) { rv$data_original <- temp_data |> default_parsing() - rv$code$import_print <- list( - rv$code$import, + rv$code$import <- rv$code$import |> + expression_string(assign.str = "df <-") + + rv$code$format <- list( + "df", rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") ) |> @@ -475,7 +479,11 @@ server <- function(input, output, session) { # }) output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) + prismCodeBlock(paste0("#Data import\n", rv$code$import)) + }) + + output$code_import <- shiny::renderUI({ + prismCodeBlock(paste0("#Data import formatting\n", rv$code$format)) }) output$code_data <- shiny::renderUI({ diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 8dac4454..ddb26818 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -462,7 +462,7 @@ ui_elements <- list( shiny::tagList( lapply( paste0("code_", c( - "import", "data", "variables", "filter", "table1", "univariable", "multivariable" + "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable" )), \(.x)shiny::htmlOutput(outputId = .x) ) diff --git a/inst/apps/FreesearchR/www/references.bib b/inst/apps/FreesearchR/www/references.bib index ca20ec82..ab4b8b80 100644 --- a/inst/apps/FreesearchR/www/references.bib +++ b/inst/apps/FreesearchR/www/references.bib @@ -1,24 +1,11 @@ @book{andreasgammelgaarddamsbo2025, - title = {agdamsbo/freesearcheR: freesearcheR 25.3.1}, - author = {Andreas Gammelgaard Damsbo, }, + title = {agdamsbo/FreesearchR: FreesearchR 25.4.3}, + author = {Damsbo, Andreas Gammelgaard}, year = {2025}, - month = {03}, - date = {2025-03-06}, + month = {04}, + date = {2025-04-24}, publisher = {Zenodo}, doi = {10.5281/ZENODO.14527429}, url = {https://zenodo.org/doi/10.5281/zenodo.14527429} } - -@article{Aam2020, - title = {Post-stroke Cognitive Impairment{\textemdash}Impact of Follow-Up Time and Stroke Subtype on Severity and Cognitive Profile: The Nor-COAST Study}, - author = {Aam, Stina and Einstad, Marte Stine and Munthe-Kaas, Ragnhild and Lydersen, Stian and Ihle-Hansen, Hege and Knapskog, Anne Brita and {Ellekjær}, Hanne and Seljeseth, Yngve and Saltvedt, Ingvild}, - year = {2020}, - date = {2020}, - journal = {Frontiers in Neurology}, - pages = {1--10}, - volume = {11}, - number = {July}, - doi = {10.3389/fneur.2020.00699}, - note = {Citation Key: Aam2020} -} diff --git a/umami-page.html b/umami-page.html index 57eeb5a2..1270d512 100644 --- a/umami-page.html +++ b/umami-page.html @@ -1 +1 @@ - + From e3017458dd4f86df9f676aec9044fb8e2a62cf3f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 11:09:21 +0200 Subject: [PATCH 2/6] revert version bump --- DESCRIPTION | 2 +- NEWS.md | 6 +- R/sysdata.rda | Bin 2168 -> 1179 bytes SESSION.md | 239 ++++++------------ .../shinyapps.io/agdamsbo/FreesearchR.dcf | 2 +- renv.lock | 2 +- 6 files changed, 77 insertions(+), 174 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 07d95898..b3a06126 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Browser Based Data Analysis -Version: 25.4.4 +Version: 25.4.3 Authors@R: person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")) diff --git a/NEWS.md b/NEWS.md index 69adfefd..3dd549ca 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,3 @@ -# FreesearchR 25.4.4 - -Polishing and moved hosted app to new address to fully reflect name change: [https://agdamsbo.shinyapps.io/FreesearchR/](https://agdamsbo.shinyapps.io/FreesearchR/) - # FreesearchR 25.4.3 - *NEW*: Added a variables type filter to easily exclude unwanted types. This also includes having data type rather than data class in the summary table. Will evaluate. Types are a simpler, more practical version of the *R* data class to easy interpretation. @@ -10,6 +6,8 @@ Polishing and moved hosted app to new address to fully reflect name change: [htt - *IMPROVED*: docs are updated and much more comprehensive. They will be continuously updated. +Polishing and moved hosted app to new address to fully reflect name change: [https://agdamsbo.shinyapps.io/FreesearchR/](https://agdamsbo.shinyapps.io/FreesearchR/) + # FreesearchR 25.4.2 Polished and simplified data import module including a much improved REDCap import module. diff --git a/R/sysdata.rda b/R/sysdata.rda index dc59c7af96bda7facb7e5704e083d03fc5ec030a..b35440132da75ef221b1e49c2e44d3af4c4876a2 100644 GIT binary patch literal 1179 zcmV;M1Z4X{T4*^jL0KkKS@HNuJOBsef5iX)Xaz!V|KM*aoz3RP#!&4w5Ls5p4RQ4cEO+8HphKz$i0C`4()FNdMN_mk`X{VI*gY``S&;g@H zAOHXW(-9FV;ZG^1Pg5bMsL%ia0001J2C1kT4GkItMuSWs001;-Fe5J|n4v6EcUtap% z05;+x>;eEm0VEg_5)efKL>h{spJ)Q>!9=#qqd&<}+4rAJHq_<7Q%=ugPqz$xTv!6? z)t-Yn1dx#kMPnFs>f2LjBnb&Jl3PTG*hO+^BT;0br4~3j1;d~el1c%&8zo_CmeV`7 zSQ#p?nJiJ4RW|s=H-LEISj<2&;{u?HMC8HR*MSf$uRy~wEKwB7m_@OJPR?Zu5Rn!^ zy8t2)HDy4Vsgz8q5~j$MM3HTw#vk5U;o#`)YX{sTAp=H%nF3WBt_|%Pe5Sp5rQ>+R z&xRJ=97qrafH~kLVpJTu*P_a$QDTTxfnyQ zn9j*4l_Vu9mpo+6uEXWkq#vk0(Ns)bI=n^n;QAEQ6HF7^(8tGo?K}$l$ z5LFW-ILflzJxETdxpI+1bU5)r(GgWW3DaNNd{!r;tp{U9pNP3S# z(_RmJXtWSypGnsiiMEQ=#zkFDI2^HCoGjyo1r~&D!>4l*mbNj)-kS`ATLX2hVFj~u zAlFrC4L$PM<(G>=;tiE^MDwW`QsLbsEQ>?J!54=3!)(*){>f%6zE|Z?VzAWHwxqpP z$TQb0?TUl$gbteqOcobE&Yc?W%q2|!Mvq_OMsi@pQFql%U)w#F_i>ccgN)tI>DMI#Rj}bG_L3iI}UTV{h t#OK{+0i2xkDRPuEs;cjrI7Uh{Bw9DmXlU--xLp5>xgwk>NO=4to&Y-N4*388 literal 2168 zcmV-;2#5DVT4*^jL0KkKS>J5gBLEXNf8hWBXaz!l|KNXXp1{BV|L{Nn0RRXA;0a$B zCmV->$TdkwqWkBfP*g&^H8BLyFwvkY6mr00D>q00000B|Rb}Q8tl~G|`|8fB*mh0002gplHx& zX`l@TfM^W>4FJdira;IdNTM-Q+f_W8G}A$%c$x%Zpa2B*Jv2thm}!bxz?x+lfWXqF zz3D^@aTE@&*12UxIX~?Jz$jY8GkAVmnwy#yIPlUFWk2uEWU7HYw0^=hkn*~6sbCSGQuQK? zh`on)00da#P!WR%XL5=Pt3Yy9%NS>eMF6tmqr1uiXFUaJpwUEvGEzZgXhytCy0f}I zIDHKGxt2*vt*s#W$ETYtW{Cg+YO!vrxD$?KCe^I4_=@nR8ME6K! zVDy()0rs;k&LYaUcL{8P85V}vy_HwZbmcWdK8G81F4;$r=Vxf*SD#I)zDL23&vVr| zD#;Yg6G7m?y=1ULLy9~so4P?0%N3eFK*2mg8G?kISS(1{k?hklpo`*AGazA>A|VAX z!QM==V+Gz7RcT^mE^+5MrecfqAu_Hr=T^2|O^&{<=k0tm*vEzPe)L^eVhXY%nWE;` z>RX>NfxQI)Ho;X0C<7qCkdTNdB#4DURY(7TD0H9*HrkYA;{-!%{NOu0@LiY!xNYp` z->h0*-AE{g4jE`1u!%}70wAEJA_`IZ+qf2(;u=kI*}KUlTSd8& z@q!9A!br(cG8vC8W#<_+tvs(SqvW@qAw< zHhVk;i8$bG`apw43C0N#W^p5ds>xoEIEI5H)D=yJ4I5&OY8*_~FE=?(dY8U*6;)*B zT)Q}lDU&i{+7aBDQ%S4J+!E%qOqF+c9ic7Mn>S>$H5}qCYU)h8io8sdSG^eyH;9-t zs<27&0!uStC4ljTQ#}6ytTB^q8FNy%^IsP)j3B?lC<`1wY$5mj&P`E znd612O2Wl3sU%3r-QZPSE+ELMUkH3hWw9J)Qb4Bk*s~z|Z&rol!U>=d5-1@7L!^~e z$tXMRhfS)q#)$ST(Zy}LxeJ$isw%1ytVwNHmaWJt43U&CBDs-d7-g1hg;6PKi<(p$ z)$P9ugJUwW)u0-P!UPDU!cZAv6h@i@p$hAD`Z_l%5M=fnY*DDP2?Zj%lv;x_MZEAc+9QO(0galES5^r9jE(W)uo^N~o=MXMuHx2%1OF z@ujqsAT0=1nvD@1CsjJq0HVKihe!xKLzfVtMKiI_HwehWBsF`?5J9Gdf1PiLRn}Un?y~h_Mj-(*6G{p-mlR??+``sKp z=FV(p9N`G6jiAG>OWb;p-t{Pi#86#jh+d^aNHz=)o^V7szMNmjXXFSV3x{`$8%_0y zqaHUDR^CO{E8Sgfp4oh1U=R=pS~yTbIiM&g4UyUbK|pN!L$5(Xt9)BmhYnks)+^!i z=^UIPbjd2O)&Aa@YTzI_^YZT)`6s}LhgZ)o!~T+qj4VJDR@wZ_B*;tQV@CP#{N&}u z-j7NW&(!r5#kx1v>IXAi@NUO$obZW@F2N^5sarWmr+)cKU3%B&ed+kzUHHq!iAZBN zpwwXX*q0Efs2wy$>gN^014kTWT>^}bo6aQ5Ek152D$;n;*C%w_K&ydUdc6|Fa{vo*;j3zb4!AJUn+h3+WqAoq<`mIPF7_;3Y?ffv~JQX2|Q zhx~9?U#6onLmdTvP#Iv{?M0G^oc zfUF2qTnXLyEArnwY#UYBU~(tV`dV|AsDdC_W_KCDux^hi@(6QWqT`hNt|<35cL-ej z`t!=V8Z*pd4a9i!f{a>kbhH+Wg$^;wCPUrR4fQb@idIHvq7J4!^(tdgt`qQC*Uo%! zw1g&Z;PX6Oun_X$aLkohxd8%!zrdpt3n4kT$gp7mi4A08&}XS2>Nm+d#%bLq1!aR5 zKsk^yNWIk>uXJ6|mFITOob+TUFu2`XCn4h1%o4{A%Ps{ObGU<>WH zXzl5_AmSCkkXOueWCv!Eo=e`+wd|f$CK8U@j=&TRh#1&aA;7NVUAL@gkhKjXxVo@{ zPl=fm?Y`UNHHF)EVvFO}?ba=5T4j5tG{*Zuk7hB|3*zB{JY0t9;^R$%Kr uD`NiGPlfSkF>AdGem790=yeyl+CM<`km$@X0}nJm@pmLsg$WJz&5|(NLG!Nw diff --git a/SESSION.md b/SESSION.md index daccb88e..46f2bfbd 100644 --- a/SESSION.md +++ b/SESSION.md @@ -1,175 +1,80 @@ -------------------------------------------------------------------------------- -------------------------------- R environment --------------------------------- -------------------------------------------------------------------------------- -|setting |value | -|:-----------|:------------------------------------------| -|version |R version 4.4.1 (2024-06-14) | -|os |macOS 15.3.1 | -|system |aarch64, darwin20 | -|ui |RStudio | -|language |(EN) | -|collate |en_US.UTF-8 | -|ctype |en_US.UTF-8 | -|tz |Europe/Copenhagen | -|date |2025-04-24 | -|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | -|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | -|quarto |1.6.40 @ /usr/local/bin/quarto | -|FreesearchR |25.4.4.250424 | +|setting |value | +|:-----------|:-------------------------------------| +|version |R version 4.4.1 (2024-06-14) | +|os |macOS 15.3.1 | +|system |aarch64, darwin20 | +|ui |RStudio | +|language |(EN) | +|collate |en_US.UTF-8 | +|ctype |en_US.UTF-8 | +|tz |Europe/Copenhagen | +|date |2025-04-24 | +|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | +|pandoc |3.6.4 @ /opt/homebrew/bin/pandoc | +|quarto |1.6.40 @ /usr/local/bin/quarto | +|FreesearchR |25.4.4.250424 | -------------------------------------------------------------------------------- ----------------------------------- packages ----------------------------------- -------------------------------------------------------------------------------- -|package |loadedversion |date |source | -|:-------------|:-------------|:----------|:--------------| -|apexcharter |0.4.4 |2024-09-06 |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) | -|backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) | -|bayestestR |0.15.2 |2025-02-07 |CRAN (R 4.4.1) | -|bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) | -|bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) | -|boot |1.3-31 |2024-08-28 |CRAN (R 4.4.1) | -|broom |1.0.8 |2025-03-28 |CRAN (R 4.4.1) | -|broom.helpers |1.20.0 |2025-03-06 |CRAN (R 4.4.1) | -|bsicons |0.1.2 |2023-11-04 |CRAN (R 4.4.0) | -|bslib |0.9.0 |2025-01-30 |CRAN (R 4.4.1) | -|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | -|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | -|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | -|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | -|cli |3.6.4 |2025-02-13 |CRAN (R 4.4.1) | -|codetools |0.2-20 |2024-03-31 |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) | -|correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | -|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | -|crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) | -|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) | -|datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) | -|datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) | -|desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) | -|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | -|DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) | -|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | -|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | -|DT |0.33 |2024-04-04 |CRAN (R 4.4.0) | -|e1071 |1.7-16 |2024-09-16 |CRAN (R 4.4.1) | -|easystats |0.7.4 |2025-02-06 |CRAN (R 4.4.1) | -|effectsize |1.0.0 |2024-12-10 |CRAN (R 4.4.1) | -|ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | -|esquisse |2.1.0 |2025-02-21 |CRAN (R 4.4.1) | -|evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | -|farver |2.1.2 |2024-05-13 |CRAN (R 4.4.1) | -|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | -|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) | -|forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | -|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | -|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | -|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | -|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | -|glmnet |4.1-8 |NA |NA | -|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | -|gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | -|gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | -|gtsummary |2.2.0 |2025-04-14 |CRAN (R 4.4.1) | -|haven |2.5.4 |2023-11-30 |CRAN (R 4.4.0) | -|here |1.0.1 |2020-12-13 |CRAN (R 4.4.1) | -|hms |1.1.3 |2023-03-21 |CRAN (R 4.4.0) | -|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) | -|IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | -|insight |1.2.0 |2025-04-22 |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) | -|jsonlite |2.0.0 |2025-03-27 |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) | -|knitr |1.50 |2025-03-16 |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) | -|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | -|lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | -|magrittr |2.0.3 |2022-03-30 |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) | -|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | -|mime |0.13 |2025-03-17 |CRAN (R 4.4.1) | -|miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) | -|minqa |1.2.8 |2024-08-17 |CRAN (R 4.4.1) | -|modelbased |0.10.0 |2025-03-10 |CRAN (R 4.4.1) | -|munsell |0.5.1 |2024-04-01 |CRAN (R 4.4.1) | -|nlme |3.1-168 |2025-03-31 |CRAN (R 4.4.1) | -|nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | -|openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) | -|openxlsx2 |1.14 |2025-03-20 |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) | -|performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | -|phosphoricons |0.2.1 |2024-04-08 |CRAN (R 4.4.0) | -|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | -|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | -|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | -|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | -|processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | -|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | -|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | -|proxy |0.4-27 |2022-06-09 |CRAN (R 4.4.1) | -|ps |1.9.1 |2025-04-12 |CRAN (R 4.4.1) | -|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | -|quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | -|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | -|ragg |1.4.0 |2025-04-10 |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) | -|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | -|Rdpack |2.6.4 |2025-04-09 |CRAN (R 4.4.1) | -|reactable |0.4.4 |2023-03-12 |CRAN (R 4.4.0) | -|readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | -|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | -|readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | -|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) | -|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) | -|reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | -|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | -|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | -|report |0.6.1 |2025-02-07 |CRAN (R 4.4.1) | -|rio |1.2.3 |2024-09-25 |CRAN (R 4.4.1) | -|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) | -|rmarkdown |2.29 |2024-11-04 |CRAN (R 4.4.1) | -|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) | -|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) | -|rstudioapi |0.17.1 |2024-10-22 |CRAN (R 4.4.1) | -|sass |0.4.10 |2025-04-11 |CRAN (R 4.4.1) | -|scales |1.3.0 |2023-11-28 |CRAN (R 4.4.0) | -|see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) | -|sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) | -|shape |1.4.6.1 |NA |NA | -|shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) | -|shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | -|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | -|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) | -|survival |3.8-3 |2024-12-17 |CRAN (R 4.4.1) | -|systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) | -|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) | -|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | -|tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | -|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | -|toastui |0.4.0 |2025-04-03 |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) | -|usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | -|vctrs |0.6.5 |2023-12-01 |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) | -|writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) | -|xfun |0.52 |2025-04-02 |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) | -|yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) | -|zip |2.3.2 |2025-02-01 |CRAN (R 4.4.1) | +|package |loadedversion |date |source | +|:-----------|:-------------|:----------|:--------------| +|bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) | +|bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) | +|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | +|cli |3.6.4 |2025-04-23 |CRAN (R 4.4.1) | +|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | +|desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) | +|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | +|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | +|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | +|ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | +|evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | +|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | +|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | +|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | +|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | +|here |1.0.1 |2020-12-13 |CRAN (R 4.4.1) | +|hms |1.1.3 |2023-03-21 |CRAN (R 4.4.0) | +|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) | +|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | +|later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) | +|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | +|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | +|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | +|mime |0.13 |2025-03-17 |CRAN (R 4.4.1) | +|miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) | +|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | +|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | +|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | +|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | +|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | +|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | +|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | +|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | +|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | +|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | +|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | +|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | +|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) | +|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) | +|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) | +|rstudioapi |0.17.1 |2024-10-22 |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) | +|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | +|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | +|tzdb |0.5.0 |2025-03-15 |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) | +|vctrs |0.6.5 |2023-12-01 |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) | +|xfun |0.52 |2025-04-02 |CRAN (R 4.4.1) | +|xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) | diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf index 23eef6a3..89e5ac2b 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 14600805 -bundleId: 10169595 +bundleId: 10169675 url: https://agdamsbo.shinyapps.io/FreesearchR/ version: 1 diff --git a/renv.lock b/renv.lock index 1a386741..5e58e951 100644 --- a/renv.lock +++ b/renv.lock @@ -1792,7 +1792,7 @@ }, "cli": { "Package": "cli", - "Version": "3.6.4", + "Version": "3.6.5", "Source": "Repository", "Title": "Helpers for Developing Command Line Interfaces", "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"gabor@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Kirill\", \"Müller\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", , \"salim-b@pm.me\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", From 6a43ba7b5bb015d4e2d90671980965af48bb07f9 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 12:53:37 +0200 Subject: [PATCH 3/6] internalised the create_column function from datamods for ui modifications - all variable icons are the same throughout now - added custom css --- R/create-column-mod.R | 443 +++++++++++++++++++++++++++ R/data-summary.R | 34 +- R/datagrid-infos-mod.R | 348 +++++++++++++++++++++ R/html_dependency_freesearchr.R | 9 + R/theme.R | 50 +-- examples/create_column_module_demo.R | 69 +++++ inst/apps/FreesearchR/www/style.css | 124 ++++++++ inst/assets/css/FreesearchR.css | 124 ++++++++ man/create-column.Rd | 76 +++++ man/cut_var.Rd | 4 +- man/get_var_icon.Rd | 23 ++ man/show_data.Rd | 41 +++ 12 files changed, 1322 insertions(+), 23 deletions(-) create mode 100644 R/create-column-mod.R create mode 100644 R/datagrid-infos-mod.R create mode 100644 R/html_dependency_freesearchr.R create mode 100644 examples/create_column_module_demo.R create mode 100644 inst/apps/FreesearchR/www/style.css create mode 100644 inst/assets/css/FreesearchR.css create mode 100644 man/create-column.Rd create mode 100644 man/get_var_icon.Rd create mode 100644 man/show_data.Rd diff --git a/R/create-column-mod.R b/R/create-column-mod.R new file mode 100644 index 00000000..f25dbdd8 --- /dev/null +++ b/R/create-column-mod.R @@ -0,0 +1,443 @@ +#' @title Create new column +#' +#' @description +#' This module allow to enter an expression to create a new column in a `data.frame`. +#' +#' +#' @param id Module's ID. +#' +#' @return A [shiny::reactive()] function returning the data. +#' +#' @note User can only use a subset of function: `r paste(list_allowed_operations(), collapse=", ")`. +#' You can add more operations using the `allowed_operations` argument, for example if you want to allow to use package lubridate, you can do: +#' ```r +#' c(list_allowed_operations(), getNamespaceExports("lubridate")) +#' ``` +#' +#' @export +#' +#' @importFrom htmltools tagList tags css +#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton +#' @importFrom phosphoricons ph +#' @importFrom shinyWidgets virtualSelectInput +#' +#' @name create-column +#' +#' @example example/create_column_module_demo.R +create_column_ui <- function(id) { + ns <- NS(id) + tagList( + # datamods:::html_dependency_datamods(), + # html_dependency_FreesearchR(), + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + ), + # tags$head( + # # Note the wrapping of the string in HTML() + # tags$style(HTML(" + # /* modified from esquisse for data types */ + # .btn-column-categorical { + # background-color: #EF562D; + # color: #FFFFFF; + # } + # .btn-column-continuous { + # background-color: #0C4C8A; + # color: #FFFFFF; + # } + # .btn-column-dichotomous { + # background-color: #97D5E0; + # color: #FFFFFF; + # } + # .btn-column-datetime { + # background-color: #97D5E0; + # color: #FFFFFF; + # } + # .btn-column-id { + # background-color: #848484; + # color: #FFFFFF; + # } + # .btn-column-text { + # background-color: #2E2E2E; + # color: #FFFFFF; + # }")) + # ), + fluidRow( + column( + width = 6, + textInput( + inputId = ns("new_column"), + label = i18n("New column name:"), + value = "new_column1", + width = "100%" + ) + ), + column( + width = 6, + shinyWidgets::virtualSelectInput( + inputId = ns("group_by"), + label = i18n("Group calculation by:"), + choices = NULL, + multiple = TRUE, + disableSelectAll = TRUE, + hasOptionDescription = TRUE, + width = "100%" + ) + ) + ), + textAreaInput( + inputId = ns("expression"), + label = i18n("Enter an expression to define new column:"), + value = "", + width = "100%", + rows = 6 + ), + tags$i( + class = "d-block", + phosphoricons::ph("info"), + datamods::i18n("Click on a column name to add it to the expression:") + ), + uiOutput(outputId = ns("columns")), + uiOutput(outputId = ns("feedback")), + tags$div( + style = css( + display = "grid", + gridTemplateColumns = "3fr 1fr", + columnGap = "10px", + margin = "10px 0" + ), + actionButton( + inputId = ns("compute"), + label = tagList( + phosphoricons::ph("gear"), i18n("Create column") + ), + class = "btn-outline-primary", + width = "100%" + ), + actionButton( + inputId = ns("remove"), + label = tagList( + phosphoricons::ph("trash") + ), + class = "btn-outline-danger", + width = "100%" + ) + ) + ) +} + +#' @param data_r A [shiny::reactive()] function returning a `data.frame`. +#' @param allowed_operations A `list` of allowed operations, see below for details. +#' +#' @export +#' +#' @rdname create-column +#' +#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req +#' updateTextAreaInput reactive bindEvent observe +#' @importFrom shinyWidgets alert updateVirtualSelect +create_column_server <- function(id, + data_r = reactive(NULL), + allowed_operations = list_allowed_operations()) { + moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + info_alert <- shinyWidgets::alert( + status = "info", + phosphoricons::ph("question"), + datamods::i18n("Choose a name for the column to be created or modified,"), + datamods::i18n("then enter an expression before clicking on the button above to validate or on "), + phosphoricons::ph("trash"), datamods::i18n("to delete it.") + ) + + rv <- reactiveValues( + data = NULL, + feedback = info_alert + ) + + observeEvent(input$hidden, rv$feedback <- info_alert) + + bindEvent(observe({ + data <- data_r() + shinyWidgets::updateVirtualSelect( + inputId = "group_by", + choices = make_choices_with_infos(data) + ) + }), data_r(), input$hidden) + + observeEvent(data_r(), rv$data <- data_r()) + + output$feedback <- renderUI(rv$feedback) + + output$columns <- renderUI({ + data <- req(rv$data) + mapply( + label = names(data), + data = data, + FUN = btn_column, + MoreArgs = list(inputId = ns("add_column")), + SIMPLIFY = FALSE + ) + }) + + observeEvent(input$add_column, { + updateTextAreaInput( + session = session, + inputId = "expression", + value = paste0(input$expression, input$add_column) + ) + }) + + observeEvent(input$new_column, { + if (input$new_column == "") { + rv$feedback <- shinyWidgets::alert( + status = "warning", + ph("warning"), datamods::i18n("New column name cannot be empty") + ) + } + }) + + observeEvent(input$remove, { + rv$data[[input$new_column]] <- NULL + }) + observeEvent(input$compute, { + rv$feedback <- try_compute_column( + expression = input$expression, + name = input$new_column, + rv = rv, + allowed_operations = allowed_operations, + by = input$group_by + ) + }) + + return(reactive(rv$data)) + } + ) +} + +#' @export +#' +#' @rdname create-column +# @importFrom methods getGroupMembers +list_allowed_operations <- function() { + c( + "(", "c", + # getGroupMembers("Arith"), + c("+", "-", "*", "^", "%%", "%/%", "/"), + # getGroupMembers("Compare"), + c("==", ">", "<", "!=", "<=", ">="), + # getGroupMembers("Logic"), + c("&", "|"), + # getGroupMembers("Math"), + c( + "abs", "sign", "sqrt", "ceiling", "floor", "trunc", "cummax", + "cummin", "cumprod", "cumsum", "exp", "expm1", "log", "log10", + "log2", "log1p", "cos", "cosh", "sin", "sinh", "tan", "tanh", + "acos", "acosh", "asin", "asinh", "atan", "atanh", "cospi", "sinpi", + "tanpi", "gamma", "lgamma", "digamma", "trigamma" + ), + # getGroupMembers("Math2"), + c("round", "signif"), + # getGroupMembers("Summary"), + c("max", "min", "range", "prod", "sum", "any", "all"), + "pmin", "pmax", "mean", + "paste", "paste0", "substr", "nchar", "trimws", + "gsub", "sub", "grepl", "ifelse", "length", + "as.numeric", "as.character", "as.integer", "as.Date", "as.POSIXct", + "as.factor", "factor" + ) +} + + +#' @inheritParams shiny::modalDialog +#' @export +#' +#' @importFrom shiny showModal modalDialog textInput +#' @importFrom htmltools tagList +#' +#' @rdname create-column +modal_create_column <- function(id, + title = i18n("Create a new column"), + easyClose = TRUE, + size = "l", + footer = NULL) { + ns <- NS(id) + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + create_column_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ), + easyClose = easyClose, + size = size, + footer = footer + )) +} + +#' @inheritParams shinyWidgets::WinBox +#' @export +#' +#' @importFrom shinyWidgets WinBox wbOptions wbControls +#' @importFrom htmltools tagList +#' @rdname create-column +winbox_create_column <- function(id, + title = i18n("Create a new column"), + options = shinyWidgets::wbOptions(), + controls = shinyWidgets::wbControls()) { + ns <- NS(id) + WinBox( + title = title, + ui = tagList( + create_column_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ) + ), + options = modifyList( + shinyWidgets::wbOptions(height = "550px", modal = TRUE), + options + ), + controls = controls, + auto_height = FALSE + ) +} + + +try_compute_column <- function(expression, + name, + rv, + allowed_operations, + by = NULL) { + parsed <- try(parse(text = expression, keep.source = FALSE), silent = TRUE) + if (inherits(parsed, "try-error")) { + return(datamods:::alert_error(attr(parsed, "condition")$message)) + } + funs <- unlist(c(extract_calls(parsed), lapply(parsed, extract_calls)), recursive = TRUE) + if (!are_allowed_operations(funs, allowed_operations)) { + return(datamods:::alert_error(datamods::i18n("Some operations are not allowed"))) + } + if (!isTruthy(by)) { + result <- try( + rlang::eval_tidy(rlang::parse_expr(expression), data = rv$data), + silent = TRUE + ) + } else { + result <- try( + { + dt <- as.data.table(rv$data) + new_col <- NULL + dt[, new_col := rlang::eval_tidy(rlang::parse_expr(expression), data = .SD), by = by] + dt$new_col + }, + silent = TRUE + ) + } + if (inherits(result, "try-error")) { + return(alert_error(attr(result, "condition")$message)) + } + adding_col <- try(rv$data[[name]] <- result, silent = TRUE) + if (inherits(adding_col, "try-error")) { + return(alert_error(attr(adding_col, "condition")$message)) + } + code <- if (!isTruthy(by)) { + rlang::call2("mutate", !!!rlang::set_names(list(rlang::parse_expr(expression)), name)) + } else { + rlang::call2( + "mutate", + !!!rlang::set_names(list(rlang::parse_expr(expression)), name), + !!!list(.by = rlang::expr(c(!!!rlang::syms(by)))) + ) + } + attr(rv$data, "code") <- Reduce( + f = function(x, y) rlang::expr(!!x %>% !!y), + x = c(attr(rv$data, "code"), code) + ) + shinyWidgets::alert( + status = "success", + ph("check"), datamods::i18n("Column added!") + ) +} + +are_allowed_operations <- function(x, allowed_operations) { + all( + x %in% allowed_operations + ) +} + + +extract_calls <- function(exp) { + if (is.call(exp)) { + return(list( + as.character(exp[[1L]]), + lapply(exp[-1L], extract_calls) + )) + } +} + +alert_error <- function(text) { + alert( + status = "danger", + ph("bug"), text + ) +} + + +btn_column <- function(label, data, inputId) { + icon <- get_var_icon(data, "class") + type <- data_type(data) + tags$button( + type = "button", + class = paste0("btn btn-column-", type), + style = css( + "--bs-btn-padding-y" = ".25rem", + "--bs-btn-padding-x" = ".5rem", + "--bs-btn-font-size" = ".75rem", + "margin-bottom" = "5px" + ), + if (!is.null(icon)) icon, + label, + onclick = sprintf( + "Shiny.setInputValue('%s', '%s', {priority: 'event'})", + inputId, label + ) + ) +} + +make_choices_with_infos <- function(data) { + lapply( + X = seq_along(data), + FUN = function(i) { + nm <- names(data)[i] + values <- data[[nm]] + icon <- get_var_icon(values, "class") + # icon <- if (inherits(values, "character")) { + # phosphoricons::ph("text-aa") + # } else if (inherits(values, "factor")) { + # phosphoricons::ph("list-bullets") + # } else if (inherits(values, c("numeric", "integer"))) { + # phosphoricons::ph("hash") + # } else if (inherits(values, c("Date"))) { + # phosphoricons::ph("calendar") + # } else if (inherits(values, c("POSIXt"))) { + # phosphoricons::ph("clock") + # } else { + # NULL + # } + description <- if (is.atomic(values)) { + paste(i18n("Unique values:"), data.table::uniqueN(values)) + } else { + "" + } + list( + label = htmltools::doRenderTags(tagList( + icon, nm + )), + value = nm, + description = description + ) + } + ) +} diff --git a/R/data-summary.R b/R/data-summary.R index f0e6be3f..ccb749bc 100644 --- a/R/data-summary.R +++ b/R/data-summary.R @@ -318,9 +318,9 @@ class_icons <- function(x) { shiny::icon("arrow-down-a-z") } else if (identical(x, "logical")) { shiny::icon("toggle-off") - } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { + } else if (any(c("Date", "POSIXt") %in% x)) { shiny::icon("calendar-days") - } else if ("hms" %in% x) { + } else if (any("POSIXct", "hms") %in% x) { shiny::icon("clock") } else { shiny::icon("table") @@ -360,3 +360,33 @@ type_icons <- function(x) { } } } + +#' Easily get variable icon based on data type or class +#' +#' @param data variable or data frame +#' @param class.type "type" or "class". Default is "class" +#' +#' @returns svg icon +#' @export +#' +#' @examples +#' mtcars[1] |> get_var_icon("class") +#' default_parsing(mtcars) |> get_var_icon() +get_var_icon <- function(data,class.type=c("class","type")){ + if (is.data.frame(data)){ + lapply(data,get_var_icon) + } else { + + class.type <- match.arg(class.type) + + switch(class.type, + type = { + type_icons(data_type(data)) + }, + class = { + class(data)[1] |> class_icons() + } + ) +} + +} diff --git a/R/datagrid-infos-mod.R b/R/datagrid-infos-mod.R new file mode 100644 index 00000000..6958e6be --- /dev/null +++ b/R/datagrid-infos-mod.R @@ -0,0 +1,348 @@ + +#' Display a table in a window +#' +#' @param data a data object (either a `matrix` or a `data.frame`). +#' @param title Title to be displayed in window. +#' @param show_classes Show variables classes under variables names in table header. +#' @param type Display table in a pop-up with [shinyWidgets::show_alert()], +#' in modal window with [shiny::showModal()] or in a WinBox window with [shinyWidgets::WinBox()]. +#' @param options Arguments passed to [toastui::datagrid()]. +#' @param width Width of the window, only used if `type = "popup"` or `type = "winbox"`. +#' @param ... Additional options, such as `wbOptions = wbOptions()` or `wbControls = wbControls()`. +#' +#' @note +#' If you use `type = "winbox"`, you'll need to use `shinyWidgets::html_dependency_winbox()` somewhere in your UI. +#' +#' @return No value. +#' @export +#' +#' @importFrom htmltools tags tagList css +#' @importFrom shiny showModal modalDialog +#' @importFrom utils modifyList packageVersion +#' +#' @example examples/show_data.R +show_data <- function(data, + title = NULL, + options = NULL, + show_classes = TRUE, + type = c("popup", "modal", "winbox"), + width = "65%", + ...) { # nocov start + type <- match.arg(type) + data <- as.data.frame(data) + args <- list(...) + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + if (is.null(options)) + options <- list() + + options$height <- 550 + options$minBodyHeight <- 400 + options$data <- data + options$theme <- "default" + options$colwidths <- "guess" + options$guess_colwidths_opts <- list(min_width = 90, max_width = 400, mul = 1, add = 10) + if (isTRUE(show_classes)) + options$summary <- construct_col_summary(data) + datatable <- rlang::exec(toastui::datagrid, !!!options) + datatable <- toastui::grid_columns(datatable, className = "font-monospace") + if (identical(type, "winbox")) { + stopifnot( + "You need shinyWidgets >= 0.8.4" = packageVersion("shinyWidgets") >= "0.8.4" + ) + wb_options <- if (is.null(args$wbOptions)) { + shinyWidgets::wbOptions( + height = "600px", + width = width, + modal = TRUE + ) + } else { + modifyList( + shinyWidgets::wbOptions( + height = "600px", + width = width, + modal = TRUE + ), + args$wbOptions + ) + } + wb_controls <- if (is.null(args$wbControls)) { + shinyWidgets::wbControls() + } else { + args$wbControls + } + shinyWidgets::WinBox( + title = title, + ui = datatable, + options = wb_options, + controls = wb_controls, + padding = "0 5px" + ) + } else if (identical(type, "popup")) { + shinyWidgets::show_alert( + title = NULL, + text = tags$div( + if (!is.null(title)) { + tagList( + tags$h3(title), + tags$hr() + ) + }, + style = "color: #000 !important;", + datatable + ), + closeOnClickOutside = TRUE, + showCloseButton = TRUE, + btn_labels = NA, + html = TRUE, + width = width + ) + } else { + showModal(modalDialog( + title = tagList( + datamods:::button_close_modal(), + title + ), + tags$div( + style = css(minHeight = validateCssUnit(options$height)), + toastui::renderDatagrid2(datatable) + ), + size = "xl", + footer = NULL, + easyClose = TRUE + )) + } +} # nocov end + + + +#' @importFrom htmltools tagList tags css +describe_col_char <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("text-aa"), + "character" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Unique:"), length(unique(x)) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + style = css(whiteSpace = "normal", wordBreak = "break-all"), + i18n("Most Common:"), gsub( + pattern = "'", + replacement = "\u07F4", + x = names(sort(table(x), decreasing = TRUE))[1] + ) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +fmt_p <- function(val, tot) { + paste0(round(val / tot * 100, 1), "%") +} + +describe_col_factor <- function(x, with_summary = TRUE) { + count <- sort(table(x, useNA = "always"), decreasing = TRUE) + total <- sum(count) + one <- count[!is.na(names(count))][1] + two <- count[!is.na(names(count))][2] + missing <- count[is.na(names(count))] + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("list-bullets"), + "factor" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + names(one), ":", fmt_p(one, total) + ), + tags$div( + names(two), ":", fmt_p(two, total) + ), + tags$div( + "Missing", ":", fmt_p(missing, total) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +describe_col_num <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("hash"), + "numeric" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), round(min(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Mean:"), round(mean(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Max:"), round(max(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ) + ) + } + ) +} + + +describe_col_date <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("calendar"), + "date" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), min(x, na.rm = TRUE) + ), + tags$div( + i18n("Max:"), max(x, na.rm = TRUE) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +describe_col_datetime <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("clock"), + "datetime" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), min(x, na.rm = TRUE) + ), + tags$div( + i18n("Max:"), max(x, na.rm = TRUE) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + + +describe_col_other <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("clock"), + paste(class(x), collapse = ", ") + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Unique:"), length(unique(x)) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +construct_col_summary <- function(data) { + list( + position = "top", + height = 90, + columnContent = lapply( + X = setNames(names(data), names(data)), + FUN = function(col) { + values <- data[[col]] + content <- if (inherits(values, "character")) { + describe_col_char(values) + } else if (inherits(values, "factor")) { + describe_col_factor(values) + } else if (inherits(values, c("numeric", "integer"))) { + describe_col_num(values) + } else if (inherits(values, c("Date"))) { + describe_col_date(values) + } else if (inherits(values, c("POSIXt"))) { + describe_col_datetime(values) + } else { + describe_col_other(values) + } + list( + template = toastui::JS( + "function(value) {", + sprintf( + "return '%s';", + gsub(replacement = "", pattern = "\n", x = htmltools::doRenderTags(content)) + ), + "}" + ) + ) + } + ) + ) +} diff --git a/R/html_dependency_freesearchr.R b/R/html_dependency_freesearchr.R new file mode 100644 index 00000000..bf46e471 --- /dev/null +++ b/R/html_dependency_freesearchr.R @@ -0,0 +1,9 @@ +html_dependency_FreesearchR <- function() { + htmltools::htmlDependency( + name = "FreesearchR", + version = packageVersion("FreesearchR"), + src = list(href = "FreesearchR", file = "assets"), + package = "FreesearchR", + stylesheet = "css/FreesearchR.css" + ) +} diff --git a/R/theme.R b/R/theme.R index 15fc5f4b..29e0c33f 100644 --- a/R/theme.R +++ b/R/theme.R @@ -10,7 +10,7 @@ custom_theme <- function(..., secondary = "#FF6F61", bootswatch = "united", base_font = bslib::font_google("Montserrat"), - heading_font = bslib::font_google("Public Sans",wght = "700"), + heading_font = bslib::font_google("Public Sans", wght = "700"), code_font = bslib::font_google("Open Sans") # success = "#1E4A8F", # info = , @@ -22,7 +22,7 @@ custom_theme <- function(..., # heading_font = bslib::font_google("Jost", wght = "800"), # heading_font = bslib::font_google("Noto Serif"), # heading_font = bslib::font_google("Alice"), - ){ +) { bslib::bs_theme( ..., "navbar-bg" = primary, @@ -36,6 +36,16 @@ custom_theme <- function(..., ) } +compliment_colors <- function() { + c( + "#00C896", + "#FFB100", + "#8A4FFF", + "#11A0EC" + ) +} + + #' GGplot default theme for plotting in Shiny #' @@ -44,16 +54,16 @@ custom_theme <- function(..., #' @returns ggplot object #' @export #' -gg_theme_shiny <- function(){ - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text = ggplot2::element_text(size = 14), - strip.text = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24), - plot.subtitle = ggplot2::element_text(size = 18) - ) +gg_theme_shiny <- function() { + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text = ggplot2::element_text(size = 14), + strip.text = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24), + plot.subtitle = ggplot2::element_text(size = 18) + ) } @@ -64,12 +74,12 @@ gg_theme_shiny <- function(){ #' @returns ggplot object #' @export #' -gg_theme_export <- function(){ - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text.x = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24) - ) +gg_theme_export <- function() { + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text.x = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24) + ) } diff --git a/examples/create_column_module_demo.R b/examples/create_column_module_demo.R new file mode 100644 index 00000000..6c96ec48 --- /dev/null +++ b/examples/create_column_module_demo.R @@ -0,0 +1,69 @@ + +library(shiny) +library(reactable) + +ui <- fluidPage( + theme = bslib::bs_theme(version = 5L, preset = "bootstrap"), + shinyWidgets::html_dependency_winbox(), + tags$h2("Create new column"), + fluidRow( + column( + width = 4, + create_column_ui("inline"), + actionButton("modal", "Or click here to open a modal to create a column"), + tags$br(), tags$br(), + actionButton("winbox", "Or click here to open a WinBox to create a column") + ), + column( + width = 8, + reactableOutput(outputId = "table"), + verbatimTextOutput("code") + ) + ) +) + +server <- function(input, output, session) { + + rv <- reactiveValues(data = MASS::Cars93[, c(1, 3, 4, 5, 6, 10)]) + + # inline mode + data_inline_r <- create_column_server( + id = "inline", + data_r = reactive(rv$data) + ) + observeEvent(data_inline_r(), rv$data <- data_inline_r()) + + # modal window mode + observeEvent(input$modal, modal_create_column("modal")) + data_modal_r <- create_column_server( + id = "modal", + data_r = reactive(rv$data) + ) + observeEvent(data_modal_r(), rv$data <- data_modal_r()) + + # WinBox window mode + observeEvent(input$winbox, winbox_create_column("winbox")) + data_winbox_r <- create_column_server( + id = "winbox", + data_r = reactive(rv$data) + ) + observeEvent(data_winbox_r(), rv$data <- data_winbox_r()) + + # Show result + output$table <- renderReactable({ + data <- req(rv$data) + reactable( + data = data, + bordered = TRUE, + compact = TRUE, + striped = TRUE + ) + }) + + output$code <- renderPrint({ + attr(rv$data, "code") + }) +} + +if (interactive()) + shinyApp(ui, server) diff --git a/inst/apps/FreesearchR/www/style.css b/inst/apps/FreesearchR/www/style.css new file mode 100644 index 00000000..f84cc325 --- /dev/null +++ b/inst/apps/FreesearchR/www/style.css @@ -0,0 +1,124 @@ + +/*! + * Copyright (c) 2025 FreesearchR + * + * FreesearchR, CSS styles + * https://github.com/agdamsbo/FreesearchR + * + * @version 0.0.1 + */ + +.container-fluid > .nav > li > + a[data-value='FreesearchR'] {font-size: 28px} + +/* from datamods */ +.show-block { + display: block !important; +} +.show-inline { + display: inline !important; +} +.hidden { + display: none !important; +} +.invisible { + visibility: hidden; +} + +.container-rule { + position: relative; + text-align: center; + height: 25px; + margin-bottom: 5px; +} + +.horizontal-rule { + position: absolute; + top: 11px; + right: 0; + left: 0; + background-color: #d0cfcf; + height: 1px; + z-index: 100; + margin: 0; + border: none; +} + +.label-rule { + background: #FFF; + opacity: 1; + z-index: 101; + background-color: #FFF; + position: relative; + padding: 0 10px 0 10px; +} + +.datamods-table-container { + overflow: auto; + word-break: keep-all; + white-space: nowrap; +} + +.datamods-table-container > .table { + margin-bottom: 0 !important; +} + +.datamods-file-import { + display: grid; + grid-template-columns: auto 50px; + grid-column-gap: 10px; +} + +.datamods-dt-nowrap { + word-break: keep-all; + white-space: nowrap; +} + + + +/* validation */ +.datamods-validation-results { + display: grid; + grid-template-columns: repeat(3, 1fr); + grid-template-rows: 1fr; + height: 50px; + line-height: 50px; + font-size: large; +} + +.datamods-validation-summary { + font-weight: bold; + text-align: center; +} + +.datamods-validation-item { + font-size: larger; +} + + + +/* modified from esquisse for data types */ +.btn-column-categorical { + background-color: #00C896; + color: #FFFFFF; +} +.btn-column-continuous { + background-color: #FFB100; + color: #FFFFFF; +} +.btn-column-dichotomous { + background-color: #8A4FFF; + color: #FFFFFF; +} +.btn-column-datetime { + background-color: #11A0EC; + color: #FFFFFF; +} +.btn-column-id { + background-color: #848484; + color: #FFFFFF; +} +.btn-column-text { + background-color: #2E2E2E; + color: #FFFFFF; +} diff --git a/inst/assets/css/FreesearchR.css b/inst/assets/css/FreesearchR.css new file mode 100644 index 00000000..f84cc325 --- /dev/null +++ b/inst/assets/css/FreesearchR.css @@ -0,0 +1,124 @@ + +/*! + * Copyright (c) 2025 FreesearchR + * + * FreesearchR, CSS styles + * https://github.com/agdamsbo/FreesearchR + * + * @version 0.0.1 + */ + +.container-fluid > .nav > li > + a[data-value='FreesearchR'] {font-size: 28px} + +/* from datamods */ +.show-block { + display: block !important; +} +.show-inline { + display: inline !important; +} +.hidden { + display: none !important; +} +.invisible { + visibility: hidden; +} + +.container-rule { + position: relative; + text-align: center; + height: 25px; + margin-bottom: 5px; +} + +.horizontal-rule { + position: absolute; + top: 11px; + right: 0; + left: 0; + background-color: #d0cfcf; + height: 1px; + z-index: 100; + margin: 0; + border: none; +} + +.label-rule { + background: #FFF; + opacity: 1; + z-index: 101; + background-color: #FFF; + position: relative; + padding: 0 10px 0 10px; +} + +.datamods-table-container { + overflow: auto; + word-break: keep-all; + white-space: nowrap; +} + +.datamods-table-container > .table { + margin-bottom: 0 !important; +} + +.datamods-file-import { + display: grid; + grid-template-columns: auto 50px; + grid-column-gap: 10px; +} + +.datamods-dt-nowrap { + word-break: keep-all; + white-space: nowrap; +} + + + +/* validation */ +.datamods-validation-results { + display: grid; + grid-template-columns: repeat(3, 1fr); + grid-template-rows: 1fr; + height: 50px; + line-height: 50px; + font-size: large; +} + +.datamods-validation-summary { + font-weight: bold; + text-align: center; +} + +.datamods-validation-item { + font-size: larger; +} + + + +/* modified from esquisse for data types */ +.btn-column-categorical { + background-color: #00C896; + color: #FFFFFF; +} +.btn-column-continuous { + background-color: #FFB100; + color: #FFFFFF; +} +.btn-column-dichotomous { + background-color: #8A4FFF; + color: #FFFFFF; +} +.btn-column-datetime { + background-color: #11A0EC; + color: #FFFFFF; +} +.btn-column-id { + background-color: #848484; + color: #FFFFFF; +} +.btn-column-text { + background-color: #2E2E2E; + color: #FFFFFF; +} diff --git a/man/create-column.Rd b/man/create-column.Rd new file mode 100644 index 00000000..452cb3d4 --- /dev/null +++ b/man/create-column.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create-column-mod.R +\name{create-column} +\alias{create-column} +\alias{create_column_ui} +\alias{create_column_server} +\alias{list_allowed_operations} +\alias{modal_create_column} +\alias{winbox_create_column} +\title{Create new column} +\usage{ +create_column_ui(id) + +create_column_server( + id, + data_r = reactive(NULL), + allowed_operations = list_allowed_operations() +) + +list_allowed_operations() + +modal_create_column( + id, + title = i18n("Create a new column"), + easyClose = TRUE, + size = "l", + footer = NULL +) + +winbox_create_column( + id, + title = i18n("Create a new column"), + options = shinyWidgets::wbOptions(), + controls = shinyWidgets::wbControls() +) +} +\arguments{ +\item{id}{Module's ID.} + +\item{data_r}{A \code{\link[shiny:reactive]{shiny::reactive()}} function returning a \code{data.frame}.} + +\item{allowed_operations}{A \code{list} of allowed operations, see below for details.} + +\item{title}{An optional title for the dialog.} + +\item{easyClose}{If \code{TRUE}, the modal dialog can be dismissed by +clicking outside the dialog box, or be pressing the Escape key. If +\code{FALSE} (the default), the modal dialog can't be dismissed in those +ways; instead it must be dismissed by clicking on a \code{modalButton()}, or +from a call to \code{\link[shiny:removeModal]{removeModal()}} on the server.} + +\item{size}{One of \code{"s"} for small, \code{"m"} (the default) for medium, +\code{"l"} for large, or \code{"xl"} for extra large. Note that \code{"xl"} only +works with Bootstrap 4 and above (to opt-in to Bootstrap 4+, +pass \code{\link[bslib:bs_theme]{bslib::bs_theme()}} to the \code{theme} argument of a page container +like \code{\link[shiny:fluidPage]{fluidPage()}}).} + +\item{footer}{UI for footer. Use \code{NULL} for no footer.} + +\item{options}{List of options, see \code{\link[shinyWidgets:wbOptions]{wbOptions()}}.} + +\item{controls}{List of controls, see \code{\link[shinyWidgets:wbControls]{wbControls()}}.} +} +\value{ +A \code{\link[shiny:reactive]{shiny::reactive()}} function returning the data. +} +\description{ +This module allow to enter an expression to create a new column in a \code{data.frame}. +} +\note{ +User can only use a subset of function: (, c, +, -, *, ^, \%\%, \%/\%, /, ==, >, <, !=, <=, >=, &, |, abs, sign, sqrt, ceiling, floor, trunc, cummax, cummin, cumprod, cumsum, exp, expm1, log, log10, log2, log1p, cos, cosh, sin, sinh, tan, tanh, acos, acosh, asin, asinh, atan, atanh, cospi, sinpi, tanpi, gamma, lgamma, digamma, trigamma, round, signif, max, min, range, prod, sum, any, all, pmin, pmax, mean, paste, paste0, substr, nchar, trimws, gsub, sub, grepl, ifelse, length, as.numeric, as.character, as.integer, as.Date, as.POSIXct, as.factor, factor. +You can add more operations using the \code{allowed_operations} argument, for example if you want to allow to use package lubridate, you can do: + +\if{html}{\out{
}}\preformatted{c(list_allowed_operations(), getNamespaceExports("lubridate")) +}\if{html}{\out{
}} +} diff --git a/man/cut_var.Rd b/man/cut_var.Rd index e753ccd5..c3226a6a 100644 --- a/man/cut_var.Rd +++ b/man/cut_var.Rd @@ -33,7 +33,7 @@ cut_var(x, ...) ... ) -\method{cut_var}{Date}(x, breaks, start.on.monday = TRUE, ...) +\method{cut_var}{Date}(x, breaks = NULL, start.on.monday = TRUE, ...) } \arguments{ \item{x}{an object inheriting from class "POSIXct"} @@ -58,6 +58,8 @@ readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-0 readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "\%A-\%H") +readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "\%W") as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") +as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "\%W") } diff --git a/man/get_var_icon.Rd b/man/get_var_icon.Rd new file mode 100644 index 00000000..c299ccfd --- /dev/null +++ b/man/get_var_icon.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-summary.R +\name{get_var_icon} +\alias{get_var_icon} +\title{Easily get variable icon based on data type or class} +\usage{ +get_var_icon(data, class.type = c("class", "type")) +} +\arguments{ +\item{data}{variable or data frame} + +\item{class.type}{"type" or "class". Default is "class"} +} +\value{ +svg icon +} +\description{ +Easily get variable icon based on data type or class +} +\examples{ +mtcars[1] |> get_var_icon("class") +default_parsing(mtcars) |> get_var_icon() +} diff --git a/man/show_data.Rd b/man/show_data.Rd new file mode 100644 index 00000000..de11852b --- /dev/null +++ b/man/show_data.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/datagrid-infos-mod.R +\name{show_data} +\alias{show_data} +\title{Display a table in a window} +\usage{ +show_data( + data, + title = NULL, + options = NULL, + show_classes = TRUE, + type = c("popup", "modal", "winbox"), + width = "65\%", + ... +) +} +\arguments{ +\item{data}{a data object (either a \code{matrix} or a \code{data.frame}).} + +\item{title}{Title to be displayed in window.} + +\item{options}{Arguments passed to \code{\link[toastui:datagrid]{toastui::datagrid()}}.} + +\item{show_classes}{Show variables classes under variables names in table header.} + +\item{type}{Display table in a pop-up with \code{\link[shinyWidgets:sweetalert]{shinyWidgets::show_alert()}}, +in modal window with \code{\link[shiny:showModal]{shiny::showModal()}} or in a WinBox window with \code{\link[shinyWidgets:WinBox]{shinyWidgets::WinBox()}}.} + +\item{width}{Width of the window, only used if \code{type = "popup"} or \code{type = "winbox"}.} + +\item{...}{Additional options, such as \code{wbOptions = wbOptions()} or \code{wbControls = wbControls()}.} +} +\value{ +No value. +} +\description{ +Display a table in a window +} +\note{ +If you use \code{type = "winbox"}, you'll need to use \code{shinyWidgets::html_dependency_winbox()} somewhere in your UI. +} From ab780591b18ac5509df1b0be383d61e383a75c95 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 12:53:47 +0200 Subject: [PATCH 4/6] pub --- NAMESPACE | 13 + R/app_version.R | 2 +- R/sysdata.rda | Bin 1179 -> 2057 bytes SESSION.md | 230 +++-- inst/apps/FreesearchR/app.R | 928 +++++++++++++++++- .../shinyapps.io/agdamsbo/FreesearchR.dcf | 2 +- inst/apps/FreesearchR/server.R | 12 +- inst/apps/FreesearchR/ui.R | 12 +- 8 files changed, 1072 insertions(+), 127 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f644c440..186ab21a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,8 @@ export(clean_sep) export(columnSelectInput) export(contrast_text) export(create_baseline) +export(create_column_server) +export(create_column_ui) export(create_log_tics) export(create_overview_datagrid) export(create_plot) @@ -45,6 +47,7 @@ export(format_writer) export(get_fun_options) export(get_label) export(get_plot_options) +export(get_var_icon) export(getfun) export(gg_theme_export) export(gg_theme_shiny) @@ -67,11 +70,13 @@ export(is_valid_token) export(launch_FreesearchR) export(limit_log) export(line_break) +export(list_allowed_operations) export(m_redcap_readServer) export(m_redcap_readUI) export(merge_expression) export(merge_long) export(missing_fraction) +export(modal_create_column) export(modal_cut_variable) export(modal_update_factor) export(modify_qmd) @@ -102,6 +107,7 @@ export(repeated_instruments) export(sankey_ready) export(selectInputIcon) export(set_column_label) +export(show_data) export(sort_by) export(specify_qmd_format) export(subset_types) @@ -117,6 +123,7 @@ export(update_variables_ui) export(vectorSelectInput) export(vertical_stacked_bars) export(wide2long) +export(winbox_create_column) export(winbox_update_factor) export(wrap_plot_list) export(write_quarto) @@ -134,6 +141,7 @@ importFrom(htmltools,css) importFrom(htmltools,tagList) importFrom(htmltools,tags) importFrom(htmltools,validateCssUnit) +importFrom(phosphoricons,ph) importFrom(rlang,"%||%") importFrom(rlang,call2) importFrom(rlang,expr) @@ -152,20 +160,25 @@ importFrom(shiny,isTruthy) importFrom(shiny,modalDialog) importFrom(shiny,moduleServer) importFrom(shiny,numericInput) +importFrom(shiny,observe) importFrom(shiny,observeEvent) importFrom(shiny,plotOutput) importFrom(shiny,reactive) importFrom(shiny,reactiveValues) importFrom(shiny,renderPlot) +importFrom(shiny,renderUI) importFrom(shiny,req) importFrom(shiny,restoreInput) importFrom(shiny,selectizeInput) importFrom(shiny,showModal) importFrom(shiny,tagList) +importFrom(shiny,textAreaInput) importFrom(shiny,textInput) importFrom(shiny,uiOutput) importFrom(shiny,updateActionButton) +importFrom(shiny,updateTextAreaInput) importFrom(shinyWidgets,WinBox) +importFrom(shinyWidgets,alert) importFrom(shinyWidgets,noUiSliderInput) importFrom(shinyWidgets,prettyCheckbox) importFrom(shinyWidgets,updateVirtualSelect) diff --git a/R/app_version.R b/R/app_version.R index dd1a24fb..c99b8062 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'v25.4.4.250424' +app_version <- function()'v25.4.3.250424' diff --git a/R/sysdata.rda b/R/sysdata.rda index b35440132da75ef221b1e49c2e44d3af4c4876a2..953abdafe040167a1038ed0537a0b5b139c9c25f 100644 GIT binary patch literal 2057 zcmV+k2=@0vT4*^jL0KkKS=#vc3;+@*|G@wMXaz!l|KNXXp1{BV|L{Nr2m#;--!0j( zxbSctoeBYc-$fNbszXyCOq0__NrW^eYG~ACjW&=O01Sbrlxc`HPYIzk&?%|nn*?ac zj6efJKmce4gK7;=5Je~mY=9A(i~s-tm?oGZf*2&yM5dB5dYFNxgFt8i0004?007d6 z4FGzY0MVcTWB>qY05kvsB@m_*_Eg9K0s4>{007Wv9-uJ*$!x2EHA)%4z|lpr$_lN~ z5kr4&!k`FNq%wH^*x`;r${BaP+xx}hdtjH6Sw*BR>`vXe_$i114IqF55C#MSJRleS z`;WeN(xPvFgDeGyo*l%x`dI6jm0yr zx`8d+R9kTei408DvER$RYg8!EY;!>=c8c(}D)nLBzsa-@UZDGwF`Q8`SxDt_R7puO zX0@>GG`bwWsBn$#F}_LD>@RXzxYanOG^1 z`c+Nn+rQg4DUOiBV}Zgu-bBwPD!Fq@^y4_GtBFX|Fq5&Wi88Y-)~|Cyr)ISY4KTJ1 zD-m;7V)C7;so9rPqbU%EW^zo8N{FOoTZ)o$3`MuR48)%B4DZ?~tNpG5l_}a__ySS%qF)`9< z4W{{V#x9Iujb7O5Rjb)?T0~~^oX{A-c(8F~B0S2_-G+=hxSR3)T<@ zf{GQ8=;+H5mbJI5ppymC4XVT84~Xoz%~MkgG0CemWKw*3xSD5hAVOZL3Zl zOA}wdqMmnw*#%$fmm)zICf?P3IcWgApP!EJh*|RHQ^mRgfT2hhh={ zoVr$R4jIg1ix-%w04QWJj!{MKCN5teH>+(b+QzIM5_o-|d#Sg*Tx1baa&&K9EA5c&?O-}YxYg_Z;y8M(A7tmc-XX1uq zn^kV<00@8&F>I4634kI1cARG?zls461Hbl~>n7QEZmb3r4=xRB5$gSYqshoBx*m*r zeetD8;6QqE+z5QTp8_HqK6~(hk2vHP0>G_5Gl@5bs};Rg{b5CyQPae+w67tpkfrVj zgK0=KYPxA@h))qmgJPxmN8P^Xk~-wCvEC&6GF9%+#+`MBGkln__%71Cg@qCAj+tl@ zuCdYMo+_wSnZ$(ED^I({S}iR@rH%74plVrH5;qQ~7H7*&oJ(mF!DKW-z)?cg zHhR-y$O&Xf%WHr(vWD3NL5^{>q};383dIqAiLH(riS$|SH8Bysp!KThRFPy^#mglL z(IHh5%Z2*u(l1>PUr6rdz0W8O=&>rWK+?`LqM2@Pi!ccz-eSV102j!);to16sqEUq z+a1OpT+Xe7f4xDQwl5FEPjXL($V@=u)vAy#sG{YLJWQhiX{!u7Ieo*HC?<(x)e3)c`@D@q2-R+e21gD|%B=CnCi zPFa`Evb)2(7H6z3RP#!&4w5Ls5p4RQ4cEO+8HphKz$i0C`4()FNdMN_mk`X{VI*gY``S&;g@H zAOHXW(-9FV;ZG^1Pg5bMsL%ia0001J2C1kT4GkItMuSWs001;-Fe5J|n4v6EcUtap% z05;+x>;eEm0VEg_5)efKL>h{spJ)Q>!9=#qqd&<}+4rAJHq_<7Q%=ugPqz$xTv!6? z)t-Yn1dx#kMPnFs>f2LjBnb&Jl3PTG*hO+^BT;0br4~3j1;d~el1c%&8zo_CmeV`7 zSQ#p?nJiJ4RW|s=H-LEISj<2&;{u?HMC8HR*MSf$uRy~wEKwB7m_@OJPR?Zu5Rn!^ zy8t2)HDy4Vsgz8q5~j$MM3HTw#vk5U;o#`)YX{sTAp=H%nF3WBt_|%Pe5Sp5rQ>+R z&xRJ=97qrafH~kLVpJTu*P_a$QDTTxfnyQ zn9j*4l_Vu9mpo+6uEXWkq#vk0(Ns)bI=n^n;QAEQ6HF7^(8tGo?K}$l$ z5LFW-ILflzJxETdxpI+1bU5)r(GgWW3DaNNd{!r;tp{U9pNP3S# z(_RmJXtWSypGnsiiMEQ=#zkFDI2^HCoGjyo1r~&D!>4l*mbNj)-kS`ATLX2hVFj~u zAlFrC4L$PM<(G>=;tiE^MDwW`QsLbsEQ>?J!54=3!)(*){>f%6zE|Z?VzAWHwxqpP z$TQb0?TUl$gbteqOcobE&Yc?W%q2|!Mvq_OMsi@pQFql%U)w#F_i>ccgN)tI>DMI#Rj}bG_L3iI}UTV{h t#OK{+0i2xkDRPuEs;cjrI7Uh{Bw9DmXlU--xLp5>xgwk>NO=4to&Y-N4*388 diff --git a/SESSION.md b/SESSION.md index 46f2bfbd..f0c80479 100644 --- a/SESSION.md +++ b/SESSION.md @@ -1,80 +1,166 @@ -------------------------------------------------------------------------------- -------------------------------- R environment --------------------------------- -------------------------------------------------------------------------------- -|setting |value | -|:-----------|:-------------------------------------| -|version |R version 4.4.1 (2024-06-14) | -|os |macOS 15.3.1 | -|system |aarch64, darwin20 | -|ui |RStudio | -|language |(EN) | -|collate |en_US.UTF-8 | -|ctype |en_US.UTF-8 | -|tz |Europe/Copenhagen | -|date |2025-04-24 | -|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | -|pandoc |3.6.4 @ /opt/homebrew/bin/pandoc | -|quarto |1.6.40 @ /usr/local/bin/quarto | -|FreesearchR |25.4.4.250424 | +|setting |value | +|:-----------|:------------------------------------------| +|version |R version 4.4.1 (2024-06-14) | +|os |macOS 15.3.1 | +|system |aarch64, darwin20 | +|ui |RStudio | +|language |(EN) | +|collate |en_US.UTF-8 | +|ctype |en_US.UTF-8 | +|tz |Europe/Copenhagen | +|date |2025-04-24 | +|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | +|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | +|quarto |1.6.40 @ /usr/local/bin/quarto | +|FreesearchR |25.4.3.250424 | -------------------------------------------------------------------------------- ----------------------------------- packages ----------------------------------- -------------------------------------------------------------------------------- -|package |loadedversion |date |source | -|:-----------|:-------------|:----------|:--------------| -|bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) | -|bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) | -|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | -|cli |3.6.4 |2025-04-23 |CRAN (R 4.4.1) | -|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | -|desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) | -|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | -|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | -|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | -|ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | -|evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | -|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | -|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | -|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | -|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | -|here |1.0.1 |2020-12-13 |CRAN (R 4.4.1) | -|hms |1.1.3 |2023-03-21 |CRAN (R 4.4.0) | -|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) | -|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | -|later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) | -|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | -|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | -|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | -|mime |0.13 |2025-03-17 |CRAN (R 4.4.1) | -|miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) | -|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | -|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | -|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | -|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | -|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | -|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | -|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | -|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | -|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | -|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | -|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | -|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | -|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) | -|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) | -|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) | -|rstudioapi |0.17.1 |2024-10-22 |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) | -|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | -|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | -|tzdb |0.5.0 |2025-03-15 |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) | -|vctrs |0.6.5 |2023-12-01 |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) | -|xfun |0.52 |2025-04-02 |CRAN (R 4.4.1) | -|xtable |1.8-4 |2019-04-21 |CRAN (R 4.4.1) | +|package |loadedversion |date |source | +|:-------------|:-------------|:----------|:--------------| +|apexcharter |0.4.4 |2024-09-06 |CRAN (R 4.4.1) | +|assertthat |0.2.1 |2019-03-21 |CRAN (R 4.4.1) | +|backports |1.5.0 |2024-05-23 |CRAN (R 4.4.1) | +|bayestestR |0.15.2 |2025-02-07 |CRAN (R 4.4.1) | +|bit |4.6.0 |2025-03-06 |CRAN (R 4.4.1) | +|bit64 |4.6.0-1 |2025-01-16 |CRAN (R 4.4.1) | +|boot |1.3-31 |2024-08-28 |CRAN (R 4.4.1) | +|broom |1.0.8 |2025-03-28 |CRAN (R 4.4.1) | +|broom.helpers |1.20.0 |2025-03-06 |CRAN (R 4.4.1) | +|bsicons |0.1.2 |2023-11-04 |CRAN (R 4.4.0) | +|bslib |0.9.0 |2025-01-30 |CRAN (R 4.4.1) | +|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | +|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | +|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | +|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | +|cli |3.6.5 |2025-04-23 |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) | +|correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | +|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | +|crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) | +|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) | +|datawizard |1.0.2 |2025-03-24 |CRAN (R 4.4.1) | +|desc |1.4.3 |2023-12-10 |CRAN (R 4.4.1) | +|devtools |2.4.5 |2022-10-11 |CRAN (R 4.4.0) | +|DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.4.1) | +|digest |0.6.37 |2024-08-19 |CRAN (R 4.4.1) | +|dplyr |1.1.4 |2023-11-17 |CRAN (R 4.4.0) | +|DT |0.33 |2024-04-04 |CRAN (R 4.4.0) | +|e1071 |1.7-16 |2024-09-16 |CRAN (R 4.4.1) | +|easystats |0.7.4 |2025-02-06 |CRAN (R 4.4.1) | +|effectsize |1.0.0 |2024-12-10 |CRAN (R 4.4.1) | +|ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | +|evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | +|farver |2.1.2 |2024-05-13 |CRAN (R 4.4.1) | +|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | +|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) | +|forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | +|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | +|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | +|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | +|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | +|gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | +|gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | +|gtsummary |2.2.0 |2025-04-14 |CRAN (R 4.4.1) | +|haven |2.5.4 |2023-11-30 |CRAN (R 4.4.0) | +|here |1.0.1 |2020-12-13 |CRAN (R 4.4.1) | +|hms |1.1.3 |2023-03-21 |CRAN (R 4.4.0) | +|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) | +|IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | +|insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) | +|jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | +|jsonlite |2.0.0 |2025-03-27 |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) | +|knitr |1.50 |2025-03-16 |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) | +|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | +|lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | +|magrittr |2.0.3 |2022-03-30 |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) | +|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | +|mime |0.13 |2025-03-17 |CRAN (R 4.4.1) | +|miniUI |0.1.2 |2025-04-17 |CRAN (R 4.4.1) | +|minqa |1.2.8 |2024-08-17 |CRAN (R 4.4.1) | +|modelbased |0.10.0 |2025-03-10 |CRAN (R 4.4.1) | +|munsell |0.5.1 |2024-04-01 |CRAN (R 4.4.1) | +|nlme |3.1-168 |2025-03-31 |CRAN (R 4.4.1) | +|nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | +|openxlsx2 |1.14 |2025-03-20 |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) | +|performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | +|phosphoricons |0.2.1 |2024-04-08 |CRAN (R 4.4.0) | +|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | +|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | +|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | +|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | +|processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | +|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | +|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | +|proxy |0.4-27 |2022-06-09 |CRAN (R 4.4.1) | +|ps |1.9.1 |2025-04-12 |CRAN (R 4.4.1) | +|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | +|quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | +|R.cache |0.16.0 |2022-07-21 |CRAN (R 4.4.0) | +|R.methodsS3 |1.8.2 |2022-06-13 |CRAN (R 4.4.1) | +|R.oo |1.27.0 |2024-11-01 |CRAN (R 4.4.1) | +|R.utils |2.13.0 |2025-02-24 |CRAN (R 4.4.1) | +|R6 |2.6.1 |2025-02-15 |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) | +|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | +|Rdpack |2.6.4 |2025-04-09 |CRAN (R 4.4.1) | +|reactable |0.4.4 |2023-03-12 |CRAN (R 4.4.0) | +|readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | +|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | +|readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | +|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) | +|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) | +|reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | +|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | +|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | +|report |0.6.1 |2025-02-07 |CRAN (R 4.4.1) | +|rio |1.2.3 |2024-09-25 |CRAN (R 4.4.1) | +|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) | +|rmarkdown |2.29 |2024-11-04 |CRAN (R 4.4.1) | +|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) | +|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) | +|rstudioapi |0.17.1 |2024-10-22 |CRAN (R 4.4.1) | +|sass |0.4.10 |2025-04-11 |CRAN (R 4.4.1) | +|scales |1.3.0 |2023-11-28 |CRAN (R 4.4.0) | +|see |0.11.0 |2025-03-11 |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) | +|shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | +|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | +|shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) | +|stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | +|styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) | +|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | +|tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | +|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | +|toastui |0.4.0 |2025-04-03 |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) | +|usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | +|vctrs |0.6.5 |2023-12-01 |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) | +|writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) | +|xfun |0.52 |2025-04-02 |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) | +|yaml |2.3.10 |2024-07-26 |CRAN (R 4.4.1) | +|zip |2.3.2 |2025-02-01 |CRAN (R 4.4.1) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 33e02308..6db32fd9 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -10,7 +10,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'v25.4.4.250424' +app_version <- function()'v25.4.3.250424' ######## @@ -300,6 +300,455 @@ sentence_paste <- function(data, and.str = "and") { +######## +#### Current file: /Users/au301842/FreesearchR/R//create-column-mod.R +######## + +#' @title Create new column +#' +#' @description +#' This module allow to enter an expression to create a new column in a `data.frame`. +#' +#' +#' @param id Module's ID. +#' +#' @return A [shiny::reactive()] function returning the data. +#' +#' @note User can only use a subset of function: `r paste(list_allowed_operations(), collapse=", ")`. +#' You can add more operations using the `allowed_operations` argument, for example if you want to allow to use package lubridate, you can do: +#' ```r +#' c(list_allowed_operations(), getNamespaceExports("lubridate")) +#' ``` +#' +#' @export +#' +#' @importFrom htmltools tagList tags css +#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton +#' @importFrom phosphoricons ph +#' @importFrom shinyWidgets virtualSelectInput +#' +#' @name create-column +#' +#' @example example/create_column_module_demo.R +create_column_ui <- function(id) { + ns <- NS(id) + tagList( + # datamods:::html_dependency_datamods(), + # html_dependency_FreesearchR(), + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + ), + # tags$head( + # # Note the wrapping of the string in HTML() + # tags$style(HTML(" + # /* modified from esquisse for data types */ + # .btn-column-categorical { + # background-color: #EF562D; + # color: #FFFFFF; + # } + # .btn-column-continuous { + # background-color: #0C4C8A; + # color: #FFFFFF; + # } + # .btn-column-dichotomous { + # background-color: #97D5E0; + # color: #FFFFFF; + # } + # .btn-column-datetime { + # background-color: #97D5E0; + # color: #FFFFFF; + # } + # .btn-column-id { + # background-color: #848484; + # color: #FFFFFF; + # } + # .btn-column-text { + # background-color: #2E2E2E; + # color: #FFFFFF; + # }")) + # ), + fluidRow( + column( + width = 6, + textInput( + inputId = ns("new_column"), + label = i18n("New column name:"), + value = "new_column1", + width = "100%" + ) + ), + column( + width = 6, + shinyWidgets::virtualSelectInput( + inputId = ns("group_by"), + label = i18n("Group calculation by:"), + choices = NULL, + multiple = TRUE, + disableSelectAll = TRUE, + hasOptionDescription = TRUE, + width = "100%" + ) + ) + ), + textAreaInput( + inputId = ns("expression"), + label = i18n("Enter an expression to define new column:"), + value = "", + width = "100%", + rows = 6 + ), + tags$i( + class = "d-block", + phosphoricons::ph("info"), + datamods::i18n("Click on a column name to add it to the expression:") + ), + uiOutput(outputId = ns("columns")), + uiOutput(outputId = ns("feedback")), + tags$div( + style = css( + display = "grid", + gridTemplateColumns = "3fr 1fr", + columnGap = "10px", + margin = "10px 0" + ), + actionButton( + inputId = ns("compute"), + label = tagList( + phosphoricons::ph("gear"), i18n("Create column") + ), + class = "btn-outline-primary", + width = "100%" + ), + actionButton( + inputId = ns("remove"), + label = tagList( + phosphoricons::ph("trash") + ), + class = "btn-outline-danger", + width = "100%" + ) + ) + ) +} + +#' @param data_r A [shiny::reactive()] function returning a `data.frame`. +#' @param allowed_operations A `list` of allowed operations, see below for details. +#' +#' @export +#' +#' @rdname create-column +#' +#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req +#' updateTextAreaInput reactive bindEvent observe +#' @importFrom shinyWidgets alert updateVirtualSelect +create_column_server <- function(id, + data_r = reactive(NULL), + allowed_operations = list_allowed_operations()) { + moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + info_alert <- shinyWidgets::alert( + status = "info", + phosphoricons::ph("question"), + datamods::i18n("Choose a name for the column to be created or modified,"), + datamods::i18n("then enter an expression before clicking on the button above to validate or on "), + phosphoricons::ph("trash"), datamods::i18n("to delete it.") + ) + + rv <- reactiveValues( + data = NULL, + feedback = info_alert + ) + + observeEvent(input$hidden, rv$feedback <- info_alert) + + bindEvent(observe({ + data <- data_r() + shinyWidgets::updateVirtualSelect( + inputId = "group_by", + choices = make_choices_with_infos(data) + ) + }), data_r(), input$hidden) + + observeEvent(data_r(), rv$data <- data_r()) + + output$feedback <- renderUI(rv$feedback) + + output$columns <- renderUI({ + data <- req(rv$data) + mapply( + label = names(data), + data = data, + FUN = btn_column, + MoreArgs = list(inputId = ns("add_column")), + SIMPLIFY = FALSE + ) + }) + + observeEvent(input$add_column, { + updateTextAreaInput( + session = session, + inputId = "expression", + value = paste0(input$expression, input$add_column) + ) + }) + + observeEvent(input$new_column, { + if (input$new_column == "") { + rv$feedback <- shinyWidgets::alert( + status = "warning", + ph("warning"), datamods::i18n("New column name cannot be empty") + ) + } + }) + + observeEvent(input$remove, { + rv$data[[input$new_column]] <- NULL + }) + observeEvent(input$compute, { + rv$feedback <- try_compute_column( + expression = input$expression, + name = input$new_column, + rv = rv, + allowed_operations = allowed_operations, + by = input$group_by + ) + }) + + return(reactive(rv$data)) + } + ) +} + +#' @export +#' +#' @rdname create-column +# @importFrom methods getGroupMembers +list_allowed_operations <- function() { + c( + "(", "c", + # getGroupMembers("Arith"), + c("+", "-", "*", "^", "%%", "%/%", "/"), + # getGroupMembers("Compare"), + c("==", ">", "<", "!=", "<=", ">="), + # getGroupMembers("Logic"), + c("&", "|"), + # getGroupMembers("Math"), + c( + "abs", "sign", "sqrt", "ceiling", "floor", "trunc", "cummax", + "cummin", "cumprod", "cumsum", "exp", "expm1", "log", "log10", + "log2", "log1p", "cos", "cosh", "sin", "sinh", "tan", "tanh", + "acos", "acosh", "asin", "asinh", "atan", "atanh", "cospi", "sinpi", + "tanpi", "gamma", "lgamma", "digamma", "trigamma" + ), + # getGroupMembers("Math2"), + c("round", "signif"), + # getGroupMembers("Summary"), + c("max", "min", "range", "prod", "sum", "any", "all"), + "pmin", "pmax", "mean", + "paste", "paste0", "substr", "nchar", "trimws", + "gsub", "sub", "grepl", "ifelse", "length", + "as.numeric", "as.character", "as.integer", "as.Date", "as.POSIXct", + "as.factor", "factor" + ) +} + + +#' @inheritParams shiny::modalDialog +#' @export +#' +#' @importFrom shiny showModal modalDialog textInput +#' @importFrom htmltools tagList +#' +#' @rdname create-column +modal_create_column <- function(id, + title = i18n("Create a new column"), + easyClose = TRUE, + size = "l", + footer = NULL) { + ns <- NS(id) + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + create_column_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ), + easyClose = easyClose, + size = size, + footer = footer + )) +} + +#' @inheritParams shinyWidgets::WinBox +#' @export +#' +#' @importFrom shinyWidgets WinBox wbOptions wbControls +#' @importFrom htmltools tagList +#' @rdname create-column +winbox_create_column <- function(id, + title = i18n("Create a new column"), + options = shinyWidgets::wbOptions(), + controls = shinyWidgets::wbControls()) { + ns <- NS(id) + WinBox( + title = title, + ui = tagList( + create_column_ui(id), + tags$div( + style = "display: none;", + textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) + ) + ), + options = modifyList( + shinyWidgets::wbOptions(height = "550px", modal = TRUE), + options + ), + controls = controls, + auto_height = FALSE + ) +} + + +try_compute_column <- function(expression, + name, + rv, + allowed_operations, + by = NULL) { + parsed <- try(parse(text = expression, keep.source = FALSE), silent = TRUE) + if (inherits(parsed, "try-error")) { + return(datamods:::alert_error(attr(parsed, "condition")$message)) + } + funs <- unlist(c(extract_calls(parsed), lapply(parsed, extract_calls)), recursive = TRUE) + if (!are_allowed_operations(funs, allowed_operations)) { + return(datamods:::alert_error(datamods::i18n("Some operations are not allowed"))) + } + if (!isTruthy(by)) { + result <- try( + rlang::eval_tidy(rlang::parse_expr(expression), data = rv$data), + silent = TRUE + ) + } else { + result <- try( + { + dt <- as.data.table(rv$data) + new_col <- NULL + dt[, new_col := rlang::eval_tidy(rlang::parse_expr(expression), data = .SD), by = by] + dt$new_col + }, + silent = TRUE + ) + } + if (inherits(result, "try-error")) { + return(alert_error(attr(result, "condition")$message)) + } + adding_col <- try(rv$data[[name]] <- result, silent = TRUE) + if (inherits(adding_col, "try-error")) { + return(alert_error(attr(adding_col, "condition")$message)) + } + code <- if (!isTruthy(by)) { + rlang::call2("mutate", !!!rlang::set_names(list(rlang::parse_expr(expression)), name)) + } else { + rlang::call2( + "mutate", + !!!rlang::set_names(list(rlang::parse_expr(expression)), name), + !!!list(.by = rlang::expr(c(!!!rlang::syms(by)))) + ) + } + attr(rv$data, "code") <- Reduce( + f = function(x, y) rlang::expr(!!x %>% !!y), + x = c(attr(rv$data, "code"), code) + ) + shinyWidgets::alert( + status = "success", + ph("check"), datamods::i18n("Column added!") + ) +} + +are_allowed_operations <- function(x, allowed_operations) { + all( + x %in% allowed_operations + ) +} + + +extract_calls <- function(exp) { + if (is.call(exp)) { + return(list( + as.character(exp[[1L]]), + lapply(exp[-1L], extract_calls) + )) + } +} + +alert_error <- function(text) { + alert( + status = "danger", + ph("bug"), text + ) +} + + +btn_column <- function(label, data, inputId) { + icon <- get_var_icon(data, "class") + type <- data_type(data) + tags$button( + type = "button", + class = paste0("btn btn-column-", type), + style = css( + "--bs-btn-padding-y" = ".25rem", + "--bs-btn-padding-x" = ".5rem", + "--bs-btn-font-size" = ".75rem", + "margin-bottom" = "5px" + ), + if (!is.null(icon)) icon, + label, + onclick = sprintf( + "Shiny.setInputValue('%s', '%s', {priority: 'event'})", + inputId, label + ) + ) +} + +make_choices_with_infos <- function(data) { + lapply( + X = seq_along(data), + FUN = function(i) { + nm <- names(data)[i] + values <- data[[nm]] + icon <- get_var_icon(values, "class") + # icon <- if (inherits(values, "character")) { + # phosphoricons::ph("text-aa") + # } else if (inherits(values, "factor")) { + # phosphoricons::ph("list-bullets") + # } else if (inherits(values, c("numeric", "integer"))) { + # phosphoricons::ph("hash") + # } else if (inherits(values, c("Date"))) { + # phosphoricons::ph("calendar") + # } else if (inherits(values, c("POSIXt"))) { + # phosphoricons::ph("clock") + # } else { + # NULL + # } + description <- if (is.atomic(values)) { + paste(i18n("Unique values:"), data.table::uniqueN(values)) + } else { + "" + } + list( + label = htmltools::doRenderTags(tagList( + icon, nm + )), + value = nm, + description = description + ) + } + ) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//custom_SelectInput.R ######## @@ -2379,9 +2828,9 @@ class_icons <- function(x) { shiny::icon("arrow-down-a-z") } else if (identical(x, "logical")) { shiny::icon("toggle-off") - } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { + } else if (any(c("Date", "POSIXt") %in% x)) { shiny::icon("calendar-days") - } else if ("hms" %in% x) { + } else if (any("POSIXct", "hms") %in% x) { shiny::icon("clock") } else { shiny::icon("table") @@ -2422,6 +2871,390 @@ type_icons <- function(x) { } } +#' Easily get variable icon based on data type or class +#' +#' @param data variable or data frame +#' @param class.type "type" or "class". Default is "class" +#' +#' @returns svg icon +#' @export +#' +#' @examples +#' mtcars[1] |> get_var_icon("class") +#' default_parsing(mtcars) |> get_var_icon() +get_var_icon <- function(data,class.type=c("class","type")){ + if (is.data.frame(data)){ + lapply(data,get_var_icon) + } else { + + class.type <- match.arg(class.type) + + switch(class.type, + type = { + type_icons(data_type(data)) + }, + class = { + class(data)[1] |> class_icons() + } + ) +} + +} + + +######## +#### Current file: /Users/au301842/FreesearchR/R//datagrid-infos-mod.R +######## + + +#' Display a table in a window +#' +#' @param data a data object (either a `matrix` or a `data.frame`). +#' @param title Title to be displayed in window. +#' @param show_classes Show variables classes under variables names in table header. +#' @param type Display table in a pop-up with [shinyWidgets::show_alert()], +#' in modal window with [shiny::showModal()] or in a WinBox window with [shinyWidgets::WinBox()]. +#' @param options Arguments passed to [toastui::datagrid()]. +#' @param width Width of the window, only used if `type = "popup"` or `type = "winbox"`. +#' @param ... Additional options, such as `wbOptions = wbOptions()` or `wbControls = wbControls()`. +#' +#' @note +#' If you use `type = "winbox"`, you'll need to use `shinyWidgets::html_dependency_winbox()` somewhere in your UI. +#' +#' @return No value. +#' @export +#' +#' @importFrom htmltools tags tagList css +#' @importFrom shiny showModal modalDialog +#' @importFrom utils modifyList packageVersion +#' +#' @example examples/show_data.R +show_data <- function(data, + title = NULL, + options = NULL, + show_classes = TRUE, + type = c("popup", "modal", "winbox"), + width = "65%", + ...) { # nocov start + type <- match.arg(type) + data <- as.data.frame(data) + args <- list(...) + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + if (is.null(options)) + options <- list() + + options$height <- 550 + options$minBodyHeight <- 400 + options$data <- data + options$theme <- "default" + options$colwidths <- "guess" + options$guess_colwidths_opts <- list(min_width = 90, max_width = 400, mul = 1, add = 10) + if (isTRUE(show_classes)) + options$summary <- construct_col_summary(data) + datatable <- rlang::exec(toastui::datagrid, !!!options) + datatable <- toastui::grid_columns(datatable, className = "font-monospace") + if (identical(type, "winbox")) { + stopifnot( + "You need shinyWidgets >= 0.8.4" = packageVersion("shinyWidgets") >= "0.8.4" + ) + wb_options <- if (is.null(args$wbOptions)) { + shinyWidgets::wbOptions( + height = "600px", + width = width, + modal = TRUE + ) + } else { + modifyList( + shinyWidgets::wbOptions( + height = "600px", + width = width, + modal = TRUE + ), + args$wbOptions + ) + } + wb_controls <- if (is.null(args$wbControls)) { + shinyWidgets::wbControls() + } else { + args$wbControls + } + shinyWidgets::WinBox( + title = title, + ui = datatable, + options = wb_options, + controls = wb_controls, + padding = "0 5px" + ) + } else if (identical(type, "popup")) { + shinyWidgets::show_alert( + title = NULL, + text = tags$div( + if (!is.null(title)) { + tagList( + tags$h3(title), + tags$hr() + ) + }, + style = "color: #000 !important;", + datatable + ), + closeOnClickOutside = TRUE, + showCloseButton = TRUE, + btn_labels = NA, + html = TRUE, + width = width + ) + } else { + showModal(modalDialog( + title = tagList( + datamods:::button_close_modal(), + title + ), + tags$div( + style = css(minHeight = validateCssUnit(options$height)), + toastui::renderDatagrid2(datatable) + ), + size = "xl", + footer = NULL, + easyClose = TRUE + )) + } +} # nocov end + + + +#' @importFrom htmltools tagList tags css +describe_col_char <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("text-aa"), + "character" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Unique:"), length(unique(x)) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + style = css(whiteSpace = "normal", wordBreak = "break-all"), + i18n("Most Common:"), gsub( + pattern = "'", + replacement = "\u07F4", + x = names(sort(table(x), decreasing = TRUE))[1] + ) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +fmt_p <- function(val, tot) { + paste0(round(val / tot * 100, 1), "%") +} + +describe_col_factor <- function(x, with_summary = TRUE) { + count <- sort(table(x, useNA = "always"), decreasing = TRUE) + total <- sum(count) + one <- count[!is.na(names(count))][1] + two <- count[!is.na(names(count))][2] + missing <- count[is.na(names(count))] + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("list-bullets"), + "factor" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + names(one), ":", fmt_p(one, total) + ), + tags$div( + names(two), ":", fmt_p(two, total) + ), + tags$div( + "Missing", ":", fmt_p(missing, total) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +describe_col_num <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("hash"), + "numeric" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), round(min(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Mean:"), round(mean(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Max:"), round(max(x, na.rm = TRUE), 2) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ) + ) + } + ) +} + + +describe_col_date <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("calendar"), + "date" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), min(x, na.rm = TRUE) + ), + tags$div( + i18n("Max:"), max(x, na.rm = TRUE) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +describe_col_datetime <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("clock"), + "datetime" + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Min:"), min(x, na.rm = TRUE) + ), + tags$div( + i18n("Max:"), max(x, na.rm = TRUE) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + + +describe_col_other <- function(x, with_summary = TRUE) { + tags$div( + style = css(padding = "3px 0", fontSize = "x-small"), + tags$div( + style = css(fontStyle = "italic"), + get_var_icon(x), + # phosphoricons::ph("clock"), + paste(class(x), collapse = ", ") + ), + if (with_summary) { + tagList( + tags$hr(style = css(margin = "3px 0")), + tags$div( + i18n("Unique:"), length(unique(x)) + ), + tags$div( + i18n("Missing:"), sum(is.na(x)) + ), + tags$div( + "\u00A0" + ), + tags$div( + "\u00A0" + ) + ) + } + ) +} + +construct_col_summary <- function(data) { + list( + position = "top", + height = 90, + columnContent = lapply( + X = setNames(names(data), names(data)), + FUN = function(col) { + values <- data[[col]] + content <- if (inherits(values, "character")) { + describe_col_char(values) + } else if (inherits(values, "factor")) { + describe_col_factor(values) + } else if (inherits(values, c("numeric", "integer"))) { + describe_col_num(values) + } else if (inherits(values, c("Date"))) { + describe_col_date(values) + } else if (inherits(values, c("POSIXt"))) { + describe_col_datetime(values) + } else { + describe_col_other(values) + } + list( + template = toastui::JS( + "function(value) {", + sprintf( + "return '%s';", + gsub(replacement = "", pattern = "\n", x = htmltools::doRenderTags(content)) + ), + "}" + ) + ) + } + ) + ) +} + ######## #### Current file: /Users/au301842/FreesearchR/R//helpers.R @@ -3083,6 +3916,21 @@ is_identical_to_previous <- function(data, no.name = TRUE) { } +######## +#### Current file: /Users/au301842/FreesearchR/R//html_dependency_freesearchr.R +######## + +html_dependency_FreesearchR <- function() { + htmltools::htmlDependency( + name = "FreesearchR", + version = packageVersion("FreesearchR"), + src = list(href = "FreesearchR", file = "assets"), + package = "FreesearchR", + stylesheet = "css/FreesearchR.css" + ) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R ######## @@ -6953,7 +7801,7 @@ custom_theme <- function(..., secondary = "#FF6F61", bootswatch = "united", base_font = bslib::font_google("Montserrat"), - heading_font = bslib::font_google("Public Sans",wght = "700"), + heading_font = bslib::font_google("Public Sans", wght = "700"), code_font = bslib::font_google("Open Sans") # success = "#1E4A8F", # info = , @@ -6965,7 +7813,7 @@ custom_theme <- function(..., # heading_font = bslib::font_google("Jost", wght = "800"), # heading_font = bslib::font_google("Noto Serif"), # heading_font = bslib::font_google("Alice"), - ){ +) { bslib::bs_theme( ..., "navbar-bg" = primary, @@ -6979,6 +7827,16 @@ custom_theme <- function(..., ) } +compliment_colors <- function() { + c( + "#00C896", + "#FFB100", + "#8A4FFF", + "#11A0EC" + ) +} + + #' GGplot default theme for plotting in Shiny #' @@ -6987,16 +7845,16 @@ custom_theme <- function(..., #' @returns ggplot object #' @export #' -gg_theme_shiny <- function(){ - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text = ggplot2::element_text(size = 14), - strip.text = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24), - plot.subtitle = ggplot2::element_text(size = 18) - ) +gg_theme_shiny <- function() { + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text = ggplot2::element_text(size = 14), + strip.text = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24), + plot.subtitle = ggplot2::element_text(size = 18) + ) } @@ -7007,14 +7865,14 @@ gg_theme_shiny <- function(){ #' @returns ggplot object #' @export #' -gg_theme_export <- function(){ - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text.x = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24) - ) +gg_theme_export <- function() { + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text.x = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24) + ) } @@ -8803,15 +9661,9 @@ dark <- custom_theme( ui <- bslib::page_fixed( prismDependencies, prismRDependency, - shiny::tags$head(includeHTML(("www/umami-app.html"))), - shiny::tags$style( - type = "text/css", - # add the name of the tab you want to use as title in data-value - shiny::HTML( - ".container-fluid > .nav > li > - a[data-value='FreesearchR'] {font-size: 28px}" - ) - ), + shiny::tags$head( + includeHTML(("www/umami-app.html")), + tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), title = "FreesearchR", theme = light, shiny::useBusyIndicators(), @@ -8850,7 +9702,7 @@ library(readr) library(MASS) library(stats) library(gt) -library(openxlsx2) +# library(openxlsx2) library(haven) library(readODS) require(shiny) @@ -8863,16 +9715,16 @@ library(broom) library(broom.helpers) # library(REDCapCAST) library(easystats) -library(esquisse) +# library(esquisse) library(patchwork) library(DHARMa) library(apexcharter) library(toastui) library(datamods) -library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) +library(data.table) library(gtsummary) # library(FreesearchR) @@ -9167,13 +10019,13 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_column, - datamods::modal_create_column( + modal_create_column( id = "modal_column", footer = "This window is aimed at advanced users and require some R-experience!", title = "Create new variables" ) ) - data_modal_r <- datamods::create_column_server( + data_modal_r <- create_column_server( id = "modal_column", data_r = reactive(rv$data) ) @@ -9296,7 +10148,7 @@ server <- function(input, output, session) { ) observeEvent(input$modal_browse, { - datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") + show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") }) output$original_str <- renderPrint({ diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf index 89e5ac2b..54b1e102 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 14600805 -bundleId: 10169675 +bundleId: 10170130 url: https://agdamsbo.shinyapps.io/FreesearchR/ version: 1 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index ea8a2b74..b6c78d2b 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -2,7 +2,7 @@ library(readr) library(MASS) library(stats) library(gt) -library(openxlsx2) +# library(openxlsx2) library(haven) library(readODS) require(shiny) @@ -15,16 +15,16 @@ library(broom) library(broom.helpers) # library(REDCapCAST) library(easystats) -library(esquisse) +# library(esquisse) library(patchwork) library(DHARMa) library(apexcharter) library(toastui) library(datamods) -library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) +library(data.table) library(gtsummary) # library(FreesearchR) @@ -319,13 +319,13 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_column, - datamods::modal_create_column( + modal_create_column( id = "modal_column", footer = "This window is aimed at advanced users and require some R-experience!", title = "Create new variables" ) ) - data_modal_r <- datamods::create_column_server( + data_modal_r <- create_column_server( id = "modal_column", data_r = reactive(rv$data) ) @@ -448,7 +448,7 @@ server <- function(input, output, session) { ) observeEvent(input$modal_browse, { - datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") + show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") }) output$original_str <- renderPrint({ diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index ddb26818..0ce31efa 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -507,15 +507,9 @@ dark <- custom_theme( ui <- bslib::page_fixed( prismDependencies, prismRDependency, - shiny::tags$head(includeHTML(("www/umami-app.html"))), - shiny::tags$style( - type = "text/css", - # add the name of the tab you want to use as title in data-value - shiny::HTML( - ".container-fluid > .nav > li > - a[data-value='FreesearchR'] {font-size: 28px}" - ) - ), + shiny::tags$head( + includeHTML(("www/umami-app.html")), + tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), title = "FreesearchR", theme = light, shiny::useBusyIndicators(), From ffe80bf04376a2bb93a773e0c96fa8646f0e1e23 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 13:05:54 +0200 Subject: [PATCH 5/6] polish --- R/sysdata.rda | Bin 2057 -> 2097 bytes SESSION.md | 3 +++ inst/apps/FreesearchR/app.R | 9 ++++++--- .../shinyapps.io/agdamsbo/FreesearchR.dcf | 2 +- inst/apps/FreesearchR/server.R | 2 +- inst/apps/FreesearchR/ui.R | 7 +++++-- 6 files changed, 16 insertions(+), 7 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index 953abdafe040167a1038ed0537a0b5b139c9c25f..51dd6d0980b3ba31b0d5d615ddd3926f286af25c 100644 GIT binary patch literal 2097 zcmV-12+sFHT4*^jL0KkKStBPkDgY9p|KR`sXaz!l|KNXXp1{BV|L{NnKmZ5<;0XUN zM`q)}&t@QXKraKy5FtZTCWO!ifIuc_jZ@V9Q1qXv0MG*?(i!O{n0-4FCWDWB>pFGyo*hNQ8-+n1-5YWCy4K0004?00GS! zG&I5irUcVK84V0T8ZjCeBOn4LAt~)h_Eg$|pba0T0ib9A#A%`G1Jh6pmP(t+s!-yA zd6J7=bOZwwQBdL0Sx_PsR6`$|?S=Sb8$#XQ@IP&Ldyt*e!LS&QJlx85wSRt?Ta80bw$Ltnx^;|dAVELvUG-xUw9{mg z6?h>?D5#d^CSnaIA)=_>X(^c3lpDPv;lkYaz3*z&ZbSr*JB2x}p*!<Zm2_=io7JJvrE}vu}B$$RCqIdM3o^7 z;iY`nGa~OsZZt;)~;!>ia7)lV4D~cW^q?-CYu;CqXOh2IB+sW zW@-X~e29~bH<>~io81RO7(py5S*le4D-bm}{G7(~a{_v-+2)3_jN*$UAkk)J0nRL( z1UNNDX4rANYey$f7nb~?2{62cH^i~GTDnIQPCQ!eDw|xJ*Dm~bH_B@gG(ajPB|=ar zR5>RR5ob0sl5%1qizex@BvQD6F=(3rECC^qY5{LDtfk4QHblfcyNllNOu{5KAc>Yx z#7ZzAZwBkGc=!Hs>vuKL(b3u6?+`j~RSL*+^W{+~Yg>BS2{JB_ZB`!$d`E4@I(0C! z9GbI6MJLCriKcgg9034ikOYJdWB}rjJRRZENr|RcwVWNw7FBo5&7_2sp@Ljy496{0 z8*5_mhbBcMIh>dUDA_DzP|KP1rDVgHkq*TISPURQf=lH9wv+-9qem=DqMVGGF4 z(u->vuyqbB4->cV^*4L{`87FhrqY#Faf5N}8LjVpo9@G5b`aE=O*XcQjX`;$-~>1S z8~AK}KoHV#Hf=X@{(QKu$3qPp&YcbSc77!vDJOUUC<=b>PgdLD015-ATqZknfC7N& z-&-jsRd+1d3?d!aIn7t`>i3RZ0#g)f$A66yBDRnojXJ>(=gsOOA?4qcQ3v|RAy6w3 zvwiF(?i=Vv{&fFwDvFik+K;n=;8K=|r<0Wx| zeh{wkGeJa224 z^R{tLx3Hg6pGY~lYGB)Swnr>M5G+{Trbtzf1Ie|(=DAtNDe%}$!yFtF zim7wI>1;(8#&SSe3nhYv&4U>ZT&bR>8e)}^ndC=rhU{9%Ofx4ILVjni zsv-#UR;8K2O+b}VD6NceKt!`&60WldLQ`+ph87jTtU?zBo=c^cixJ zZXjgHmZ`78fc0cfScl1{^q zgXKQS_D_QwVeiK1DSEfiHF;jj0ZU5M7Fuj=(`pHYm$Q2n8eLpDXoEW0my~l9Ecv(V zT}~kiiDDeiO~8DV4G~`Um9J#ch7yw7j(`abL^Bn4r17Mys?}9#!s;v=IcsjFOZdm6nWsKF205eO!_Qlypo8#@i(to0x^NNbDk@(#dhKO$mTPn=o%FDz b5~N#nkDwfc1*m}lLH`$WML1B9BPTT~OIfiA literal 2057 zcmV+k2=@0vT4*^jL0KkKS=#vc3;+@*|G@wMXaz!l|KNXXp1{BV|L{Nr2m#;--!0j( zxbSctoeBYc-$fNbszXyCOq0__NrW^eYG~ACjW&=O01Sbrlxc`HPYIzk&?%|nn*?ac zj6efJKmce4gK7;=5Je~mY=9A(i~s-tm?oGZf*2&yM5dB5dYFNxgFt8i0004?007d6 z4FGzY0MVcTWB>qY05kvsB@m_*_Eg9K0s4>{007Wv9-uJ*$!x2EHA)%4z|lpr$_lN~ z5kr4&!k`FNq%wH^*x`;r${BaP+xx}hdtjH6Sw*BR>`vXe_$i114IqF55C#MSJRleS z`;WeN(xPvFgDeGyo*l%x`dI6jm0yr zx`8d+R9kTei408DvER$RYg8!EY;!>=c8c(}D)nLBzsa-@UZDGwF`Q8`SxDt_R7puO zX0@>GG`bwWsBn$#F}_LD>@RXzxYanOG^1 z`c+Nn+rQg4DUOiBV}Zgu-bBwPD!Fq@^y4_GtBFX|Fq5&Wi88Y-)~|Cyr)ISY4KTJ1 zD-m;7V)C7;so9rPqbU%EW^zo8N{FOoTZ)o$3`MuR48)%B4DZ?~tNpG5l_}a__ySS%qF)`9< z4W{{V#x9Iujb7O5Rjb)?T0~~^oX{A-c(8F~B0S2_-G+=hxSR3)T<@ zf{GQ8=;+H5mbJI5ppymC4XVT84~Xoz%~MkgG0CemWKw*3xSD5hAVOZL3Zl zOA}wdqMmnw*#%$fmm)zICf?P3IcWgApP!EJh*|RHQ^mRgfT2hhh={ zoVr$R4jIg1ix-%w04QWJj!{MKCN5teH>+(b+QzIM5_o-|d#Sg*Tx1baa&&K9EA5c&?O-}YxYg_Z;y8M(A7tmc-XX1uq zn^kV<00@8&F>I4634kI1cARG?zls461Hbl~>n7QEZmb3r4=xRB5$gSYqshoBx*m*r zeetD8;6QqE+z5QTp8_HqK6~(hk2vHP0>G_5Gl@5bs};Rg{b5CyQPae+w67tpkfrVj zgK0=KYPxA@h))qmgJPxmN8P^Xk~-wCvEC&6GF9%+#+`MBGkln__%71Cg@qCAj+tl@ zuCdYMo+_wSnZ$(ED^I({S}iR@rH%74plVrH5;qQ~7H7*&oJ(mF!DKW-z)?cg zHhR-y$O&Xf%WHr(vWD3NL5^{>q};383dIqAiLH(riS$|SH8Bysp!KThRFPy^#mglL z(IHh5%Z2*u(l1>PUr6rdz0W8O=&>rWK+?`LqM2@Pi!ccz-eSV102j!);to16sqEUq z+a1OpT+Xe7f4xDQwl5FEPjXL($V@=u)vAy#sG{YLJWQhiX{!u7Ieo*HC?<(x)e3)c`@D@q2-R+e21gD|%B=CnCi zPFa`Evb)2(7H6 Date: Thu, 24 Apr 2025 13:16:33 +0200 Subject: [PATCH 6/6] slightly updated visuals --- R/theme.R | 45 +++++++++++++------ inst/apps/FreesearchR/app.R | 45 +++++++++++++------ .../shinyapps.io/agdamsbo/FreesearchR.dcf | 2 +- 3 files changed, 63 insertions(+), 29 deletions(-) diff --git a/R/theme.R b/R/theme.R index 29e0c33f..d0852ada 100644 --- a/R/theme.R +++ b/R/theme.R @@ -6,16 +6,16 @@ #' @export custom_theme <- function(..., version = 5, - primary = "#1E4A8F", - secondary = "#FF6F61", + primary = FreesearchR_colors("primary"), + secondary = FreesearchR_colors("secondary"), bootswatch = "united", base_font = bslib::font_google("Montserrat"), heading_font = bslib::font_google("Public Sans", wght = "700"), - code_font = bslib::font_google("Open Sans") - # success = "#1E4A8F", - # info = , - # warning = , - # danger = , + code_font = bslib::font_google("Open Sans"), + success = FreesearchR_colors("success"), + info = FreesearchR_colors("info"), + warning = FreesearchR_colors("warning"), + danger = FreesearchR_colors("danger") # fg = "#000", # bg="#fff", # base_font = bslib::font_google("Alice"), @@ -32,21 +32,38 @@ custom_theme <- function(..., bootswatch = bootswatch, base_font = base_font, heading_font = heading_font, - code_font = code_font + code_font = code_font, + success=success, + info=info, + warning=warning, + danger=danger ) } -compliment_colors <- function() { - c( - "#00C896", - "#FFB100", - "#8A4FFF", - "#11A0EC" +FreesearchR_colors <- function(choose = NULL) { + out <- c( + primary = "#1E4A8F", + secondary = "#FF6F61", + success = "#00C896", + warning = "#FFB100", + danger = "#FF3A2F", + extra = "#8A4FFF", + info = "#11A0EC", + bg = "#FFFFFF", + dark = "#2D2D42", + fg = "#000000" ) + if (!is.null(choose)) { + out[choose] + } else { + out + } } + + #' GGplot default theme for plotting in Shiny #' #' @param data ggplot object diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 0a1616ca..b041778d 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -7797,16 +7797,16 @@ html_code_wrap <- function(string,lang="r"){ #' @export custom_theme <- function(..., version = 5, - primary = "#1E4A8F", - secondary = "#FF6F61", + primary = FreesearchR_colors("primary"), + secondary = FreesearchR_colors("secondary"), bootswatch = "united", base_font = bslib::font_google("Montserrat"), heading_font = bslib::font_google("Public Sans", wght = "700"), - code_font = bslib::font_google("Open Sans") - # success = "#1E4A8F", - # info = , - # warning = , - # danger = , + code_font = bslib::font_google("Open Sans"), + success = FreesearchR_colors("success"), + info = FreesearchR_colors("info"), + warning = FreesearchR_colors("warning"), + danger = FreesearchR_colors("danger") # fg = "#000", # bg="#fff", # base_font = bslib::font_google("Alice"), @@ -7823,21 +7823,38 @@ custom_theme <- function(..., bootswatch = bootswatch, base_font = base_font, heading_font = heading_font, - code_font = code_font + code_font = code_font, + success=success, + info=info, + warning=warning, + danger=danger ) } -compliment_colors <- function() { - c( - "#00C896", - "#FFB100", - "#8A4FFF", - "#11A0EC" +FreesearchR_colors <- function(choose = NULL) { + out <- c( + primary = "#1E4A8F", + secondary = "#FF6F61", + success = "#00C896", + warning = "#FFB100", + danger = "#FF3A2F", + extra = "#8A4FFF", + info = "#11A0EC", + bg = "#FFFFFF", + dark = "#2D2D42", + fg = "#000000" ) + if (!is.null(choose)) { + out[choose] + } else { + out + } } + + #' GGplot default theme for plotting in Shiny #' #' @param data ggplot object diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf index 969a60a2..7d73d94f 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 14600805 -bundleId: +bundleId: 10170173 url: https://agdamsbo.shinyapps.io/FreesearchR/ version: 1