From 1b45c3fabffabecb716e58f0085830935b6ef595 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 11:30:36 +0200 Subject: [PATCH 1/7] polished redcap import and code export --- R/redcap_read_shiny_module.R | 59 ++++++++++++++++++++++++++++-------- man/simple_snake.Rd | 20 ++++++++++++ 2 files changed, 66 insertions(+), 13 deletions(-) create mode 100644 man/simple_snake.Rd diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 8857e5f0..9499e7d3 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -200,9 +200,12 @@ m_redcap_readServer <- function(id) { ) # browser() - shiny::withProgress({ - imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) - },message = paste("Connecting to",data_rv$uri)) + shiny::withProgress( + { + imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) + }, + message = paste("Connecting to", data_rv$uri) + ) ## TODO: Simplify error messages if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { @@ -228,7 +231,7 @@ m_redcap_readServer <- function(id) { status = "success", include_data_alert( see_data_text = "Click to see data dictionary", - dataIdName = "see_data", + dataIdName = "see_dd", extra = tags$p( tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), glue::glue("The {data_rv$info$project_title} project is loaded.") @@ -254,8 +257,8 @@ m_redcap_readServer <- function(id) { output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) - shiny::observeEvent(input$see_data, { - datamods::show_data( + shiny::observeEvent(input$see_dd, { + show_data( purrr::pluck(data_rv$dd_list, "data"), title = "Data dictionary", type = "modal", @@ -264,6 +267,17 @@ m_redcap_readServer <- function(id) { ) }) + shiny::observeEvent(input$see_data, { + show_data( + # purrr::pluck(data_rv$dd_list, "data"), + data_rv$data, + title = "Imported data set", + type = "modal", + show_classes = FALSE, + tags$b("Preview:") + ) + }) + arms <- shiny::reactive({ shiny::req(input$api) shiny::req(data_rv$uri) @@ -378,13 +392,24 @@ m_redcap_readServer <- function(id) { imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) }) - code <- rlang::call2("read_redcap_tables", - !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")] + + code <- rlang::call2( + "easy_redcap", + !!!utils::modifyList( + parameters_code, + list( + data_format = ifelse( + input$data_type == "long" && !is.null(input$data_type), + "long", + "wide" + ), + project.name = simple_snake(data_rv$info$project_title) + ) + ), .ns = "REDCapCAST" ) - # browser() - if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL @@ -453,9 +478,17 @@ m_redcap_readServer <- function(id) { datamods:::insert_alert( selector = ns("retrieved"), status = data_rv$data_status, - tags$p( - tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), - data_rv$data_message + # tags$p( + # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + # data_rv$data_message + # ), + include_data_alert( + see_data_text = "Click to see the imported data", + dataIdName = "see_data", + extra = tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message) + ), + btn_show_data = TRUE ) ) } else { diff --git a/man/simple_snake.Rd b/man/simple_snake.Rd new file mode 100644 index 00000000..f79ba9a4 --- /dev/null +++ b/man/simple_snake.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{simple_snake} +\alias{simple_snake} +\title{Simplified version of the snakecase packages to_snake_case} +\usage{ +simple_snake(data) +} +\arguments{ +\item{data}{character string vector} +} +\value{ +vector +} +\description{ +Simplified version of the snakecase packages to_snake_case +} +\examples{ +c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake() +} From 91a3f199527bf6e385d806ab4e1e91439887984d Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 11:31:11 +0200 Subject: [PATCH 2/7] version bump --- CITATION.cff | 2 +- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 8 ++++++++ R/app_version.R | 2 +- R/hosted_version.R | 2 +- R/redcap.R | 0 R/sysdata.rda | Bin 2120 -> 2152 bytes README.md | 6 +++--- SESSION.md | 11 +++++++---- _pkgdown.yml | 2 +- 11 files changed, 24 insertions(+), 12 deletions(-) delete mode 100644 R/redcap.R diff --git a/CITATION.cff b/CITATION.cff index 29f48145..25ca71cb 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -9,7 +9,7 @@ type: software license: AGPL-3.0-or-later title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers with publication ready output' -version: 25.5.2 +version: 25.5.3 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 87cc929d..be82a047 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: A free and open-source browser based data analysis tool for researchers with publication ready output -Version: 25.5.2 +Version: 25.5.3 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NAMESPACE b/NAMESPACE index 186ab21a..e51e611a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -108,6 +108,7 @@ export(sankey_ready) export(selectInputIcon) export(set_column_label) export(show_data) +export(simple_snake) export(sort_by) export(specify_qmd_format) export(subset_types) diff --git a/NEWS.md b/NEWS.md index 07731215..9c02423f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# FreesearchR 25.5.3 + +- *FIX* a little polish on the data import + +- *FIX* polished REDCap import and new code to reference the `REDCapCAST::easy_redcap()` function. + +- *FIX* updated documentation to reflect new private hosting on a Hetzner server in Germany. + # FreesearchR 25.5.2 - *FIX*: correct export of plots. The solution in the last version broke more than it solved. diff --git a/R/app_version.R b/R/app_version.R index eca6bb3a..ba85500f 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.2' +app_version <- function()'25.5.3' diff --git a/R/hosted_version.R b/R/hosted_version.R index 5feb2555..9f191afd 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.2-250508' +hosted_version <- function()'v25.5.3-250510' diff --git a/R/redcap.R b/R/redcap.R deleted file mode 100644 index e69de29b..00000000 diff --git a/R/sysdata.rda b/R/sysdata.rda index 57d54ffe4019c0943ba03653e6099750f677ab1c..17176937b55b3e75ccefe450178e95d5e9a5a271 100644 GIT binary patch literal 2152 zcmV-u2$%OlT4*^jL0KkKS$(5h9Ni{ZrHp8fKtvKmY&$ z27mwqN`oUtng9bpXaF=cXfyx-GynuiO+>_-Ab`*`Jt3n&Gyni;pwYBI$$DJmCXq&Z z84U_sT7f{n0RcF_HZBoD>xf|S?&Zms0O1TgKOQa<7@r8HGD}j_FKkZb?7wSYMb3hN zCoTiOpx)m9R&7pK>eD-ag8tE}c(gn*OZ9&j1gG~L17E^0hR=29<;1`wK0KSq4jFJo zV>2>IP7-G>LJSsNp<5*N;AJQA`)~TN-3%{uhyV z?MoP0p8H+yl9_23y}H>w8H^Tr>t;Qqj)vw=)SqxDD))?X#nc@UQp{%4US3`DbbUp->f3{lOG9VhA^NB^YxGA(!X4Z1X@3Xehe+Jsf*=dqdx+08q)36*!16 zgn&pw42&Sb7L;053KUQUr2#={RHQ{vPF~LV&rvJN3rb#Q8_Fvf!JGs^xkO_3AQ*IK zT9XD_5mW^<(S^nmPcslRoi%hM)V1z4c!n65Ln*#ZX?D$FqVt=)Fc4DVB#f0467c73 zXE{|o>h36Pg+T@o#1Nr~qQM~tpd~q$Mp`NoDWVg))eIOS5=dC2JTw^ql0e+!?NXXe zQW5KUBU23YD&g3ua7QvzEC2wUK@kB6Xh_t}o6O?}2M-5^xK&YAbAb|S(&>{Jm`2kL zyRpqhGcL6Yb-dB133qokfh;0RNu7hCAqokc0Le_~q=7^P@+sXNWW+YT35JsuR8UAG zvr_n8YVn*_t{XVGy5X&jYfPB77|4>bjLSA~-6u)MzdKX@ZR6X=UteE`rIs|>0wN(56AVPb8V>_h zav)(0b}wxRN{Z^?stT&X0>ps@Vz(lVGDcfb-i{4Yl-DD5Xi-F=rXe8RS6s=r2R_Dn zur(+KqA-CNk}Stn7e1&6Mw)b@Ux4Z9W9HgaAkSXyv53MAL23e%RCkm$SdKfW)6v(l zdh!*E8e;aKJCIj$0ELFhev*KyNDe(4@cA|ji#8bbU{@xn4luq9^oW&xyVLCiX!@GjL|h+T9dGd^EIh&ilpF zP-?^^zJlzzzG!7&+N*R91VDgvwz-KxcnE<3a+H8 zBWgUn%A$PFQBqr7T~xp!uyrayqh>Qpj7E6}dfQ@`=O0e|UP$bczKS&`_|00fe;(B; zz|Ge#D<50udE!Dqtscv8opZY3)!TekSg%8j&Sbe>exEg{yr>lMYnAA01)LGHtWM}a zT67LH7Kh6F^_M^*Xf1}6mE}Ts)NE?s6+j4QO2wNyq4x@N5JctMOUlU6fYJ*Pq+ayG zkV7?dj}fz?IMyDuTY*-QY+1sEl7yXbt=DJ29hOG%iztH~#CP)C`bx367)eWziKVI9nQTAt7 z9gE%_w%NqDFvmwXDbt+nU`FNiym-S1$02YG(`X7vHVYTdH<5nSj`4im$`ds?L|ijd z4B{s!sW@X1LNq5N>d#IXNL6hni0>WCreV=LyVr;zd-k+~?z5{o>u?>`K0M9*Xr%eq z(_SlNkA|!6LUZ8}pZAL53Y#rb0*h?(Q?ZJI^Y(DANuu}wS0+TzfKh$ztOfv%xYIw@`tTHx7I?u?zSlOe=7 z9cSs$n5-}aC6_KXGpb<0Z%n#!3~63LZBpGHbc)_|2h6MxG|4Hdg6?n)>*=H5L~20; zHSOO=4RFWRHDlQP$$4fq?Hclb9)9)BbVyOD>q^GGwC9L^(v6AS@zr#_PFb#W(F%Ck euvLY$i+4!i1GYe3suTqu@pmLsg$W1cPriVyzRTYL literal 2120 zcmV-O2)Fk_T4*^jL0KkKS+Ga33jh-S|KR`sXaz!l|KNXXpTNKW|L{Nn2mlBH;0Yfs z)>*sMI4FQL4R9V*os1|nASQrlO%p~b=0sCGsP#QV(Hl_H)D0OkG?Pr!8mE&WBOt1K z(UGDPPfBejBM8DU2nGW}G!0J(MJfQu8USPf01W^D000D`^Nk1h$H3z5-29MPM z0LTCX)Bpe+WWh8t85tQgGy$N$76bxYQMT@%ws}#QwsS$ckhMg0_*G z_IsAV2%2Dl5fB%d0^>0=yX23q?}F|}@$h$0X!~sLk{3-rzUQ*q1fNKwSHEP;s9+JF z{cnYU+Nm}onVFZJlORnq4OA`#j-aL!#c*SC9||#1u3-GkHV=Fr)>Lpr1cpb5w>)T{ z)_p7cIph1*n>ibE z5IhPk%20E~8m_vbhHFCBHQ&1Y{JSR1?u#**Z9`=U`j9M$fGUM5z57u_W`V5;02x4v zgd(a$5d{=v2oO?0sR&3<;gS$Kkw9p(5>?!whF2}4KMWV^3X7MQjbD;$T=3n*Ap?&c z^xnv;B8ZS;2$4k;1qiDoSh6gNv0{jTuz9>~v!^1?*kK~@X|;sTa%qsLIIyi=R1CVB z>#K5T;6)S#HDQ&`Qr|l?G}BY20SeP6%sO_2G(`|BjnK;`X`KZlaG(x}4Fr-YX%Q2L zGU}VBR5qhK7K1~qM-a|TEQ{bVZ*=N%GU9CA&1DJ=m${tFmxKqh6|DSq6W+ER^u3i3 ztKsRA_^_?+miJ(5M+Fi<&PNFcO4#DL1(?-@g{#*fb~xBp6Q7?IMwYgZMnX(Q$`xYI zfIbt&aK|Z`f`%MS*^?1r@n+#On>xZ9fdEJl5F|IU2G)c;4bbL5(V6h^yHN`&y5gFU zl4PNQC{a?lwMI79;g#AO*%XZCaWMjvX)HikV&flDR!keo5b3f)u!w^YQaoA)`#?rn zeWdKL;>dLH;kwFEwzO(AqbRb1moVmoCT#3to%Q3}rkVkIctd~5Buh{WY7jz^r7fi- z36zy)RzXRSupn*eXEF;So<9r$gq&^gQyDf@D87%AaK-{fgCV0TO1cje=(GhF?X}+} z6xo5Q80yjHNR&Y(kP2t292UE8;SAjB#8*hf^p$}+rk<#U=}*RSF@Z5Fb*B`nzd>X~J%!2EQL z1N-XrnV9kRVD~(GU}Jc!9jkM@7;3;{O5594x#dk|^YX4scP3Mq`CmlyN(s)HM1`LF zROA#}$RFV9R?d;?*L)1Vh_CaK^>=eF{LshDwbUD`ETx0C7Mj;YY+UvAIijtFpPXA6Wfi1@bccd%y6nfG&A{`bly@A8#&m0z zG)Vz1jEu174d74AgBh;KP^9fG+zQ}?U%M@Xh-Vkw{+hO`YM6?p*p%2Vqk521L4)rT zefo0h*=;z6rov5rBZl2jnCKdcDqKYfrtG!y*`?D)(4$RAD>-tIX4B}%9V^OlZswNi zZ!r?<9P|mt^-#^*T`L+re4YyhbeK`UszP;`oJtJ0RMkhC6NbWh&?EA{9i4J!*8qkN z%!TBcXI3a~deT^Cc_fhAF~4iAAiAerD%iUxxlpzNZqvVF+gqaq1&L!=k-z+g5HcF| zrjs!V3g-he)Rl0MZ%4T;dV&%AthI5Fo|_8H$&pi5^Vf~$f8CL1~m`^+H%uFFKd zYs)=IM|v9UKH|EgsQs3_pI-Dj`BmBh*C86)Dbk zfq8Acn^;g@OC!UUEZodIVL8U#SZP&mF&fQ6{^`r82WEq7^+Bb@1+pPZt}I(X2@awe zm6>mf4dpqtRqXZ{${9ZgW8FH=+uqBdVt|Q%j_+Mp~gL&0DV*LN|*l!+kmH z6hcT^bqP^cDO10Dz;^92b(J&`ghq1flV)je?6r6FLzvm7!pmsOIQ4jUuXE@^8se-` ymX+zKM`=>lamSKxZA~oZdNqf1t0)Api=S}!f!iP^h!6xH_`8xR!i0r_J&0Iy$>ah6 diff --git a/README.md b/README.md index 99d8d012..75ca0442 100644 --- a/README.md +++ b/README.md @@ -7,9 +7,9 @@ [![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/) -The [***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. +The [***FreesearchR***](https://app.freesearchr.org) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. -[***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is free and open-source, and is directly accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). The app can also run locally, please see below. +[***FreesearchR***](https://app.freesearchr.org) is free and open-source, and is [accessible in your web browser through this link](https://app.freesearchr.org). The app can also run locally, please see below. All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! @@ -25,7 +25,7 @@ This app has the following simple goals: 1. ease quick data overview and basic visualisations for any clinical researcher -## Run locally on your own machine +## Run locally on your own machine {#sec-run-locally} The ***FreesearchR*** app can also run on your own machine with no data transmitted anywhere. Any data.frame available in the global environment will be accessible from the interface. Just follow the below steps: diff --git a/SESSION.md b/SESSION.md index da151864..583ed1c4 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-05-08 | +|date |2025-05-10 | |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.5.2.250508 | +|quarto |1.7.30 @ /usr/local/bin/quarto | +|FreesearchR |25.5.3.250510 | -------------------------------------------------------------------------------- @@ -38,6 +38,7 @@ |cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) | +|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |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) | @@ -77,6 +78,7 @@ |htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | +|httr |1.4.7 |2023-08-15 |CRAN (R 4.4.0) | |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) | @@ -101,7 +103,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.15 |2025-04-25 |CRAN (R 4.4.1) | -|pak |0.8.0.2 |2025-04-08 |CRAN (R 4.4.1) | |parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | @@ -139,6 +140,7 @@ |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) | +|roxygen2 |7.3.2 |2024-06-28 |CRAN (R 4.4.0) | |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) | @@ -152,6 +154,7 @@ |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) | |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) | diff --git a/_pkgdown.yml b/_pkgdown.yml index 47ca9e1b..7391d304 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -11,7 +11,7 @@ template: # Adding the switch destroys the theme colors light-switch: false includes: - in_header: + in_header: navbar: bg: primary From a655dd3b8733d6726adddf9fc829b75725a153a4 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 11:31:26 +0200 Subject: [PATCH 3/7] polished import --- R/datagrid-infos-mod.R | 2 +- R/helpers.R | 14 ++++ inst/apps/FreesearchR/app.R | 136 +++++++++++++++++++++++------------- 3 files changed, 104 insertions(+), 48 deletions(-) diff --git a/R/datagrid-infos-mod.R b/R/datagrid-infos-mod.R index 1a250d77..8d898f77 100644 --- a/R/datagrid-infos-mod.R +++ b/R/datagrid-infos-mod.R @@ -35,7 +35,7 @@ show_data <- function(data, if (is.null(options)) options <- list() - options$height <- 550 + options$height <- 500 options$minBodyHeight <- 400 options$data <- data options$theme <- "default" diff --git a/R/helpers.R b/R/helpers.R index 377badb5..73129194 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -652,3 +652,17 @@ is_identical_to_previous <- function(data, no.name = TRUE) { } }, FUN.VALUE = logical(1)) } + + +#' Simplified version of the snakecase packages to_snake_case +#' +#' @param data character string vector +#' +#' @returns vector +#' @export +#' +#' @examples +#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake() +simple_snake <- function(data){ + gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE) +} diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index e9886d65..34302d27 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -2983,7 +2983,7 @@ show_data <- function(data, if (is.null(options)) options <- list() - options$height <- 550 + options$height <- 500 options$minBodyHeight <- 400 options$data <- data options$theme <- "default" @@ -3951,11 +3951,25 @@ is_identical_to_previous <- function(data, no.name = TRUE) { } +#' Simplified version of the snakecase packages to_snake_case +#' +#' @param data character string vector +#' +#' @returns vector +#' @export +#' +#' @examples +#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake() +simple_snake <- function(data){ + gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.5.2-250508' +hosted_version <- function()'v25.5.2-250510' ######## @@ -5566,9 +5580,12 @@ m_redcap_readServer <- function(id) { ) # browser() - shiny::withProgress({ - imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) - },message = paste("Connecting to",data_rv$uri)) + shiny::withProgress( + { + imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE) + }, + message = paste("Connecting to", data_rv$uri) + ) ## TODO: Simplify error messages if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { @@ -5594,7 +5611,7 @@ m_redcap_readServer <- function(id) { status = "success", include_data_alert( see_data_text = "Click to see data dictionary", - dataIdName = "see_data", + dataIdName = "see_dd", extra = tags$p( tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), glue::glue("The {data_rv$info$project_title} project is loaded.") @@ -5620,8 +5637,8 @@ m_redcap_readServer <- function(id) { output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) - shiny::observeEvent(input$see_data, { - datamods::show_data( + shiny::observeEvent(input$see_dd, { + show_data( purrr::pluck(data_rv$dd_list, "data"), title = "Data dictionary", type = "modal", @@ -5630,6 +5647,17 @@ m_redcap_readServer <- function(id) { ) }) + shiny::observeEvent(input$see_data, { + show_data( + # purrr::pluck(data_rv$dd_list, "data"), + data_rv$data, + title = "Imported data set", + type = "modal", + show_classes = FALSE, + tags$b("Preview:") + ) + }) + arms <- shiny::reactive({ shiny::req(input$api) shiny::req(data_rv$uri) @@ -5744,13 +5772,24 @@ m_redcap_readServer <- function(id) { imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) }) - code <- rlang::call2("read_redcap_tables", - !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")] + + code <- rlang::call2( + "easy_redcap", + !!!utils::modifyList( + parameters_code, + list( + data_format = ifelse( + input$data_type == "long" && !is.null(input$data_type), + "long", + "wide" + ), + project.name = simple_snake(data_rv$info$project_title) + ) + ), .ns = "REDCapCAST" ) - # browser() - if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL @@ -5819,9 +5858,17 @@ m_redcap_readServer <- function(id) { datamods:::insert_alert( selector = ns("retrieved"), status = data_rv$data_status, - tags$p( - tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), - data_rv$data_message + # tags$p( + # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + # data_rv$data_message + # ), + include_data_alert( + see_data_text = "Click to see the imported data", + dataIdName = "see_data", + extra = tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message) + ), + btn_show_data = TRUE ) ) } else { @@ -6022,13 +6069,6 @@ redcap_demo_app <- function() { } -######## -#### Current file: /Users/au301842/FreesearchR/R//redcap.R -######## - - - - ######## #### Current file: /Users/au301842/FreesearchR/R//regression_model.R ######## @@ -9317,10 +9357,10 @@ ui_elements <- list( condition = "input.source=='env'", import_globalenv_ui(id = "env", title = NULL) ), - shiny::conditionalPanel( - condition = "input.source=='redcap'", - DT::DTOutput(outputId = "redcap_prev") - ), + # shiny::conditionalPanel( + # condition = "input.source=='redcap'", + # DT::DTOutput(outputId = "redcap_prev") + # ), shiny::conditionalPanel( condition = "output.data_loaded == true", shiny::br(), @@ -9329,13 +9369,8 @@ ui_elements <- list( shiny::fluidRow( shiny::column( width = 6, + shiny::p("Filter by completeness threshold:"), shiny::br(), - shiny::p("Filter by completeness threshold and manual selection:"), - shiny::br(), - shiny::br() - ), - shiny::column( - width = 6, shinyWidgets::noUiSliderInput( inputId = "complete_cutoff", label = NULL, @@ -9348,12 +9383,17 @@ ui_elements <- list( color = datamods:::get_primary_color() ), shiny::helpText("Exclude variables with completeness below the specified percentage."), - shiny::br(), + shiny::br() + ), + shiny::column( + width = 6, + shiny::p("Specify manually:"), shiny::br(), shiny::uiOutput(outputId = "import_var"), - shiny::uiOutput(outputId = "data_info_import", inline = TRUE) + shiny::br() ) - ) + ), + shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ), shiny::br(), shiny::br(), @@ -9830,6 +9870,9 @@ ui <- bslib::page_fixed( #### Current file: /Users/au301842/FreesearchR/app/server.R ######## +library(shiny) +# library(shinyjs) +# library(methods) library(readr) library(MASS) library(stats) @@ -9837,7 +9880,6 @@ library(gt) # library(openxlsx2) library(haven) library(readODS) -require(shiny) library(bslib) library(assertthat) library(dplyr) @@ -9856,7 +9898,7 @@ library(shinyWidgets) library(DT) library(data.table) library(gtsummary) -library(shinyjs) +library(bsicons) data(starwars) data(mtcars) @@ -9864,8 +9906,8 @@ data(trial) load_data <- function() { Sys.sleep(1) - hide("loading_page") - show("main_content") + shinyjs::hide("loading_page") + shinyjs::show("main_content") } @@ -9946,14 +9988,14 @@ server <- function(input, output, session) { }) ## This is used to ensure the reactive data is retrieved - output$redcap_prev <- DT::renderDT( - { - DT::datatable(head(from_redcap$data(), 5), - caption = "First 5 observations" - ) - }, - server = TRUE - ) + # output$redcap_prev <- DT::renderDT( + # { + # DT::datatable(head(from_redcap$data(), 5), + # caption = "First 5 observations" + # ) + # }, + # server = TRUE + # ) from_env <- datamods::import_globalenv_server( id = "env", From 0c80bd2616fef6d5cb37970b55ac81d882727acf Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 11:37:03 +0200 Subject: [PATCH 4/7] ref --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 75ca0442..66297f9b 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ The [***FreesearchR***](https://app.freesearchr.org) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. -[***FreesearchR***](https://app.freesearchr.org) is free and open-source, and is [accessible in your web browser through this link](https://app.freesearchr.org). The app can also run locally, please see below. +[***FreesearchR***](https://app.freesearchr.org) is free and open-source, and is [accessible in your web browser through this link](https://app.freesearchr.org). The app can also run locally, please [see below](#run-locally-on-your-own-machine-sec-run-locally). All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! @@ -25,7 +25,7 @@ This app has the following simple goals: 1. ease quick data overview and basic visualisations for any clinical researcher -## Run locally on your own machine {#sec-run-locally} +## Run locally on your own machine The ***FreesearchR*** app can also run on your own machine with no data transmitted anywhere. Any data.frame available in the global environment will be accessible from the interface. Just follow the below steps: From d3819b786ed50a5857351a2796f0160d2fd45aec Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 13:01:48 +0200 Subject: [PATCH 5/7] omit missing --- R/plot_euler.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/plot_euler.R b/R/plot_euler.R index 4dff9de5..10156b74 100644 --- a/R/plot_euler.R +++ b/R/plot_euler.R @@ -87,10 +87,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) { out <- lapply(ds, \(.x){ .x[c(pri, sec)] |> as.data.frame() |> + na.omit() |> plot_euler_single() }) -# names(out) + # names(out) wrap_plot_list(out) # patchwork::wrap_plots(out, guides = "collect") } From d76c75bd93dd3773eb6ec850c3a12b9751f82708 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 13:02:04 +0200 Subject: [PATCH 6/7] quick additional update --- CITATION.cff | 2 +- DESCRIPTION | 2 +- NEWS.md | 10 +++ R/app_version.R | 2 +- R/contrast_text.R | 1 - R/create-column-mod.R | 14 +--- R/cut-variable-dates.R | 36 ++++----- R/data_plots.R | 1 + R/hosted_version.R | 2 +- R/plot_hbar.R | 5 +- R/plot_sankey.R | 5 +- R/regression_model.R | 9 ++- R/sysdata.rda | Bin 2152 -> 2271 bytes R/update-factor-ext.R | 6 +- R/update-variables-ext.R | 4 - SESSION.md | 20 ++++- inst/apps/FreesearchR/app.R | 157 +++++++++++++++++------------------- 17 files changed, 138 insertions(+), 138 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index 25ca71cb..f026dade 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -9,7 +9,7 @@ type: software license: AGPL-3.0-or-later title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers with publication ready output' -version: 25.5.3 +version: 25.5.4 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index be82a047..5a9123e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: A free and open-source browser based data analysis tool for researchers with publication ready output -Version: 25.5.3 +Version: 25.5.4 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NEWS.md b/NEWS.md index 9c02423f..5f097c19 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# FreesearchR 25.5.4 + +- *FIX* correctly omit NAs in `data_type()` call + +- *FIX* omit NAs when plotting Euler diagrams. + +- *FIX* print correct labels in horizontal stacked bars. + +- *FIX* initial app load should feel faster. + # FreesearchR 25.5.3 - *FIX* a little polish on the data import diff --git a/R/app_version.R b/R/app_version.R index ba85500f..5e843a23 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.3' +app_version <- function()'25.5.4' diff --git a/R/contrast_text.R b/R/contrast_text.R index 9ea4c5ba..1db2e562 100644 --- a/R/contrast_text.R +++ b/R/contrast_text.R @@ -25,7 +25,6 @@ #' contrast_text(c("#F2F2F2", "blue"), method="relative") #' @export #' -#' @importFrom grDevices col2rgb #' contrast_text <- function(background, light_text = 'white', diff --git a/R/create-column-mod.R b/R/create-column-mod.R index 9bb71c49..0bc24026 100644 --- a/R/create-column-mod.R +++ b/R/create-column-mod.R @@ -17,20 +17,17 @@ #' @export #' #' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput #' #' @name create-column #' #' @example examples/create_column_module_demo.R create_column_ui <- function(id) { ns <- NS(id) - tagList( + htmltools::tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + shiny::tags$head( + shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -84,7 +81,7 @@ create_column_ui <- function(id) { ) ) ), - textAreaInput( + shiny::textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -132,9 +129,6 @@ create_column_ui <- function(id) { #' #' @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()) { diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index d3f95eb5..9c78e73c 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -1,9 +1,3 @@ -library(datamods) -library(toastui) -library(phosphoricons) -library(rlang) -library(shiny) - #' Extended cutting function with fall-back to the native base::cut #' #' @param x an object inheriting from class "hms" @@ -212,9 +206,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), - label = i18n("Variable to cut:"), + label = datamods:::i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -227,7 +221,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = i18n("Number of breaks:"), + label = datamods:::i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -238,12 +232,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = i18n("Close intervals on the right"), + label = datamods:::i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = i18n("Include lowest value"), + label = datamods:::i18n("Include lowest value"), value = TRUE ) ) @@ -254,10 +248,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - datagridOutput2(outputId = ns("count")), + toastui::datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(ph("scissors"), i18n("Create factor variable")), + label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -288,7 +282,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { is.numeric(.x) || is_datetime(.x) }, logical(1)) vars_num <- names(vars_num)[vars_num] - updateVirtualSelect( + shinyWidgets::updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -325,9 +319,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - noUiSliderInput( + shinyWidgets::noUiSliderInput( inputId = session$ns("fixed_brks"), - label = i18n("Fixed breaks:"), + label = datamods:::i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -382,7 +376,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = i18n("Method:"), + label = datamods:::i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -525,7 +519,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- renderDatagrid2({ + output$count <- toastui::renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -541,14 +535,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- datagrid( + grid <- toastui::datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - grid_colorbar( + toastui::grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -576,7 +570,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = i18n("Convert Numeric to Factor"), + title = datamods:::i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { diff --git a/R/data_plots.R b/R/data_plots.R index 8401bf87..1b07f43b 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -681,6 +681,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) { #' mtcars |> get_label() #' mtcars$mpg |> get_label() #' gtsummary::trial |> get_label(var = "trt") +#' gtsummary::trial$trt |> get_label() #' 1:10 |> get_label() get_label <- function(data, var = NULL) { # data <- if (is.reactive(data)) data() else data diff --git a/R/hosted_version.R b/R/hosted_version.R index 9f191afd..596d4e21 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.3-250510' +hosted_version <- function()'v25.5.4-250510' diff --git a/R/plot_hbar.R b/R/plot_hbar.R index 84ead0da..deac70c0 100644 --- a/R/plot_hbar.R +++ b/R/plot_hbar.R @@ -62,9 +62,8 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label")) - group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label")) - + score_label <- data |> get_label(var = score) + group_label <- data |> get_label(var = group) p |> (\(.x){ diff --git a/R/plot_sankey.R b/R/plot_sankey.R index 473e7b77..c45d46f2 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -119,7 +119,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' plot_sankey_single("first", "last", color.group = "pri") #' mtcars |> #' default_parsing() |> -#' str() #' plot_sankey_single("cyl", "vs", color.group = "pri") plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) { color.group <- match.arg(color.group) @@ -132,8 +131,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co data <- data |> sankey_ready(pri = pri, sec = sec, ...) - library(ggalluvial) - na.color <- "#2986cc" box.color <- "#1E4B66" @@ -197,6 +194,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co ) } + ## Will fail to use stat="stratum" if library is not loaded. + library(ggalluvial) p + ggplot2::geom_text( stat = "stratum", diff --git a/R/regression_model.R b/R/regression_model.R index 252cbf16..df79cc16 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -271,12 +271,13 @@ data_type <- function(data) { sapply(data, data_type) } else { cl_d <- class(data) + l_unique <- length(unique(na.omit(data))) if (all(is.na(data))) { out <- "empty" - } else if (length(unique(data)) < 2) { + } else if (l_unique < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { - if (identical("logical", cl_d) | length(unique(data)) == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { + if (identical("logical", cl_d) | l_unique == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -289,7 +290,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (!length(unique(data)) == 2) { + } else if (l_unique > 2) { ## Previously had all thinkable classes ## Now just assumes the class has not been defined above ## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) & diff --git a/R/sysdata.rda b/R/sysdata.rda index 17176937b55b3e75ccefe450178e95d5e9a5a271..080cfc43cf6072f5714be37febe3ba7c56feec78 100644 GIT binary patch literal 2271 zcmV<52q5=DT4*^jL0KkKSyGRqIsg>O|Iq*cXaz!l|KNXb-@(8C|L{Nn5C8}P;0fOw zmm=fC)#;T^fF~2AAL2`(eFsxXf>gaP^n^mL%}f%4$Q# z!*irE(2v+%#nN=GrJ>Omc$8$wl2dWFBezp#676_WPAO`=wQt2tjAfk=}>Sx8o(CRK_e z18JBPH5A}GN`V!;(z1%yP3u|Z(4SS*OZQB$A5&Nm1M_G=5M_&rr21k0Zq+=Ct5-&ULY?SwE#kuM3JsV z5k-O|ycvnda`521a%sdJw#?H(1x#(Vw#bI5nVZQQQbU??tb!E{@fs63%}gB(#JD12 zc?^#9Qzv6YD1{18=;2h7L90>~<5)Q$OBSz>eVi2~vszNJsjE4l>0yiJ8aY^%F)d&L z$b=JXoKvJoHo6&7GISS(qkcdDW#uYe@iI2+RMI%jIPq(=y2@>=mwYO_aopc5)?=I) zTzAaK@DiHd)+B2rq#LqMnuZZ$T;g1^R&rwQxpc00}9e#{P(B}k;5w`^rZY_+zf$pEo& zB~V%K2fsV#7@Bo3vl)S_G-O~Ni)zT*ABv`OKu7>21xunP2$1e~4rT_KuD)>GLdvfB zO~?Rfp@LANwOpkJCA4XbuM%=(SrF!OVG2>Cv4Et@nHT6u&!e6I!?&PH!Z8LgQaud= zp3p5UEVHPSbd#&p=;+{3r7eA2#|EQHGK(n|UDJdxZKn-|8oGGPOV^s0;8uPS&-Ea= zBCbfH7LBQXmVl~C1gct4YJ!wQmz%8wSPC8gK1gCtn|rj)97Szc%<$~SDlAx$V90FB z$yZ@IQ>$zR7wfg=B}7w;19lnK>k z+g#Owfb}kCE{ZSnKN_ZHAZunIfCL;HsRQM|bO-=L*Wa##yJ$cG1J~)bbrWNMyR#94 zg_t$0N9E}Dj+}*ys!!r%WyhEO8WxRwz`*nMjpOt3`Ur@3dU?|%?;fvF1&YC62SSyR zCy?h=3~$*V)NYk>HBH znJ-S6s{CKeqLoS+)fK^G>wSfJ2$dt*O{HA*)llEk#Lg$w=&b7{#>Xeg;H4H5!#K6d z@wI{+5MwUETxFD0Z5-q+d0TD;nGj$sjjB;wA*ozvIF_y}a2I#d+ULYSS$)*pL07Mr z8m6-==YB(=7J3sAVzUG{XIantRCu#rCL!5##IQk@FV#jR9R2EMF`&$!s|~cm(R>>R z&gb$Sy!XtC3F48x7h1Mj8qL)OvQ1i^r%`%UMVEx)Y2ISOnP>~5(OcYkI=gQd^J>EjOi16?V8uvcFa>8C48$q8=eH65&2?g6?d7Kq z9}ejRK(o@y^wo=39tdu^}^&VsdI zT!qPaxzWVVh-5bHUHBN9i>pI3+O~FGpI+#EupF!5YGLo6PPnlo#`H7DAqFtIu&B+N z08l`X)4r#cMj6Z*{HX>+lq0aKQ44}kRKa!%)9@tvylfeQMy_Kf)Q}99B2hq1_);WC z5^_$B+;zUeII3erD;^ct(kL8zX}l1%<*}p}8h7VrE(60$;n;63GE98vIy8mqZD+#^ zD?)SOP|v#sz%x1HTEJmuwB3u@jV#t+=V5*>;!H%U#_PNu);T&Mlg^5WSSV?%i9Nl)yS+cC>eL42irGjR0 z4hO3K8Y@)nf&h?L70RsmYIfHF^`_o=8B)27EYqV`8-+00Xs*K6EuTcBow3Q&VV!7E-wH8 literal 2152 zcmV-u2$%OlT4*^jL0KkKS$(5h9Ni{ZrHp8fKtvKmY&$ z27mwqN`oUtng9bpXaF=cXfyx-GynuiO+>_-Ab`*`Jt3n&Gyni;pwYBI$$DJmCXq&Z z84U_sT7f{n0RcF_HZBoD>xf|S?&Zms0O1TgKOQa<7@r8HGD}j_FKkZb?7wSYMb3hN zCoTiOpx)m9R&7pK>eD-ag8tE}c(gn*OZ9&j1gG~L17E^0hR=29<;1`wK0KSq4jFJo zV>2>IP7-G>LJSsNp<5*N;AJQA`)~TN-3%{uhyV z?MoP0p8H+yl9_23y}H>w8H^Tr>t;Qqj)vw=)SqxDD))?X#nc@UQp{%4US3`DbbUp->f3{lOG9VhA^NB^YxGA(!X4Z1X@3Xehe+Jsf*=dqdx+08q)36*!16 zgn&pw42&Sb7L;053KUQUr2#={RHQ{vPF~LV&rvJN3rb#Q8_Fvf!JGs^xkO_3AQ*IK zT9XD_5mW^<(S^nmPcslRoi%hM)V1z4c!n65Ln*#ZX?D$FqVt=)Fc4DVB#f0467c73 zXE{|o>h36Pg+T@o#1Nr~qQM~tpd~q$Mp`NoDWVg))eIOS5=dC2JTw^ql0e+!?NXXe zQW5KUBU23YD&g3ua7QvzEC2wUK@kB6Xh_t}o6O?}2M-5^xK&YAbAb|S(&>{Jm`2kL zyRpqhGcL6Yb-dB133qokfh;0RNu7hCAqokc0Le_~q=7^P@+sXNWW+YT35JsuR8UAG zvr_n8YVn*_t{XVGy5X&jYfPB77|4>bjLSA~-6u)MzdKX@ZR6X=UteE`rIs|>0wN(56AVPb8V>_h zav)(0b}wxRN{Z^?stT&X0>ps@Vz(lVGDcfb-i{4Yl-DD5Xi-F=rXe8RS6s=r2R_Dn zur(+KqA-CNk}Stn7e1&6Mw)b@Ux4Z9W9HgaAkSXyv53MAL23e%RCkm$SdKfW)6v(l zdh!*E8e;aKJCIj$0ELFhev*KyNDe(4@cA|ji#8bbU{@xn4luq9^oW&xyVLCiX!@GjL|h+T9dGd^EIh&ilpF zP-?^^zJlzzzG!7&+N*R91VDgvwz-KxcnE<3a+H8 zBWgUn%A$PFQBqr7T~xp!uyrayqh>Qpj7E6}dfQ@`=O0e|UP$bczKS&`_|00fe;(B; zz|Ge#D<50udE!Dqtscv8opZY3)!TekSg%8j&Sbe>exEg{yr>lMYnAA01)LGHtWM}a zT67LH7Kh6F^_M^*Xf1}6mE}Ts)NE?s6+j4QO2wNyq4x@N5JctMOUlU6fYJ*Pq+ayG zkV7?dj}fz?IMyDuTY*-QY+1sEl7yXbt=DJ29hOG%iztH~#CP)C`bx367)eWziKVI9nQTAt7 z9gE%_w%NqDFvmwXDbt+nU`FNiym-S1$02YG(`X7vHVYTdH<5nSj`4im$`ds?L|ijd z4B{s!sW@X1LNq5N>d#IXNL6hni0>WCreV=LyVr;zd-k+~?z5{o>u?>`K0M9*Xr%eq z(_SlNkA|!6LUZ8}pZAL53Y#rb0*h?(Q?ZJI^Y(DANuu}wS0+TzfKh$ztOfv%xYIw@`tTHx7I?u?zSlOe=7 z9cSs$n5-}aC6_KXGpb<0Z%n#!3~63LZBpGHbc)_|2h6MxG|4Hdg6?n)>*=H5L~20; zHSOO=4RFWRHDlQP$$4fq?Hclb9)9)BbVyOD>q^GGwC9L^(v6AS@zr#_PFb#W(F%Ck euvLY$i+4!i1GYe3suTqu@pmLsg$W1cPriVyzRTYL diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R index a3943495..3fd4719e 100644 --- a/R/update-factor-ext.R +++ b/R/update-factor-ext.R @@ -31,7 +31,7 @@ update_factor_ui <- function(id) { fluidRow( column( width = 6, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -66,10 +66,10 @@ update_factor_ui <- function(id) { ) ) ), - datagridOutput(ns("grid")), + toastui::datagridOutput(ns("grid")), tags$div( class = "float-end", - prettyCheckbox( + shinyWidgets::prettyCheckbox( inputId = ns("new_var"), label = i18n("Create a new variable (otherwise replaces the one selected)"), value = FALSE, diff --git a/R/update-variables-ext.R b/R/update-variables-ext.R index eb20a11a..dbc64f8a 100644 --- a/R/update-variables-ext.R +++ b/R/update-variables-ext.R @@ -1,7 +1,3 @@ -library(data.table) -library(rlang) - - #' Select, rename and convert variables #' #' @param id Module id. See [shiny::moduleServer()]. diff --git a/SESSION.md b/SESSION.md index 583ed1c4..dc20f495 100644 --- a/SESSION.md +++ b/SESSION.md @@ -15,7 +15,7 @@ |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |25.5.3.250510 | +|FreesearchR |25.5.4.250510 | -------------------------------------------------------------------------------- @@ -38,14 +38,12 @@ |cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) | -|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |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) | |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) | @@ -60,6 +58,7 @@ |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) | +|eulerr |7.0.2 |2024-03-28 |CRAN (R 4.4.0) | |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) | @@ -67,8 +66,11 @@ |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) | +|ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.4.0) | +|ggforce |0.4.2 |2024-02-19 |CRAN (R 4.4.0) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | +|gridExtra |2.3 |2017-09-09 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | |gtsummary |2.2.0 |2025-04-14 |CRAN (R 4.4.1) | @@ -78,7 +80,6 @@ |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) | -|httr |1.4.7 |2023-08-15 |CRAN (R 4.4.0) | |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) | @@ -87,6 +88,7 @@ |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) | +|labeling |0.4.3 |2023-08-29 |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) | @@ -111,6 +113,8 @@ |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) | +|polyclip |1.10-7 |2024-07-23 |CRAN (R 4.4.1) | +|polylabelr |0.3.0 |2024-11-19 |CRAN (R 4.4.1) | |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) | @@ -123,6 +127,8 @@ |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) | +|ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) | +|rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) | |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) | @@ -156,15 +162,21 @@ |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | |stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) | |styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) | +|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) | +|tweenr |2.0.3 |2024-02-26 |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) | +|utf8 |1.2.4 |2023-10-22 |CRAN (R 4.4.1) | |V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) | +|viridis |0.6.5 |2024-01-29 |CRAN (R 4.4.0) | +|viridisLite |0.4.2 |2023-05-02 |CRAN (R 4.4.1) | |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) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 34302d27..7dff7246 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,5 +1,44 @@ +######## +#### Current file: /Users/au301842/FreesearchR/app/libs.R +######## + +library(shiny) +# library(shinyjs) +# library(methods) +# library(readr) +# library(MASS) +# library(stats) +# library(gt) +# library(openxlsx2) +# library(haven) +# library(readODS) +# library(bslib) +# library(assertthat) +# library(dplyr) +# library(quarto) +# library(here) +# library(broom) +# library(broom.helpers) +# library(easystats) +# library(patchwork) +# library(DHARMa) +# library(apexcharter) +library(toastui) +# library(datamods) +# library(IDEAFilter) +library(shinyWidgets) +# library(DT) +# library(data.table) +# library(gtsummary) +library(bsicons) +library(rlang) +# library(datamods) +# library(toastui) +# library(phosphoricons) + + ######## #### Current file: /Users/au301842/FreesearchR/app/functions.R ######## @@ -10,7 +49,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'25.5.2' +app_version <- function()'25.5.3' ######## @@ -129,7 +168,6 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS #' contrast_text(c("#F2F2F2", "blue"), method="relative") #' @export #' -#' @importFrom grDevices col2rgb #' contrast_text <- function(background, light_text = 'white', @@ -323,20 +361,17 @@ sentence_paste <- function(data, and.str = "and") { #' @export #' #' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput #' #' @name create-column #' #' @example examples/create_column_module_demo.R create_column_ui <- function(id) { ns <- NS(id) - tagList( + htmltools::tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + shiny::tags$head( + shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -390,7 +425,7 @@ create_column_ui <- function(id) { ) ) ), - textAreaInput( + shiny::textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -438,9 +473,6 @@ create_column_ui <- function(id) { #' #' @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()) { @@ -947,12 +979,6 @@ vectorSelectInput <- function(inputId, #### Current file: /Users/au301842/FreesearchR/R//cut-variable-dates.R ######## -library(datamods) -library(toastui) -library(phosphoricons) -library(rlang) -library(shiny) - #' Extended cutting function with fall-back to the native base::cut #' #' @param x an object inheriting from class "hms" @@ -1161,9 +1187,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), - label = i18n("Variable to cut:"), + label = datamods:::i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -1176,7 +1202,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = i18n("Number of breaks:"), + label = datamods:::i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -1187,12 +1213,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = i18n("Close intervals on the right"), + label = datamods:::i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = i18n("Include lowest value"), + label = datamods:::i18n("Include lowest value"), value = TRUE ) ) @@ -1203,10 +1229,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - datagridOutput2(outputId = ns("count")), + toastui::datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(ph("scissors"), i18n("Create factor variable")), + label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -1237,7 +1263,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { is.numeric(.x) || is_datetime(.x) }, logical(1)) vars_num <- names(vars_num)[vars_num] - updateVirtualSelect( + shinyWidgets::updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -1274,9 +1300,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - noUiSliderInput( + shinyWidgets::noUiSliderInput( inputId = session$ns("fixed_brks"), - label = i18n("Fixed breaks:"), + label = datamods:::i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -1331,7 +1357,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = i18n("Method:"), + label = datamods:::i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -1474,7 +1500,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- renderDatagrid2({ + output$count <- toastui::renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -1490,14 +1516,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- datagrid( + grid <- toastui::datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - grid_colorbar( + toastui::grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -1525,7 +1551,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = i18n("Convert Numeric to Factor"), + title = datamods:::i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { @@ -2255,6 +2281,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) { #' mtcars |> get_label() #' mtcars$mpg |> get_label() #' gtsummary::trial |> get_label(var = "trt") +#' gtsummary::trial$trt |> get_label() #' 1:10 |> get_label() get_label <- function(data, var = NULL) { # data <- if (is.reactive(data)) data() else data @@ -3969,7 +3996,7 @@ simple_snake <- function(data){ #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.5.2-250510' +hosted_version <- function()'v25.5.3-250510' ######## @@ -4807,10 +4834,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) { out <- lapply(ds, \(.x){ .x[c(pri, sec)] |> as.data.frame() |> + na.omit() |> plot_euler_single() }) -# names(out) + # names(out) wrap_plot_list(out) # patchwork::wrap_plots(out, guides = "collect") } @@ -4922,9 +4950,8 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label")) - group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label")) - + score_label <- data |> get_label(var = score) + group_label <- data |> get_label(var = group) p |> (\(.x){ @@ -5114,7 +5141,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' plot_sankey_single("first", "last", color.group = "pri") #' mtcars |> #' default_parsing() |> -#' str() #' plot_sankey_single("cyl", "vs", color.group = "pri") plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) { color.group <- match.arg(color.group) @@ -5127,8 +5153,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co data <- data |> sankey_ready(pri = pri, sec = sec, ...) - library(ggalluvial) - na.color <- "#2986cc" box.color <- "#1E4B66" @@ -5192,6 +5216,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co ) } + ## Will fail to use stat="stratum" if library is not loaded. + library(ggalluvial) p + ggplot2::geom_text( stat = "stratum", @@ -6346,12 +6372,13 @@ data_type <- function(data) { sapply(data, data_type) } else { cl_d <- class(data) + l_unique <- length(unique(na.omit(data))) if (all(is.na(data))) { out <- "empty" - } else if (length(unique(data)) < 2) { + } else if (l_unique < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { - if (identical("logical", cl_d) | length(unique(data)) == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { + if (identical("logical", cl_d) | l_unique == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -6364,7 +6391,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (!length(unique(data)) == 2) { + } else if (l_unique > 2) { ## Previously had all thinkable classes ## Now just assumes the class has not been defined above ## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) & @@ -8039,7 +8066,7 @@ update_factor_ui <- function(id) { fluidRow( column( width = 6, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -8074,10 +8101,10 @@ update_factor_ui <- function(id) { ) ) ), - datagridOutput(ns("grid")), + toastui::datagridOutput(ns("grid")), tags$div( class = "float-end", - prettyCheckbox( + shinyWidgets::prettyCheckbox( inputId = ns("new_var"), label = i18n("Create a new variable (otherwise replaces the one selected)"), value = FALSE, @@ -8303,10 +8330,6 @@ winbox_update_factor <- function(id, #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R ######## -library(data.table) -library(rlang) - - #' Select, rename and convert variables #' #' @param id Module id. See [shiny::moduleServer()]. @@ -9870,35 +9893,7 @@ ui <- bslib::page_fixed( #### Current file: /Users/au301842/FreesearchR/app/server.R ######## -library(shiny) -# library(shinyjs) -# library(methods) -library(readr) -library(MASS) -library(stats) -library(gt) -# library(openxlsx2) -library(haven) -library(readODS) -library(bslib) -library(assertthat) -library(dplyr) -library(quarto) -library(here) -library(broom) -library(broom.helpers) -library(easystats) -library(patchwork) -library(DHARMa) -library(apexcharter) -library(toastui) -library(datamods) -library(IDEAFilter) -library(shinyWidgets) -library(DT) -library(data.table) -library(gtsummary) -library(bsicons) + data(starwars) data(mtcars) From 2a39655e96bbbafbd60486797311720c7399ffcc Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 13:02:31 +0200 Subject: [PATCH 7/7] docs --- NAMESPACE | 7 ------- man/cut-variable.Rd | 2 +- man/get_label.Rd | 1 + man/plot_sankey_single.Rd | 1 - 4 files changed, 2 insertions(+), 9 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e51e611a..cbc6d0ec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -131,7 +131,6 @@ export(write_quarto) importFrom(classInt,classIntervals) importFrom(data.table,as.data.table) importFrom(data.table,data.table) -importFrom(grDevices,col2rgb) importFrom(graphics,abline) importFrom(graphics,axis) importFrom(graphics,hist) @@ -142,7 +141,6 @@ importFrom(htmltools,css) importFrom(htmltools,tagList) importFrom(htmltools,tags) importFrom(htmltools,validateCssUnit) -importFrom(phosphoricons,ph) importFrom(rlang,"%||%") importFrom(rlang,call2) importFrom(rlang,expr) @@ -161,25 +159,20 @@ 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/man/cut-variable.Rd b/man/cut-variable.Rd index 6403fa7f..67a125cd 100644 --- a/man/cut-variable.Rd +++ b/man/cut-variable.Rd @@ -13,7 +13,7 @@ cut_variable_server(id, data_r = reactive(NULL)) modal_cut_variable( id, - title = i18n("Convert Numeric to Factor"), + title = datamods:::i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL diff --git a/man/get_label.Rd b/man/get_label.Rd index 59643d65..c4484304 100644 --- a/man/get_label.Rd +++ b/man/get_label.Rd @@ -22,5 +22,6 @@ mtcars |> get_label(var = "mpg") mtcars |> get_label() mtcars$mpg |> get_label() gtsummary::trial |> get_label(var = "trt") +gtsummary::trial$trt |> get_label() 1:10 |> get_label() } diff --git a/man/plot_sankey_single.Rd b/man/plot_sankey_single.Rd index 6b2e7888..83742a75 100644 --- a/man/plot_sankey_single.Rd +++ b/man/plot_sankey_single.Rd @@ -39,6 +39,5 @@ data.frame( plot_sankey_single("first", "last", color.group = "pri") mtcars |> default_parsing() |> - str() plot_sankey_single("cyl", "vs", color.group = "pri") }