From 54ba126a8b95455509d4956c2f607fdd26057297 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Apr 2025 11:00:56 +0200 Subject: [PATCH] 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 b3a0612..07d9589 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 af77b75..69adfef 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 1fbe1ec..dd1a24f 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 e18f615..d3f95eb 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 87eb19c..989d2ed 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 674d463..daccb88 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 b3606e6..33e0230 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 0000000..23eef6a --- /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 f5bbfb7..dd1b961 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 8f97737..ea8a2b7 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 8dac445..ddb2681 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 ca20ec8..ab4b8b8 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 57eeb5a..1270d51 100644 --- a/umami-page.html +++ b/umami-page.html @@ -1 +1 @@ - +