session updated

.Rbuildignore

@@ -13,3 +13,5 @@
 ^pkgdown$
 ^data-raw$
 ^CITATION\.cff$
+^app_hosted$
+^app$

.gitignore

@@ -10,3 +10,5 @@ inst/shiny-examples/casting/functions.R
 functions.R
 docs
 inst/doc
+app_hosted
+app

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.4.4
+version: 25.4.5
 doi: 10.5281/zenodo.14527429
 abstract: Easily evaluate and analysis clinical health data in your browser on a server
   or on your own device. Import data from multiple sources, summarise, modify and

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.4.4
+Version: 25.4.5
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),

NEWS.md

@@ -1,3 +1,11 @@
+# FreesearchR 25.4.5
+
+- *BUG*: Regression results and code not returned correctly
+
+- *IMPROVED*: analyses results are reset on data change
+
+- *NEW*: app usage tracking only in hosted app. README updated to reflect.
+ 
 # FreesearchR 25.4.4
 
 Minor updates in docs and easier citation.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'v25.4.4.250429'
+app_version <- function()'v25.4.5.250430'

R/data_plots.R

@@ -351,9 +351,25 @@ data_visuals_server <- function(id,
         prismCodeBlock(paste0("#Plotting\n", rv$code))
       })
 
+      shiny::observeEvent(
+        list(
+          data()
+        ),
+        {
+          shiny::req(data())
+
+          rv$plot <- NULL
+        }
+      )
+
       output$plot <- shiny::renderPlot({
-        shiny::req(rv$plot)
+        # shiny::req(rv$plot)
-        rv$plot
+        # rv$plot
+        if (!is.null(rv$plot)) {
+          rv$plot
+        } else {
+          return(NULL)
+        }
       })
 
       output$download_plot <- shiny::downloadHandler(

R/regression-module.R

@@ -331,10 +331,10 @@ regression_server <- function(id,
                 "Multivariable" = "regression_model_list"
               ) |>
                 lapply(\(.fun){
-                  parameters=list(
+                  parameters <- list(
                     data = data_r()[regression_vars()],
-                  outcome.str = input$outcome_var,
+                    outcome.str = input$outcome_var,
-              fun.descr = input$regression_type
+                    fun.descr = input$regression_type
                   )
 
                   do.call(
@@ -413,49 +413,68 @@ regression_server <- function(id,
           shiny::req(rv$check_plot)
           shiny::req(input$plot_checks)
 
-          p <- rv$check_plot() +
+          ## Print checks if a regression table is present
-            # patchwork::wrap_plots() +
+          if (!is.null(rv$list$regression$tables)) {
-            patchwork::plot_annotation(title = "Multivariable regression model checks")
+            p <- rv$check_plot() +
+              # patchwork::wrap_plots() +
+              patchwork::plot_annotation(title = "Multivariable regression model checks")
 
 
-          layout <- sapply(seq_len(length(p)), \(.x){
+            layout <- sapply(seq_len(length(p)), \(.x){
-            patchwork::area(.x, 1)
+              patchwork::area(.x, 1)
-          })
-
-          out <- p + patchwork::plot_layout(design = Reduce(c, layout))
-
-          index <- match(
-            input$plot_checks,
-            sapply(rv$check_plot(), \(.i){
-              get_ggplot_label(.i, "title")
             })
-          )
 
-          ls <- list()
+            p_list <- p + patchwork::plot_layout(design = Reduce(c, layout))
 
-          for (i in index) {
+            index <- match(
-            p <- out[[i]] +
+              input$plot_checks,
-              ggplot2::theme(axis.text = ggplot2::element_text(size = 10),
+              sapply(rv$check_plot(), \(.i){
-                             axis.title = ggplot2::element_text(size = 12),
+                get_ggplot_label(.i, "title")
-                             legend.text = ggplot2::element_text(size = 12),
+              })
-                             plot.subtitle = ggplot2::element_text(size = 12),
+            )
-                             plot.title = ggplot2::element_text(size = 18))
+
-            ls <- c(ls, list(p))
+            ls <- list()
-          }
+
-          # browser()
+            for (i in index) {
-          tryCatch(
+              p <- p_list[[i]] +
-            {
+                ggplot2::theme(
-              patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
+                  axis.text = ggplot2::element_text(size = 10),
-            },
+                  axis.title = ggplot2::element_text(size = 12),
-            error = function(err) {
+                  legend.text = ggplot2::element_text(size = 12),
-              showNotification(err, type = "err")
+                  plot.subtitle = ggplot2::element_text(size = 12),
+                  plot.title = ggplot2::element_text(size = 18)
+                )
+              ls <- c(ls, list(p))
             }
-          )
+            # browser()
+            tryCatch(
+              {
+                out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
+              },
+              error = function(err) {
+                showNotification(err, type = "err")
+              }
+            )
+
+            out
+          } else {
+            return(NULL)
+          }
         },
         alt = "Assumptions testing of the multivariable regression model"
       )
 
-### Creating the regression table
+      shiny::observeEvent(
+        list(
+          data_r(),
+          regression_vars()
+        ),
+        {
+          rv$list$regression$tables <- NULL
+        }
+      )
+
+      ### Creating the regression table
       shiny::observeEvent(
         input$load,
         {
@@ -463,6 +482,7 @@ regression_server <- function(id,
           ## To avoid plotting old models on fail/error
           rv$list$regression$tables <- NULL
 
+          # browser()
           tryCatch(
             {
               parameters <- list(
@@ -475,9 +495,9 @@ regression_server <- function(id,
                 purrr::map(\(.x){
                   do.call(
                     regression_table,
-                    append_list(.x,parameters,"x")
+                    append_list(.x, parameters, "x")
                   )
-})
+                })
 
               # if (input$add_regression_p == "no") {
               #   out <- out |>
@@ -490,23 +510,17 @@ regression_server <- function(id,
               # }
 
               rv$list$regression$models |>
-                purrr::imap(\(.x,.i){
+                purrr::imap(\(.x, .i){
                   rv$list$regression$models[[.i]][["code_table"]] <- paste(
-                  .x$code,
+                    .x$code,
-                  expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n")
+                    expression_string(rlang::call2(.fn = "regression_table", !!!parameters, .ns = "FreesearchR"), assign.str = NULL),
+                    sep = "|>\n"
+                  )
                 })
 
-              list(
-                rv$code$import,
-                rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
-                rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
-              ) |>
-                merge_expression() |>
-                expression_string()
-
               rv$list$regression$tables <- out
-
               rv$list$input <- input
+
             },
             warning = function(warn) {
               showNotification(paste0(warn), type = "warning")
@@ -519,11 +533,15 @@ regression_server <- function(id,
       )
 
       output$table2 <- gt::render_gt({
-        shiny::req(rv$list$regression$tables)
+        ## Print checks if a regression table is present
-        rv$list$regression$tables |>
+        if (!is.null(rv$list$regression$tables)) {
-          tbl_merge() |>
+          rv$list$regression$tables |>
-          gtsummary::as_gt() |>
+            tbl_merge() |>
-          gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
+            gtsummary::as_gt() |>
+            gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
+        } else {
+          return(NULL)
+        }
       })
 
       ##############################################################################
@@ -614,10 +632,8 @@ regression_server <- function(id,
       ##############################################################################
 
       return(shiny::reactive({
-        return(rv$list)
+          rv$list
       }))
     }
   )
 }
-
-

R/theme.R

@@ -54,7 +54,7 @@ FreesearchR_colors <- function(choose = NULL) {
     fg = "#000000"
   )
   if (!is.null(choose)) {
-    out[choose]
+    unname(out[choose])
   } else {
     out
   }

README.md

@@ -23,23 +23,27 @@ This app has the following simple goals:
 
 1.   ease quick data overview and basic visualisations for any clinical researcher
 
-## Install locally
+## Run locally on your own machine
 
-The ***FreesearchR***-tool can also be launched locally. Any data.frame available in the global environment will be accessible from the interface.
+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:
 
-```
+1.   **Requirement:** You need to have [*R* installed](https://www.r-project.org/) and possibly an editor like [RStudio](https://posit.co/download/rstudio-desktop/). 
-require("devtools")
+
-devtools::install_github("agdamsbo/FreesearchR")
+1.   Then open the *R* console and copy/paste the following code, that will install the `{devtools}` package and then the `{FreesearchR}` *R*-package with its dependencies:
-library(FreesearchR)
+
-# By loading mtcars to the environment, it will be available 
+     ```
-# in the interface like any other data.frame
+     require("devtools")
-data(mtcars) 
+     devtools::install_github("agdamsbo/FreesearchR")
-launch_FreesearchR()
+     library(FreesearchR)
-```
+     # By loading mtcars to the environment, it will be available 
+     # in the interface like any other data.frame
+     data(mtcars) 
+     launch_FreesearchR()
+     ```
 
 ## Code of Conduct
 
-Please note that the ***FreesearchR*** project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms.
+Please note that the ***FreesearchR*** project is published with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms.
 
 ## Acknowledgements
 
@@ -56,3 +60,5 @@ Like any other project, this project was never possible without the great work o
 -   [IDEAfilter](https://biogen-inc.github.io/IDEAFilter/): a visually appealing data filter function based on the [{shinyDataFilter}](https://github.com/dgkf/shinyDataFilter).
 
 This project was all written by a human and not by any AI-based tools.
+
+The online ***FreesearchR*** app contains a tracking script, transmitting minimal data on usage. No uploaded data is transmitted anywhere. Have a look at the [tracking data here](https://analytics.gdamsbo.dk/share/2i4BNpMcDMB9lJvF/agdamsbo.shinyapps.io). No tracking data is sent running the app locally (see above).

SESSION.md

@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2025-04-29                                 |
+|date        |2025-04-30                                 |
 |rstudio     |2024.12.1+563 Kousa Dogwood (desktop)      |
 |pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
 |quarto      |1.6.40 @ /usr/local/bin/quarto             |
-|FreesearchR |25.4.4.250429                              |
+|FreesearchR |25.4.5.250430                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -24,8 +24,10 @@
 |package       |loadedversion |date       |source         |
 |:-------------|:-------------|:----------|:--------------|
 |apexcharter   |0.4.4         |2024-09-06 |CRAN (R 4.4.1) |
+|askpass       |1.2.1         |2024-10-04 |CRAN (R 4.4.1) |
 |assertthat    |0.2.1         |2019-03-21 |CRAN (R 4.4.1) |
 |backports     |1.5.0         |2024-05-23 |CRAN (R 4.4.1) |
+|base64enc     |0.1-3         |2015-07-28 |CRAN (R 4.4.1) |
 |bayestestR    |0.15.3        |2025-04-28 |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) |
@@ -35,14 +37,21 @@
 |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) |
+|cards         |0.6.0         |2025-04-11 |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) |
+|cluster       |2.1.8.1       |2025-03-12 |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) |
+|credentials   |2.0.2         |2024-10-04 |CRAN (R 4.4.1) |
 |crosstalk     |1.2.1         |2023-11-23 |CRAN (R 4.4.0) |
+|curl          |6.2.2         |2025-03-24 |CRAN (R 4.4.1) |
 |data.table    |1.17.0        |2025-02-22 |CRAN (R 4.4.1) |
 |datamods      |1.5.3         |2024-10-02 |CRAN (R 4.4.1) |
 |datawizard    |1.0.2         |2025-03-24 |CRAN (R 4.4.1) |
@@ -61,30 +70,47 @@
 |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) |
+|foreign       |0.8-90        |2025-03-31 |CRAN (R 4.4.1) |
+|Formula       |1.2-5         |2023-02-24 |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) |
+|gert          |2.1.5         |2025-03-25 |CRAN (R 4.4.1) |
+|ggcorrplot    |0.1.4.1       |2023-09-05 |CRAN (R 4.4.0) |
 |ggplot2       |3.5.2         |2025-04-09 |CRAN (R 4.4.1) |
+|ggstats       |0.9.0         |2025-03-10 |CRAN (R 4.4.1) |
+|gh            |1.4.1         |2024-03-28 |CRAN (R 4.4.0) |
+|gitcreds      |0.1.2         |2022-09-08 |CRAN (R 4.4.1) |
 |glue          |1.8.0         |2024-09-30 |CRAN (R 4.4.1) |
+|gridExtra     |2.3           |2017-09-09 |CRAN (R 4.4.1) |
 |gt            |1.0.0         |2025-04-05 |CRAN (R 4.4.1) |
 |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) |
+|Hmisc         |5.2-3         |2025-03-16 |CRAN (R 4.4.1) |
 |hms           |1.1.3         |2023-03-21 |CRAN (R 4.4.0) |
+|htmlTable     |2.4.3         |2024-07-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) |
+|httr2         |1.1.2         |2025-03-26 |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) |
+|jsonvalidate  |1.5.0         |2025-02-07 |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) |
+|labeling      |0.4.3         |2023-08-29 |CRAN (R 4.4.1) |
+|labelled      |2.14.0        |2025-01-08 |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) |
+|litedown      |0.7           |2025-04-08 |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) |
+|markdown      |2.0           |2025-03-23 |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) |
@@ -94,6 +120,9 @@
 |modelbased    |0.10.0        |2025-03-10 |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) |
+|nnet          |7.3-20        |2025-01-01 |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) |
 |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) |
@@ -102,6 +131,7 @@
 |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) |
+|plyr          |1.8.9         |2023-10-02 |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) |
@@ -109,7 +139,13 @@
 |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) |
+|ragg          |1.4.0         |2025-04-10 |CRAN (R 4.4.1) |
+|rappdirs      |0.3.3         |2021-01-31 |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) |
@@ -118,13 +154,17 @@
 |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) |
+|reshape2      |1.4.4         |2020-04-09 |CRAN (R 4.4.0) |
 |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) |
+|rpart         |4.1.24        |2025-01-07 |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) |
@@ -136,6 +176,12 @@
 |shinybusy     |0.3.3         |2024-03-09 |CRAN (R 4.4.0) |
 |shinyTime     |1.0.3         |2022-08-19 |CRAN (R 4.4.0) |
 |shinyWidgets  |0.9.0         |2025-02-21 |CRAN (R 4.4.1) |
+|stringi       |1.8.7         |2025-03-27 |CRAN (R 4.4.1) |
+|stringr       |1.5.1         |2023-11-14 |CRAN (R 4.4.0) |
+|styler        |1.10.3        |2024-04-07 |CRAN (R 4.4.0) |
+|sys           |3.4.3         |2024-10-04 |CRAN (R 4.4.1) |
+|systemfonts   |1.2.2         |2025-04-04 |CRAN (R 4.4.1) |
+|textshaping   |1.0.0         |2025-01-20 |CRAN (R 4.4.1) |
 |tibble        |3.2.1         |2023-03-20 |CRAN (R 4.4.0) |
 |tidyr         |1.3.1         |2024-01-24 |CRAN (R 4.4.1) |
 |tidyselect    |1.2.1         |2024-03-11 |CRAN (R 4.4.0) |
@@ -143,6 +189,7 @@
 |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) |
+|V8            |6.0.3         |2025-03-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) |
@@ -151,3 +198,4 @@
 |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) |

inst/apps/FreesearchR/app.R

@@ -1,7 +1,7 @@
 
 
 ########
-#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/functions.R 
+#### Current file: /Users/au301842/FreesearchR/app/functions.R 
 ########
 
 
@@ -10,7 +10,7 @@
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'v25.4.4.250429'
+app_version <- function()'v25.4.4.250430'
 
 
 ########
@@ -1925,9 +1925,25 @@ data_visuals_server <- function(id,
         prismCodeBlock(paste0("#Plotting\n", rv$code))
       })
 
+      shiny::observeEvent(
+        list(
+          data()
+        ),
+        {
+          shiny::req(data())
+
+          rv$plot <- NULL
+        }
+      )
+
       output$plot <- shiny::renderPlot({
-        shiny::req(rv$plot)
+        # shiny::req(rv$plot)
-        rv$plot
+        # rv$plot
+        if (!is.null(rv$plot)) {
+          rv$plot
+        } else {
+          return(NULL)
+        }
       })
 
       output$download_plot <- shiny::downloadHandler(
@@ -7370,10 +7386,10 @@ regression_server <- function(id,
                 "Multivariable" = "regression_model_list"
               ) |>
                 lapply(\(.fun){
-                  parameters=list(
+                  parameters <- list(
                     data = data_r()[regression_vars()],
-                  outcome.str = input$outcome_var,
+                    outcome.str = input$outcome_var,
-              fun.descr = input$regression_type
+                    fun.descr = input$regression_type
                   )
 
                   do.call(
@@ -7452,49 +7468,67 @@ regression_server <- function(id,
           shiny::req(rv$check_plot)
           shiny::req(input$plot_checks)
 
-          p <- rv$check_plot() +
+          ## Print checks if a regression table is present
-            # patchwork::wrap_plots() +
+          if (!is.null(rv$list$regression$tables)) {
-            patchwork::plot_annotation(title = "Multivariable regression model checks")
+            p <- rv$check_plot() +
+              # patchwork::wrap_plots() +
+              patchwork::plot_annotation(title = "Multivariable regression model checks")
 
 
-          layout <- sapply(seq_len(length(p)), \(.x){
+            layout <- sapply(seq_len(length(p)), \(.x){
-            patchwork::area(.x, 1)
+              patchwork::area(.x, 1)
-          })
-
-          out <- p + patchwork::plot_layout(design = Reduce(c, layout))
-
-          index <- match(
-            input$plot_checks,
-            sapply(rv$check_plot(), \(.i){
-              get_ggplot_label(.i, "title")
             })
-          )
 
-          ls <- list()
+            p_list <- p + patchwork::plot_layout(design = Reduce(c, layout))
 
-          for (i in index) {
+            index <- match(
-            p <- out[[i]] +
+              input$plot_checks,
-              ggplot2::theme(axis.text = ggplot2::element_text(size = 10),
+              sapply(rv$check_plot(), \(.i){
-                             axis.title = ggplot2::element_text(size = 12),
+                get_ggplot_label(.i, "title")
-                             legend.text = ggplot2::element_text(size = 12),
+              })
-                             plot.subtitle = ggplot2::element_text(size = 12),
+            )
-                             plot.title = ggplot2::element_text(size = 18))
+
-            ls <- c(ls, list(p))
+            ls <- list()
-          }
+
-          # browser()
+            for (i in index) {
-          tryCatch(
+              p <- p_list[[i]] +
-            {
+                ggplot2::theme(
-              patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
+                  axis.text = ggplot2::element_text(size = 10),
-            },
+                  axis.title = ggplot2::element_text(size = 12),
-            error = function(err) {
+                  legend.text = ggplot2::element_text(size = 12),
-              showNotification(err, type = "err")
+                  plot.subtitle = ggplot2::element_text(size = 12),
+                  plot.title = ggplot2::element_text(size = 18)
+                )
+              ls <- c(ls, list(p))
             }
-          )
+            # browser()
+            tryCatch(
+              {
+                out <- patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
+              },
+              error = function(err) {
+                showNotification(err, type = "err")
+              }
+            )
+
+            out
+          } else {
+            return(NULL)
+          }
         },
         alt = "Assumptions testing of the multivariable regression model"
       )
 
-### Creating the regression table
+      shiny::observeEvent(
+        list(
+          data_r()
+        ),
+        {
+          rv$list$regression$tables <- NULL
+        }
+      )
+
+      ### Creating the regression table
       shiny::observeEvent(
         input$load,
         {
@@ -7502,6 +7536,7 @@ regression_server <- function(id,
           ## To avoid plotting old models on fail/error
           rv$list$regression$tables <- NULL
 
+          # browser()
           tryCatch(
             {
               parameters <- list(
@@ -7514,9 +7549,9 @@ regression_server <- function(id,
                 purrr::map(\(.x){
                   do.call(
                     regression_table,
-                    append_list(.x,parameters,"x")
+                    append_list(.x, parameters, "x")
                   )
-})
+                })
 
               # if (input$add_regression_p == "no") {
               #   out <- out |>
@@ -7529,23 +7564,17 @@ regression_server <- function(id,
               # }
 
               rv$list$regression$models |>
-                purrr::imap(\(.x,.i){
+                purrr::imap(\(.x, .i){
                   rv$list$regression$models[[.i]][["code_table"]] <- paste(
-                  .x$code,
+                    .x$code,
-                  expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n")
+                    expression_string(rlang::call2(.fn = "regression_table", !!!parameters, .ns = "FreesearchR"), assign.str = NULL),
+                    sep = "|>\n"
+                  )
                 })
 
-              list(
-                rv$code$import,
-                rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
-                rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
-              ) |>
-                merge_expression() |>
-                expression_string()
-
               rv$list$regression$tables <- out
-
               rv$list$input <- input
+
             },
             warning = function(warn) {
               showNotification(paste0(warn), type = "warning")
@@ -7558,11 +7587,15 @@ regression_server <- function(id,
       )
 
       output$table2 <- gt::render_gt({
-        shiny::req(rv$list$regression$tables)
+        ## Print checks if a regression table is present
-        rv$list$regression$tables |>
+        if (!is.null(rv$list$regression$tables)) {
-          tbl_merge() |>
+          rv$list$regression$tables |>
-          gtsummary::as_gt() |>
+            tbl_merge() |>
-          gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
+            gtsummary::as_gt() |>
+            gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
+        } else {
+          return(NULL)
+        }
       })
 
       ##############################################################################
@@ -7653,15 +7686,13 @@ regression_server <- function(id,
       ##############################################################################
 
       return(shiny::reactive({
-        return(rv$list)
+          rv$list
       }))
     }
   )
 }
 
 
-
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//report.R 
 ########
@@ -7841,7 +7872,7 @@ FreesearchR_colors <- function(choose = NULL) {
     fg = "#000000"
   )
   if (!is.null(choose)) {
-    out[choose]
+    unname(out[choose])
   } else {
     out
   }
@@ -9162,7 +9193,17 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
 
 
 ########
-#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/ui.R 
+#### Current file: /Users/au301842/FreesearchR/dev/header_include.R 
+########
+
+header_include <- function(){
+  shiny::tags$head(
+    tags$link(rel = "stylesheet", type = "text/css", href = "style.css"))
+}
+
+
+########
+#### Current file: /Users/au301842/FreesearchR/app/ui.R 
 ########
 
 # ns <- NS(id)
@@ -9678,10 +9719,10 @@ dark <- custom_theme(
 ui <- bslib::page_fixed(
   prismDependencies,
   prismRDependency,
-  shiny::tags$head(
+  header_include(),
-    includeHTML(("www/umami-app.html")),
+  ## This adds the actual favicon
-    tags$link(rel = "stylesheet", type = "text/css", href = "style.css")),
+  ## png and ico versions are kept for compatibility
-  tags$head(tags$link(rel="shortcut icon", href="favicon.svg")),
+  shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")),
   title = "FreesearchR",
   theme = light,
   shiny::useBusyIndicators(),
@@ -9701,7 +9742,7 @@ ui <- bslib::page_fixed(
       style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
       shiny::p(
         style = "margin: 1",
-        "Data is only stored for analyses and deleted when the app is closed."
+        "Data is only stored for analyses and deleted when the app is closed.", shiny::markdown("Consider [running ***FreesearchR*** locally](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine) if working with sensitive data.")
       ),
       shiny::p(
         style = "margin: 1; color: #888;",
@@ -9712,8 +9753,9 @@ ui <- bslib::page_fixed(
 )
 
 
+
 ########
-#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/server.R 
+#### Current file: /Users/au301842/FreesearchR/app/server.R 
 ########
 
 library(readr)
@@ -9751,7 +9793,7 @@ library(gtsummary)
 data(starwars)
 data(mtcars)
 mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
-mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars)))
+mtcars_date$date <- as.Date(sample(seq_len(365), nrow(mtcars)))
 data(trial)
 
 
@@ -9797,7 +9839,7 @@ server <- function(input, output, session) {
 
   rv <- shiny::reactiveValues(
     list = list(),
-    regression = list(),
+    regression = NULL,
     ds = NULL,
     local_temp = NULL,
     ready = NULL,
@@ -10182,6 +10224,20 @@ server <- function(input, output, session) {
       ))
   })
 
+  ## Evaluation table/plots reset on data change
+  ## This does not work (!?)
+  shiny::observeEvent(
+    list(
+      rv$data_filtered
+    ),
+    {
+      shiny::req(rv$data_filtered)
+
+      rv$list$table1 <- NULL
+      # rv$regression <- NULL
+    }
+  )
+
 
   ##############################################################################
   #########
@@ -10243,6 +10299,7 @@ server <- function(input, output, session) {
   ## Just a note to self
   ## This is a very rewarding couple of lines marking new insights to dynamically rendering code
   shiny::observe({
+    shiny::req(rv$regression)
     rv$regression()$regression$models |> purrr::imap(\(.x, .i){
       output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({
         prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table))
@@ -10319,11 +10376,13 @@ server <- function(input, output, session) {
   })
 
   output$table1 <- gt::render_gt({
-    shiny::req(rv$list$table1)
+    if (!is.null(rv$list$table1)) {
-
+      rv$list$table1 |>
-    rv$list$table1 |>
+        gtsummary::as_gt() |>
-      gtsummary::as_gt() |>
+        gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
-      gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
+    } else {
+      return(NULL)
+    }
   })
 
   data_correlations_server(
@@ -10355,6 +10414,22 @@ server <- function(input, output, session) {
 
   rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data))
 
+  # shiny::observeEvent(rv$regression, {
+  #   browser()
+  #   if (shiny::is.reactive(rv$regression)) {
+  #     rv$list$regression <- rv$regression()
+  #   } else {
+  #     rv$list$regression <- rv$regression
+  #   }
+  #   # rv$list$regression <- rv$regression()
+  # })
+
+  # output$regression_models <- renderText({
+  #   req(rv$list$regression)
+  #   browser()
+  #   names(rv$list$regression)
+  # })
+
   ##############################################################################
   #########
   #########  Page navigation
@@ -10405,6 +10480,7 @@ server <- function(input, output, session) {
       paste0("report.", input$output_type)
     }),
     content = function(file, type = input$output_type) {
+      # browser()
       # shiny::req(rv$list$regression)
       ## Notification is not progressing
       ## Presumably due to missing
@@ -10413,6 +10489,11 @@ server <- function(input, output, session) {
       format <- ifelse(type == "docx", "word_document", "odt_document")
 
       # browser()
+      # if (shiny::is.reactive(rv$regression)){
+      #   rv$list$regression <- rv$regression()
+      # }
+
+      # rv$list$regression <- rv$regression()
       rv$list$regression <- rv$regression()
 
       shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
@@ -10466,7 +10547,7 @@ server <- function(input, output, session) {
 
 
 ########
-#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/launch.R 
+#### Current file: /Users/au301842/FreesearchR/app/launch.R 
 ########
 
 shinyApp(ui, server)

inst/apps/FreesearchR/launch.R

@@ -1 +0,0 @@
-shinyApp(ui, server)

inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf

@@ -1,10 +0,0 @@
-name: FreesearchR
-title:
-username: agdamsbo
-account: agdamsbo
-server: shinyapps.io
-hostUrl: https://api.shinyapps.io/v1
-appId: 14600805
-bundleId: 10199884
-url: https://agdamsbo.shinyapps.io/FreesearchR/
-version: 1

inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf

@@ -1,10 +0,0 @@
-name: freesearcheR
-title:
-username: agdamsbo
-account: agdamsbo
-server: shinyapps.io
-hostUrl: https://api.shinyapps.io/v1
-appId: 13611288
-bundleId: 10164589
-url: https://agdamsbo.shinyapps.io/freesearcheR/
-version: 1

inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf

@@ -1,10 +0,0 @@
-name: webResearch
-title:
-username: agdamsbo
-account: agdamsbo
-server: shinyapps.io
-hostUrl: https://api.shinyapps.io/v1
-appId: 13276335
-bundleId: 9436643
-url: https://agdamsbo.shinyapps.io/webResearch/
-version: 1

inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf

@@ -1,10 +0,0 @@
-name: freesearcheR_dev
-title:
-username: cognitiveindex
-account: cognitiveindex
-server: shinyapps.io
-hostUrl: https://api.shinyapps.io/v1
-appId: 13786206
-bundleId: 9688582
-url: https://cognitiveindex.shinyapps.io/freesearcheR_dev/
-version: 1

inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf

@@ -1,10 +0,0 @@
-name: freesearcheR_extra
-title:
-username: cognitiveindex
-account: cognitiveindex
-server: shinyapps.io
-hostUrl: https://api.shinyapps.io/v1
-appId: 13622743
-bundleId: 9544828
-url: https://cognitiveindex.shinyapps.io/freesearcheR_extra/
-version: 1

inst/apps/FreesearchR/server.R

@@ -1,747 +0,0 @@
-library(readr)
-library(MASS)
-library(stats)
-library(gt)
-# library(openxlsx2)
-library(haven)
-library(readODS)
-require(shiny)
-library(bslib)
-library(assertthat)
-library(dplyr)
-library(quarto)
-library(here)
-library(broom)
-library(broom.helpers)
-# library(REDCapCAST)
-library(easystats)
-# library(esquisse)
-library(patchwork)
-library(DHARMa)
-library(apexcharter)
-library(toastui)
-library(datamods)
-library(IDEAFilter)
-library(shinyWidgets)
-library(DT)
-library(data.table)
-library(gtsummary)
-# library(FreesearchR)
-
-# source("functions.R")
-
-data(starwars)
-data(mtcars)
-mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
-mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars)))
-data(trial)
-
-
-# light <- custom_theme()
-#
-# dark <- custom_theme(bg = "#000",fg="#fff")
-
-
-server <- function(input, output, session) {
-  ## Listing files in www in session start to keep when ending and removing
-  ## everything else.
-  files.to.keep <- list.files("www/")
-
-  output$docs_file <- shiny::renderUI({
-    # shiny::includeHTML("www/docs.html")
-    shiny::HTML(readLines("www/docs.html"))
-  })
-
-  ##############################################################################
-  #########
-  #########  Night mode (just very popular, not really needed)
-  #########
-  ##############################################################################
-
-  # observeEvent(input$dark_mode,{
-  #   session$setCurrentTheme(
-  #   if (isTRUE(input$dark_mode)) dark else light
-  # )})
-
-  # observe({
-  #   if(input$dark_mode==TRUE)
-  #     session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5)))
-  #   if(input$dark_mode==FALSE)
-  #     session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5, bg = "#000",fg="#fff")))
-  # })
-
-
-  ##############################################################################
-  #########
-  #########  Setting reactive values
-  #########
-  ##############################################################################
-
-  rv <- shiny::reactiveValues(
-    list = list(),
-    regression = list(),
-    ds = NULL,
-    local_temp = NULL,
-    ready = NULL,
-    test = "no",
-    data_original = NULL,
-    data_temp = NULL,
-    data = NULL,
-    data_variables = NULL,
-    data_filtered = NULL,
-    models = NULL,
-    code = list()
-  )
-
-  ##############################################################################
-  #########
-  #########  Data import section
-  #########
-  ##############################################################################
-
-  data_file <- import_file_server(
-    id = "file_import",
-    show_data_in = "popup",
-    trigger_return = "change",
-    return_class = "data.frame"
-  )
-
-  shiny::observeEvent(data_file$data(), {
-    shiny::req(data_file$data())
-    rv$data_temp <- data_file$data()
-    rv$code <- modifyList(x = rv$code, list(import = data_file$code()))
-  })
-
-  from_redcap <- m_redcap_readServer(
-    id = "redcap_import"
-  )
-
-  shiny::observeEvent(from_redcap$data(), {
-    rv$data_temp <- from_redcap$data()
-    rv$code <- modifyList(x = rv$code, list(import = from_redcap$code()))
-  })
-
-  ## 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
-  )
-
-  from_env <- datamods::import_globalenv_server(
-    id = "env",
-    trigger_return = "change",
-    btn_show_data = FALSE,
-    reset = reactive(input$hidden)
-  )
-
-  shiny::observeEvent(from_env$data(), {
-    shiny::req(from_env$data())
-
-    rv$data_temp <- from_env$data()
-    rv$code <- modifyList(x = rv$code, list(import = from_env$name()))
-  })
-
-  output$import_var <- shiny::renderUI({
-    shiny::req(rv$data_temp)
-
-    preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100]
-
-    shinyWidgets::virtualSelectInput(
-      inputId = "import_var",
-      label = "Select variables to include",
-      selected = preselect,
-      choices = names(rv$data_temp),
-      updateOn = "change",
-      multiple = TRUE,
-      search = TRUE,
-      showValueAsTags = TRUE
-    )
-  })
-
-  output$data_loaded <- shiny::reactive({
-    !is.null(rv$data_temp)
-  })
-
-  shiny::observeEvent(input$source, {
-    rv$data_temp <- NULL
-  })
-
-  shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
-
-  shiny::observeEvent(
-    eventExpr = list(
-      input$import_var,
-      input$complete_cutoff,
-      rv$data_temp
-    ),
-    handlerExpr = {
-      shiny::req(rv$data_temp)
-      shiny::req(input$import_var)
-      # browser()
-      temp_data <- rv$data_temp
-      if (all(input$import_var %in% names(temp_data))) {
-        temp_data <- temp_data |> dplyr::select(input$import_var)
-      }
-
-      rv$data_original <- temp_data |>
-        default_parsing()
-
-      rv$code$import <- rv$code$import |>
-        expression_string(assign.str = "df <-")
-
-      rv$code$format <- list(
-        "df",
-        rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))),
-        rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
-      ) |>
-        lapply(expression_string) |>
-        pipe_string() |>
-        expression_string(assign.str = "df <-")
-
-      rv$code$filter <- NULL
-      rv$code$modify <- NULL
-    }, ignoreNULL = FALSE
-  )
-
-  output$data_info_import <- shiny::renderUI({
-    shiny::req(rv$data_original)
-    data_description(rv$data_original)
-  })
-
-  ## Activating action buttons on data imported
-  shiny::observeEvent(rv$data_original, {
-    if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
-      shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
-      shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE)
-      shiny::updateActionButton(inputId = "act_eval", disabled = TRUE)
-    } else {
-      shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
-      shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE)
-      shiny::updateActionButton(inputId = "act_eval", disabled = FALSE)
-    }
-  })
-
-  ##############################################################################
-  #########
-  #########  Data modification section
-  #########
-  ##############################################################################
-
-  shiny::observeEvent(
-    eventExpr = list(
-      rv$data_original
-    ),
-    handlerExpr = {
-      shiny::req(rv$data_original)
-
-      rv$data <- rv$data_original
-    }
-  )
-
-  ## For now this solution work, but I would prefer to solve this with the above
-  shiny::observeEvent(input$reset_confirm,
-    {
-      if (isTRUE(input$reset_confirm)) {
-        shiny::req(rv$data_original)
-        rv$data <- rv$data_original
-        rv$code$filter <- NULL
-        rv$code$variables <- NULL
-        rv$code$modify <- NULL
-      }
-    },
-    ignoreNULL = TRUE
-  )
-
-
-  shiny::observeEvent(input$data_reset, {
-    shinyWidgets::ask_confirmation(
-      cancelOnDismiss = TRUE,
-      inputId = "reset_confirm",
-      title = "Please confirm data reset?",
-      type = "warning"
-    )
-  })
-
-
-  #########
-  #########  Modifications
-  #########
-
-  ## Using modified version of the datamods::cut_variable_server function
-  ## Further modifications are needed to have cut/bin options based on class of variable
-  ## Could be defined server-side
-
-  output$data_info <- shiny::renderUI({
-    shiny::req(data_filter())
-    data_description(data_filter(), "The filtered data")
-  })
-
-  #########  Create factor
-
-  shiny::observeEvent(
-    input$modal_cut,
-    modal_cut_variable("modal_cut", title = "Create new factor")
-  )
-
-  data_modal_cut <- cut_variable_server(
-    id = "modal_cut",
-    data_r = shiny::reactive(rv$data)
-  )
-
-  shiny::observeEvent(data_modal_cut(), {
-    rv$data <- data_modal_cut()
-    rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
-
-  #########  Modify factor
-
-  shiny::observeEvent(
-    input$modal_update,
-    datamods::modal_update_factor(id = "modal_update", title = "Reorder factor levels")
-  )
-
-  data_modal_update <- datamods::update_factor_server(
-    id = "modal_update",
-    data_r = reactive(rv$data)
-  )
-
-  shiny::observeEvent(data_modal_update(), {
-    shiny::removeModal()
-    rv$data <- data_modal_update()
-    rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
-
-  #########  Create column
-
-  shiny::observeEvent(
-    input$modal_column,
-    modal_create_column(
-      id = "modal_column",
-      footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"),
-      title = "Create new variables"
-    )
-  )
-  data_modal_r <- create_column_server(
-    id = "modal_column",
-    data_r = reactive(rv$data)
-  )
-  shiny::observeEvent(
-    data_modal_r(),
-    {
-      rv$data <- data_modal_r()
-      rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-    }
-  )
-
-  #########  Subset, rename, reclass
-
-  updated_data <- update_variables_server(
-    id = "modal_variables",
-    data = shiny::reactive(rv$data),
-    return_data_on_init = FALSE
-  )
-
-  shiny::observeEvent(updated_data(), {
-    rv$data <- updated_data()
-    rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
-
-  ### Column filter
-  ### Completely implemented, but it takes a little considering where in the
-  ### data flow to implement, as it will act destructively on previous
-  ### manipulations
-
-  output$column_filter <- shiny::renderUI({
-    shiny::req(rv$data)
-    # c("dichotomous", "ordinal", "categorical", "datatime", "continuous")
-    shinyWidgets::virtualSelectInput(
-      inputId = "column_filter",
-      label = "Select variable types to include",
-      selected = unique(data_type(rv$data)),
-      choices = unique(data_type(rv$data)),
-      updateOn = "change",
-      multiple = TRUE,
-      search = FALSE,
-      showValueAsTags = TRUE
-    )
-  })
-
-  shiny::observe({
-    # shiny::req(input$column_filter)
-    out <- data_type_filter(rv$data, input$column_filter)
-    rv$data_variables <- out
-    if (!is.null(input$column_filter)) {
-      rv$code$variables <- attr(out, "code")
-    }
-    # rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
-  })
-
-
-  #########  Data filter
-  # IDEAFilter has the least cluttered UI, but might have a License issue
-  # Consider using shinyDataFilter, though not on CRAN
-  data_filter <- IDEAFilter::IDEAFilter("data_filter",
-    data = shiny::reactive(rv$data_variables),
-    verbose = TRUE
-  )
-
-  shiny::observeEvent(
-    list(
-      shiny::reactive(rv$data_variables),
-      shiny::reactive(rv$data_original),
-      data_filter(),
-      # regression_vars(),
-      input$complete_cutoff
-    ),
-    {
-      ###  Save filtered data
-      rv$data_filtered <- data_filter()
-
-      ###  Save filtered data
-      ###  without empty factor levels
-      rv$list$data <- data_filter() |>
-        REDCapCAST::fct_drop() |>
-        (\(.x){
-          .x[!sapply(.x, is.character)]
-        })()
-
-      ## This looks messy!! But it works as intended for now
-
-      out <- gsub(
-        "filter", "dplyr::filter",
-        gsub(
-          "\\s{2,}", " ",
-          paste0(
-            capture.output(attr(rv$data_filtered, "code")),
-            collapse = " "
-          )
-        )
-      )
-
-      out <- strsplit(out, "%>%") |>
-        unlist() |>
-        (\(.x){
-          paste(c("df <- df", .x[-1], "REDCapCAST::fct_drop()"),
-            collapse = "|> \n "
-          )
-        })()
-
-      rv$code <- append_list(data = out, list = rv$code, index = "filter")
-    }
-  )
-
-  #########  Data preview
-
-  ###  Overview
-
-  data_summary_server(
-    id = "data_summary",
-    data = shiny::reactive({
-      rv$data_filtered
-    }),
-    color.main = "#2A004E",
-    color.sec = "#C62300",
-    pagination = 10
-  )
-
-  observeEvent(input$modal_browse, {
-    show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
-  })
-
-  output$original_str <- renderPrint({
-    str(rv$data_original)
-  })
-
-  output$modified_str <- renderPrint({
-    str(as.data.frame(rv$data_filtered) |>
-      REDCapCAST::set_attr(
-        label = NULL,
-        attr = "code"
-      ))
-  })
-
-
-  ##############################################################################
-  #########
-  #########  Code export
-  #########
-  ##############################################################################
-
-  ## This really should be collapsed to only one call, but I'll leave it for now
-  ## as a working example of dynamically defining outputs and rendering.
-
-  # output$code_import <- shiny::renderPrint({
-  #   shiny::req(rv$code$import)
-  #   cat(c("#Data import\n", rv$code$import))
-  # })
-
-  output$code_import <- shiny::renderUI({
-    prismCodeBlock(paste0("#Data import\n", rv$code$import))
-  })
-
-  output$code_import <- shiny::renderUI({
-    prismCodeBlock(paste0("#Data import formatting\n", rv$code$format))
-  })
-
-  output$code_data <- shiny::renderUI({
-    shiny::req(rv$code$modify)
-    # browser()
-    ## This will create three lines for each modification
-    # ls <- rv$code$modify
-    ## This will remove all non-unique entries
-    # ls <- rv$code$modify |> unique()
-    ## This will only remove all non-repeating entries
-    ls <- rv$code$modify[!is_identical_to_previous(rv$code$modify)]
-
-    out <- ls |>
-      lapply(expression_string) |>
-      pipe_string() |>
-      expression_string(assign.str = "df <- df |>\n")
-
-    prismCodeBlock(paste0("#Data modifications\n", out))
-  })
-
-  output$code_variables <- shiny::renderUI({
-    shiny::req(rv$code$variables)
-    out <- expression_string(rv$code$variables, assign.str = "df <- df |>\n")
-    prismCodeBlock(paste0("#Variables filter\n", out))
-  })
-
-  output$code_filter <- shiny::renderUI({
-    shiny::req(rv$code$filter)
-    prismCodeBlock(paste0("#Data filter\n", rv$code$filter))
-  })
-
-  output$code_table1 <- shiny::renderUI({
-    shiny::req(rv$code$table1)
-    prismCodeBlock(paste0("#Data characteristics table\n", rv$code$table1))
-  })
-
-
-  ## Just a note to self
-  ## This is a very rewarding couple of lines marking new insights to dynamically rendering code
-  shiny::observe({
-    rv$regression()$regression$models |> purrr::imap(\(.x, .i){
-      output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({
-        prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table))
-      })
-    })
-  })
-
-
-  ##############################################################################
-  #########
-  #########  Data analyses Inputs
-  #########
-  ##############################################################################
-
-  output$strat_var <- shiny::renderUI({
-    columnSelectInput(
-      inputId = "strat_var",
-      selected = "none",
-      label = "Select variable to stratify baseline",
-      data = shiny::reactive(rv$data_filtered)(),
-      col_subset = c(
-        "none",
-        names(rv$data_filtered)[unlist(lapply(rv$data_filtered, data_type)) %in% c("dichotomous", "categorical", "ordinal")]
-      )
-    )
-  })
-
-  ##############################################################################
-  #########
-  #########  Descriptive evaluations
-  #########
-  ##############################################################################
-
-
-  output$data_info_nochar <- shiny::renderUI({
-    shiny::req(rv$list$data)
-    data_description(rv$list$data, data_text = "The dataset without text variables")
-  })
-
-  shiny::observeEvent(
-    list(
-      input$act_eval
-    ),
-    {
-      shiny::req(input$strat_var)
-      shiny::req(rv$list$data)
-
-      parameters <- list(
-        by.var = input$strat_var,
-        add.p = input$add_p == "yes",
-        add.overall = TRUE
-      )
-
-      shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
-        rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data"))
-      })
-
-      rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})")
-    }
-  )
-
-  output$outcome_var_cor <- shiny::renderUI({
-    columnSelectInput(
-      inputId = "outcome_var_cor",
-      selected = "none",
-      data = rv$list$data,
-      label = "Select outcome variable",
-      col_subset = c(
-        "none",
-        colnames(rv$list$data)
-      ),
-      multiple = FALSE
-    )
-  })
-
-  output$table1 <- gt::render_gt({
-    shiny::req(rv$list$table1)
-
-    rv$list$table1 |>
-      gtsummary::as_gt() |>
-      gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
-  })
-
-  data_correlations_server(
-    id = "correlations",
-    data = shiny::reactive({
-      shiny::req(rv$list$data)
-      out <- rv$list$data
-      if (!is.null(input$outcome_var_cor) && input$outcome_var_cor != "none") {
-        out <- out[!names(out) %in% input$outcome_var_cor]
-      }
-      out
-    }),
-    cutoff = shiny::reactive(input$cor_cutoff)
-  )
-
-  ##############################################################################
-  #########
-  #########  Data visuals
-  #########
-  ##############################################################################
-
-  pl <- data_visuals_server("visuals", data = shiny::reactive(rv$list$data))
-
-  ##############################################################################
-  #########
-  #########  Regression model analyses
-  #########
-  ##############################################################################
-
-  rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data))
-
-  ##############################################################################
-  #########
-  #########  Page navigation
-  #########
-  ##############################################################################
-
-  shiny::observeEvent(input$act_start, {
-    bslib::nav_select(id = "main_panel", selected = "Data")
-  })
-
-  ##############################################################################
-  #########
-  #########  Reactivity
-  #########
-  ##############################################################################
-
-  output$uploaded <- shiny::reactive({
-    if (is.null(rv$ds)) {
-      "no"
-    } else {
-      "yes"
-    }
-  })
-
-  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
-
-  output$ready <- shiny::reactive({
-    if (is.null(rv$ready)) {
-      "no"
-    } else {
-      "yes"
-    }
-  })
-
-  shiny::outputOptions(output, "ready", suspendWhenHidden = FALSE)
-
-  ##############################################################################
-  #########
-  #########  Downloads
-  #########
-  ##############################################################################
-
-  # Could be rendered with other tables or should show progress
-  # Investigate quarto render problems
-  # On temp file handling: https://github.com/quarto-dev/quarto-cli/issues/3992
-  output$report <- downloadHandler(
-    filename = shiny::reactive({
-      paste0("report.", input$output_type)
-    }),
-    content = function(file, type = input$output_type) {
-      # shiny::req(rv$list$regression)
-      ## Notification is not progressing
-      ## Presumably due to missing
-      # browser()
-      # Simplified for .rmd output attempt
-      format <- ifelse(type == "docx", "word_document", "odt_document")
-
-      # browser()
-      rv$list$regression <- rv$regression()
-
-      shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
-        tryCatch(
-          {
-            rv$list |>
-              write_rmd(
-                output_format = format,
-                input = file.path(getwd(), "www/report.rmd")
-              )
-          },
-          error = function(err) {
-            showNotification(paste0("We encountered the following error creating your report: ", err), type = "err")
-          }
-        )
-      })
-      file.rename(paste0("www/report.", type), file)
-    }
-  )
-
-  output$data_modified <- downloadHandler(
-    filename = shiny::reactive({
-      paste0("modified_data.", input$data_type)
-    }),
-    content = function(file, type = input$data_type) {
-      if (type == "rds") {
-        readr::write_rds(rv$list$data, file = file)
-      } else if (type == "dta") {
-        haven::write_dta(as.data.frame(rv$list$data), path = file)
-      } else if (type == "csv") {
-        readr::write_csv(rv$list$data, file = file)
-      }
-    }
-  )
-
-  ##############################################################################
-  #########
-  #########  Clearing the session on end
-  #########
-  ##############################################################################
-
-  session$onSessionEnded(function() {
-    cat("Session Ended\n")
-    files <- list.files("www/")
-    lapply(files[!files %in% files.to.keep], \(.x){
-      unlink(paste0("www/", .x), recursive = FALSE)
-      print(paste(.x, "deleted"))
-    })
-  })
-}

inst/apps/FreesearchR/ui.R

@@ -508,13 +508,10 @@ dark <- custom_theme(
 # Fonts to consider:
 # https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/
 
-ui <- bslib::page_fixed(
+ui_list <- shiny::tagList(
   prismDependencies,
   prismRDependency,
-  ## Basic Umami page tracking
+  header_include(),
-  shiny::tags$head(
-    includeHTML(("www/umami-app.html")),
-    tags$link(rel = "stylesheet", type = "text/css", href = "style.css")),
   ## This adds the actual favicon
   ## png and ico versions are kept for compatibility
   shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")),
@@ -546,3 +543,12 @@ ui <- bslib::page_fixed(
     )
   )
 )
+
+# ui_list <- shiny::tagAppendChild(ui_list,list(
+#   ## Basic Umami page tracking
+#   shiny::tags$head(includeHTML("www/umami-app.html"))
+#   # shiny::tags$head(shiny::tags$script(rel="defer", src="https://analytics.gdamsbo.dk/script.js", "data-website-id"="e7d4e13a-5824-4778-bbc0-8f92fb08303a"))
+#   ))
+
+ui <- do.call(
+  bslib::page_fixed,ui_list)

inst/apps/FreesearchR/www/umami-app.html

@@ -1 +0,0 @@
-<script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="e7d4e13a-5824-4778-bbc0-8f92fb08303a"></script>