diff --git a/NAMESPACE b/NAMESPACE index f644c44..186ab21 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 dd1a24f..c99b806 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 b354401..953abda 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/SESSION.md b/SESSION.md index 46f2bfb..f0c8047 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 33e0230..6db32fd 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 89e5ac2..54b1e10 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 ea8a2b7..b6c78d2 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 ddb2681..0ce31ef 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(),