updated translation strings

.dockerignore

@@ -0,0 +1,6 @@
+.Rhistory
+.git
+.gitignore
+manifest.json
+rsconnect/
+.Rproj.user

.github/workflows/docker-build.yml

@@ -0,0 +1,49 @@
+name: Build and Push Docker Image
+permissions:
+  contents: read
+  packages: write
+
+on:
+  # push:
+  #   branches:
+  #     - main
+  #     - master
+  release:
+    types: [published]
+  workflow_dispatch:
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v3
+
+      - name: Setup Docker Buildx
+        uses: docker/setup-buildx-action@v2
+
+      - name: Login to GitHub Container Registry
+        uses: docker/login-action@v2
+        with:
+          registry: ghcr.io
+          username: ${{ github.actor }}
+          password: ${{ secrets.GITHUB_TOKEN }}
+
+      - name: Define lowercase variables
+        id: vars
+        run: |
+          REPO_OWNER_LOWER=$(echo "$GITHUB_REPOSITORY_OWNER" | tr '[:upper:]' '[:lower:]')
+          REPO_NAME_LOWER=$(echo "$GITHUB_REPOSITORY" | cut -d'/' -f2 | tr '[:upper:]' '[:lower:]')
+          echo "REPO_OWNER_LOWER=$REPO_OWNER_LOWER" >> $GITHUB_ENV
+          echo "REPO_NAME_LOWER=$REPO_NAME_LOWER" >> $GITHUB_ENV
+
+      - name: Build and push Docker image
+        uses: docker/build-push-action@v4
+        with:
+          context: app_docker/
+          file: app_docker/Dockerfile
+          push: true
+          tags: |
+            ghcr.io/${{ env.REPO_OWNER_LOWER }}/${{ env.REPO_NAME_LOWER }}:latest
+            ghcr.io/${{ env.REPO_OWNER_LOWER }}/${{ env.REPO_NAME_LOWER }}:${{ github.sha }}

.gitignore

@@ -15,3 +15,4 @@ app_stable
 app
 page
 demo
+visuals

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.6.1
+version: 25.8.3
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url
@@ -361,7 +361,7 @@ references:
   authors:
   - family-names: Lüdecke
     given-names: Daniel
-    email: d.luedecke@uke.de
+    email: officialeasystats@gmail.com
     orcid: https://orcid.org/0000-0002-8895-3206
   - family-names: Makowski
     given-names: Dominique
@@ -409,7 +409,7 @@ references:
   authors:
   - family-names: Lüdecke
     given-names: Daniel
-    email: d.luedecke@uke.de
+    email: officialeasystats@gmail.com
     orcid: https://orcid.org/0000-0002-8895-3206
   - family-names: Makowski
     given-names: Dominique
@@ -1002,6 +1002,55 @@ references:
     email: russell-lenth@uiowa.edu
   year: '2025'
   doi: 10.32614/CRAN.package.emmeans
+- type: software
+  title: readxl
+  abstract: 'readxl: Read Excel Files'
+  notes: Imports
+  url: https://readxl.tidyverse.org
+  repository: https://CRAN.R-project.org/package=readxl
+  authors:
+  - family-names: Wickham
+    given-names: Hadley
+    email: hadley@posit.co
+    orcid: https://orcid.org/0000-0003-4757-117X
+  - family-names: Bryan
+    given-names: Jennifer
+    email: jenny@posit.co
+    orcid: https://orcid.org/0000-0002-6983-2759
+  year: '2025'
+  doi: 10.32614/CRAN.package.readxl
+- type: software
+  title: NHANES
+  abstract: 'NHANES: Data from the US National Health and Nutrition Examination Study'
+  notes: Imports
+  repository: https://CRAN.R-project.org/package=NHANES
+  authors:
+  - family-names: Pruim
+    given-names: Randall
+    email: rpruim@calvin.edu
+  year: '2025'
+  doi: 10.32614/CRAN.package.NHANES
+- type: software
+  title: shiny.i18n
+  abstract: 'shiny.i18n: Shiny Applications Internationalization'
+  notes: Imports
+  url: https://appsilon.github.io/shiny.i18n/
+  repository: https://CRAN.R-project.org/package=shiny.i18n
+  authors:
+  - family-names: Nowicki
+    given-names: Jakub
+    email: opensource+kuba@appsilon.com
+  - family-names: Krzemiński
+    given-names: Dominik
+    email: raymon92@gmail.com
+  - family-names: Igras
+    given-names: Krystian
+    email: krystian8207@gmail.com
+  - family-names: Sobolewski
+    given-names: Jakub
+    email: jakub.sobolewski@appsilon.com
+  year: '2025'
+  doi: 10.32614/CRAN.package.shiny.i18n
 - type: software
   title: styler
   abstract: 'styler: Non-Invasive Pretty Printing of R Code'
@@ -1259,6 +1308,19 @@ references:
     orcid: https://orcid.org/0000-0001-8457-4658
   year: '2025'
   doi: 10.32614/CRAN.package.cffr
+- type: software
+  title: shiny2docker
+  abstract: 'shiny2docker: Generate Dockerfiles for ''Shiny'' Applications'
+  notes: Suggests
+  url: https://github.com/VincentGuyader/shiny2docker
+  repository: https://CRAN.R-project.org/package=shiny2docker
+  authors:
+  - family-names: Guyader
+    given-names: Vincent
+    email: vincent@thinkr.fr
+    orcid: https://orcid.org/0000-0003-0671-9270
+  year: '2025'
+  doi: 10.32614/CRAN.package.shiny2docker
 - type: software
   title: 'R: A Language and Environment for Statistical Computing'
   notes: Depends

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.6.1
+Version: 25.8.3
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),
@@ -64,7 +64,10 @@ Imports:
     RcppArmadillo,
     ggcorrplot,
     shinyjs,
-    emmeans
+    emmeans,
+    readxl,
+    NHANES,
+    shiny.i18n
 Suggests: 
     styler,
     devtools,
@@ -79,7 +82,8 @@ Suggests:
     testthat (>= 3.0.0),
     shinytest,
     covr,
-    cffr
+    cffr,
+    shiny2docker
 URL: https://github.com/agdamsbo/FreesearchR, https://agdamsbo.github.io/FreesearchR/, https://app.FreesearchR.org/
 BugReports: https://github.com/agdamsbo/FreesearchR/issues
 VignetteBuilder: knitr

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(cut_var,default)
 S3method(cut_var,hms)
 S3method(plot,tbl_regression)
+export(FreesearchR_palette)
 export(add_class_icon)
 export(add_sparkline)
 export(align_axes)
@@ -16,6 +17,7 @@ export(clean_common_axis)
 export(clean_date)
 export(clean_sep)
 export(columnSelectInput)
+export(compare_missings)
 export(contrast_text)
 export(create_baseline)
 export(create_column_server)
@@ -30,6 +32,9 @@ export(cut_variable_ui)
 export(data_correlations_server)
 export(data_correlations_ui)
 export(data_description)
+export(data_missings_server)
+export(data_missings_ui)
+export(data_summary_gather)
 export(data_summary_server)
 export(data_summary_ui)
 export(data_type)
@@ -73,9 +78,13 @@ export(line_break)
 export(list_allowed_operations)
 export(m_redcap_readServer)
 export(m_redcap_readUI)
+export(make_validation)
+export(make_validation_alerts)
 export(merge_expression)
 export(merge_long)
 export(missing_fraction)
+export(missings_apex_plot)
+export(missings_validate)
 export(modal_create_column)
 export(modal_cut_variable)
 export(modal_update_factor)
@@ -118,12 +127,18 @@ export(supported_plots)
 export(symmetrical_scale_x_log10)
 export(tbl_merge)
 export(type_icons)
+export(ui_elements)
+export(unique_short)
 export(update_factor_server)
 export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_ui)
+export(validation_server)
+export(validation_ui)
 export(vectorSelectInput)
 export(vertical_stacked_bars)
+export(visual_summary)
+export(visual_summary_ui)
 export(wide2long)
 export(winbox_create_column)
 export(winbox_update_factor)

NEWS.md

@@ -1,3 +1,60 @@
+# FreesearchR 25.8.3 - DEV
+
+*NEW* Language has been revised to make the app more accessible and easier to understand.
+
+*NEW* Initial and very rudimentary translation for Danish and Swahili is introduced. Other languages can be added as well.
+
+*NEW* Alerts as to guide on select important steps and aspects are introduced. This is expected to expand.
+
+# FreesearchR 25.8.2
+
+- *NEW* Including the [NHANES](https://cran.r-project.org/web/packages/NHANES/refman/NHANES.html#NHANES) dataset for experimentation.
+
+- *BUG* Improved JS to correctly handle menu drop downs on mobile devices
+
+- *DOCS* Updated "Prepare > Overview" to "Prepare > Overview and filter" to better reflect options.
+
+# FreesearchR 25.8.1
+
+- *NEW* improved the use of `wrap_plot_list()` to pass on additional arguments to `patchwork::wrap_plots()` and allowed to specify axes to align in `align_axes()`.
+- *FIX* fixed axis text printed in Euler diagrams
+
+# FreesearchR 25.7.2
+
+- *FIX* refining hiding drop downs. All JavaScript is now in separate file. Coded with GAI help from claude.ai.
+
+- *FIX* refined iconography and navigation
+
+- *FIX* updated intro and docs.
+
+# FreesearchR 25.7.1
+
+- *NEW* UI overhaul and navigation update. The interface is simplified to clearly show the relationship between panels and sub-items by abandoning multiple levels on panel to instead show a drop-down menu. This also results in simplified sidebar menus with room to add more controls in the future.
+
+# FreesearchR 25.6.4
+
+The app is now also published as a docker container. See the README for instructions. It is mainly to use for hosting the app. Work is ongoing to publish a true standalone app, preferably for both Windows and MacOS.
+
+- *FIX* improved plot labels.
+
+# FreesearchR 25.6.3
+
+- *NEW* Introducing more options to evaluate missing observations. Inspired by the [visdat()] function from the {visdat} package, a specialised function has been introduced to easily visualise data classes and missing observations in the data set. This highly increases the options to visually get an overview of the data and to assess the pattern of missing data. Also under Evaluate, a comparison module has been introduced to compare the distribution of observations across variables depending on the missing vs non-missing in a specified variable.
+
+- *FIX* The REDCap import module has been updated visually and the PAI token is now hidden as a password. This module should still only be used when running locally if you are accessing sensitive data.
+
+- minor rewordings and updated UI.
+
+# FreesearchR 25.6.2
+
+- *FIX* Added warning about only using REDCap with sensitive data running locally. THis applies to all data actually. Considering taking REDCap out in hosted version. Standalone app is in the works.
+
+- *FIX* Reworded the completeness filter to be on missingness, as this is a more commonly used concept.
+
+- *FIX* Improved layout around data filters to improve usage.
+
+- *FIX* Regression table in report respects inclusion of p-values or not.
+
 # FreesearchR 25.6.1
 
 - *FIX* big not allowing to browse data

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'25.6.1'
+app_version <- function()'25.8.3'

R/correlations-module.R

@@ -16,9 +16,13 @@ data_correlations_ui <- function(id, ...) {
 
 
 #'
+#' @param id id
 #' @param data data
-#' @param color.main main color
+#' @param include.class character vector of classes to include. Default is NULL
-#' @param color.sec secondary color
+#' @param cutoff numeric
+#' @param warning_str Character string. Exposed to allow dynamic translations
+#' @param warning_no_str Character string. Exposed to allow dynamic translations
+#' @param and_strCharacter string. Exposed to allow dynamic translations
 #' @param ... arguments passed to toastui::datagrid
 #'
 #' @name data-correlations
@@ -28,6 +32,9 @@ data_correlations_server <- function(id,
                                      data,
                                      include.class = NULL,
                                      cutoff = .7,
+                                     warning_str = i18n$t("The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent."),
+                                     warning_no_str = i18n$t("No variables have a correlation measure above the threshold."),
+                                     and_str = i18n$t("and"),
                                      ...) {
   shiny::moduleServer(
     id = id,
@@ -59,17 +66,17 @@ data_correlations_server <- function(id,
         shiny::req(cutoff)
         pairs <- correlation_pairs(rv$data(), threshold = cutoff())
 
-        more <- ifelse(nrow(pairs) > 1, "from each pair ", "")
+        more <- ifelse(nrow(pairs) > 1, i18n$t("from each pair"), "")
 
         if (nrow(pairs) == 0) {
-          out <- glue::glue("No variables have a correlation measure above the threshold.")
+          out <- glue::glue(warning_no_str)
         } else {
           out <- pairs |>
             apply(1, \(.x){
-              glue::glue("'{.x[1]}'x'{.x[2]}'({round(as.numeric(.x[3]),2)})")
+              glue::glue("'{.x[1]}'x'{.x[2]}' ({round(as.numeric(.x[3]),2)})")
             }) |>
             (\(.x){
-              glue::glue("The following variable pairs are highly correlated: {sentence_paste(.x)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.")
+              glue::glue(warning_str)
             })()
         }
         out

R/create-column-mod.R

@@ -63,7 +63,7 @@ create_column_ui <- function(id) {
         width = 6,
         textInput(
           inputId = ns("new_column"),
-          label = i18n("New column name:"),
+          label = i18n$t("New column name:"),
           value = "new_column1",
           width = "100%"
         )
@@ -72,7 +72,7 @@ create_column_ui <- function(id) {
         width = 6,
         shinyWidgets::virtualSelectInput(
           inputId = ns("group_by"),
-          label = i18n("Group calculation by:"),
+          label = i18n$t("Group calculation by:"),
           choices = NULL,
           multiple = TRUE,
           disableSelectAll = TRUE,
@@ -83,7 +83,7 @@ create_column_ui <- function(id) {
     ),
     shiny::textAreaInput(
       inputId = ns("expression"),
-      label = i18n("Enter an expression to define new column:"),
+      label = i18n$t("Enter an expression to define new column:"),
       value = "",
       width = "100%",
       rows = 6
@@ -91,7 +91,7 @@ create_column_ui <- function(id) {
     tags$i(
       class = "d-block",
       phosphoricons::ph("info"),
-      datamods::i18n("Click on a column name to add it to the expression:")
+      i18n$t("Click on a column name to add it to the expression:")
     ),
     uiOutput(outputId = ns("columns")),
     uiOutput(outputId = ns("feedback")),
@@ -105,7 +105,7 @@ create_column_ui <- function(id) {
       actionButton(
         inputId = ns("compute"),
         label = tagList(
-          phosphoricons::ph("gear"), i18n("Create column")
+          phosphoricons::ph("gear"), i18n$t("Create column")
         ),
         class = "btn-outline-primary",
         width = "100%"
@@ -140,9 +140,9 @@ create_column_server <- function(id,
       info_alert <- shinyWidgets::alert(
         status = "info",
         phosphoricons::ph("question"),
-        datamods::i18n("Choose a name for the column to be created or modified,"),
+        i18n$t("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 "),
+        i18n$t("then enter an expression before clicking on the button above to validate or on "),
-        phosphoricons::ph("trash"), datamods::i18n("to delete it.")
+        phosphoricons::ph("trash"), i18n$t("to delete it.")
       )
 
       rv <- reactiveValues(
@@ -187,7 +187,7 @@ create_column_server <- function(id,
         if (input$new_column == "") {
           rv$feedback <- shinyWidgets::alert(
             status = "warning",
-            phosphoricons::ph("warning"), datamods::i18n("New column name cannot be empty")
+            phosphoricons::ph("warning"), i18n$t("New column name cannot be empty")
           )
         }
       })
@@ -252,7 +252,7 @@ list_allowed_operations <- function() {
 #'
 #' @rdname create-column
 modal_create_column <- function(id,
-                                title = i18n("Create a new column"),
+                                title = i18n$t("Create a new column"),
                                 easyClose = TRUE,
                                 size = "l",
                                 footer = NULL) {
@@ -277,7 +277,7 @@ modal_create_column <- function(id,
 #' @importFrom htmltools tagList
 #' @rdname create-column
 winbox_create_column <- function(id,
-                                 title = i18n("Create a new column"),
+                                 title = i18n$t("Create a new column"),
                                  options = shinyWidgets::wbOptions(),
                                  controls = shinyWidgets::wbControls()) {
   ns <- NS(id)
@@ -311,7 +311,7 @@ try_compute_column <- function(expression,
   }
   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")))
+    return(datamods:::alert_error(i18n$t("Some operations are not allowed")))
   }
   if (!isTruthy(by)) {
     result <- try(
@@ -351,7 +351,7 @@ try_compute_column <- function(expression,
   )
   shinyWidgets::alert(
     status = "success",
-    phosphoricons::ph("check"), datamods::i18n("Column added!")
+    phosphoricons::ph("check"), i18n$t("Column added!")
   )
 }
 
@@ -421,7 +421,7 @@ make_choices_with_infos <- function(data) {
       #   NULL
       # }
       description <- if (is.atomic(values)) {
-        paste(i18n("Unique values:"), data.table::uniqueN(values))
+        paste(i18n$t("Unique values:"), data.table::uniqueN(values))
       } else {
         ""
       }

R/cut-variable-dates.R

@@ -208,7 +208,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
-          label = datamods:::i18n("Variable to cut:"),
+          label = i18n$t("Variable to cut:"),
           choices = NULL,
           width = "100%"
         )
@@ -221,7 +221,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         numericInput(
           inputId = ns("n_breaks"),
-          label = datamods:::i18n("Number of breaks:"),
+          label = i18n$t("Number of breaks:"),
           value = 3,
           min = 2,
           max = 12,
@@ -232,12 +232,12 @@ cut_variable_ui <- function(id) {
         width = 3,
         checkboxInput(
           inputId = ns("right"),
-          label = datamods:::i18n("Close intervals on the right"),
+          label = i18n$t("Close intervals on the right"),
           value = TRUE
         ),
         checkboxInput(
           inputId = ns("include_lowest"),
-          label = datamods:::i18n("Include lowest value"),
+          label = i18n$t("Include lowest value"),
           value = TRUE
         )
       )
@@ -251,7 +251,7 @@ cut_variable_ui <- function(id) {
     toastui::datagridOutput2(outputId = ns("count")),
     actionButton(
       inputId = ns("create"),
-      label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
+      label = tagList(phosphoricons::ph("scissors"), i18n$t("Create factor variable")),
       class = "btn-outline-primary float-end"
     ),
     tags$div(class = "clearfix")
@@ -321,7 +321,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
 
         shinyWidgets::noUiSliderInput(
           inputId = session$ns("fixed_brks"),
-          label = datamods:::i18n("Fixed breaks:"),
+          label = i18n$t("Fixed breaks:"),
           min = lower,
           max = upper,
           value = brks,
@@ -376,7 +376,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
 
         shinyWidgets::virtualSelectInput(
           inputId = session$ns("method"),
-          label = datamods:::i18n("Method:"),
+          label = i18n$t("Method:"),
           choices = choices,
           selected = NULL,
           width = "100%"
@@ -570,7 +570,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
 #'
 #' @rdname cut-variable
 modal_cut_variable <- function(id,
-                               title = datamods:::i18n("Convert Numeric to Factor"),
+                               title = i18n$t("Convert Numeric to Factor"),
                                easyClose = TRUE,
                                size = "l",
                                footer = NULL) {

R/data_plots.R

@@ -11,10 +11,8 @@
 data_visuals_ui <- function(id, tab_title = "Plots", ...) {
   ns <- shiny::NS(id)
 
-  # bslib::navset_bar(
   list(
-
+    bslib::layout_sidebar(
-    # Sidebar with a slider input
       sidebar = bslib::sidebar(
         bslib::accordion(
           multiple = FALSE,
@@ -22,7 +20,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             title = "Creating plot",
             icon = bsicons::bs_icon("graph-up"),
             shiny::uiOutput(outputId = ns("primary")),
-          shiny::helpText('Only non-text variables are available for plotting. Go the "Data" to reclass data to plot.'),
+            shiny::helpText(i18n$t('Only non-text variables are available for plotting. Go the "Data" to reclass data to plot.')),
             shiny::tags$br(),
             shiny::uiOutput(outputId = ns("type")),
             shiny::uiOutput(outputId = ns("secondary")),
@@ -30,23 +28,19 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             shiny::br(),
             shiny::actionButton(
               inputId = ns("act_plot"),
-            label = "Plot",
+              label = i18n$t("Plot"),
               width = "100%",
               icon = shiny::icon("palette"),
               disabled = FALSE
             ),
-          shiny::helpText('Adjust settings, then press "Plot".')
+            shiny::helpText(i18n$t('Adjust settings, then press "Plot".'))
           ),
-        # bslib::accordion_panel(
-        #   title = "Advanced",
-        #   icon = bsicons::bs_icon("gear")
-        # ),
           bslib::accordion_panel(
             title = "Download",
             icon = bsicons::bs_icon("download"),
             shinyWidgets::noUiSliderInput(
               inputId = ns("height_slide"),
-            label = "Plot height (mm)",
+              label = i18n$t("Plot height (mm)"),
               min = 50,
               max = 300,
               value = 100,
@@ -64,7 +58,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             # ),
             shinyWidgets::noUiSliderInput(
               inputId = ns("width"),
-            label = "Plot width (mm)",
+              label = i18n$t("Plot width (mm)"),
               min = 50,
               max = 300,
               value = 100,
@@ -74,7 +68,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             ),
             shiny::selectInput(
               inputId = ns("plot_type"),
-            label = "File format",
+              label = i18n$t("File format"),
               choices = list(
                 "png",
                 "tiff",
@@ -88,20 +82,25 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             # Button
             shiny::downloadButton(
               outputId = ns("download_plot"),
-            label = "Download plot",
+              label = i18n$t("Download plot"),
               icon = shiny::icon("download")
             )
           )
-      )
         ),
-    bslib::nav_panel(
+        shiny::p("We have collected a few notes on visualising data and details on the options included in FreesearchR:", shiny::tags$a(
-      title = tab_title,
+          href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
+          "View notes in new tab",
+          target = "_blank",
+          rel = "noopener noreferrer"
+        ))
+      ),
       shiny::plotOutput(ns("plot"), height = "70vh"),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::htmlOutput(outputId = ns("code_plot"))
     )
   )
+  # )
 }
 
 
@@ -226,8 +225,8 @@ data_visuals_server <- function(id,
           inputId = ns("primary"),
           col_subset = names(data())[sapply(data(), data_type) != "text"],
           data = data,
-          placeholder = "Select variable",
+          placeholder = i18n$t("Select variable"),
-          label = "Response variable",
+          label = i18n$t("Response variable"),
           multiple = FALSE
         )
       })
@@ -264,7 +263,7 @@ data_visuals_server <- function(id,
         vectorSelectInput(
           inputId = ns("type"),
           selected = NULL,
-          label = shiny::h4("Plot type"),
+          label = shiny::h4(i18n$t("Plot type")),
           choices = Reduce(c, plots_named),
           multiple = FALSE
         )
@@ -292,12 +291,12 @@ data_visuals_server <- function(id,
           inputId = ns("secondary"),
           data = data,
           selected = cols[1],
-          placeholder = "Please select",
+          placeholder = i18n$t("Please select"),
-          label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
+          label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) i18n$t("Additional variables") else i18n$t("Secondary variable"),
           multiple = rv$plot.params()[["secondary.multi"]],
           maxItems = rv$plot.params()[["secondary.max"]],
           col_subset = cols,
-          none_label = "No variable"
+          none_label = i18n$t("No variable")
         )
       })
 
@@ -306,8 +305,8 @@ data_visuals_server <- function(id,
         columnSelectInput(
           inputId = ns("tertiary"),
           data = data,
-          placeholder = "Please select",
+          placeholder = i18n$t("Please select"),
-          label = "Grouping variable",
+          label = i18n$t("Grouping variable"),
           multiple = FALSE,
           col_subset = c(
             "none",
@@ -320,7 +319,7 @@ data_visuals_server <- function(id,
               input$secondary
             )
           ),
-          none_label = "No stratification"
+          none_label = i18n$t("No stratification")
         )
       })
 
@@ -336,11 +335,18 @@ data_visuals_server <- function(id,
                   ter = input$tertiary
                 )
 
-                shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
+                shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), {
-                  rv$plot <- rlang::exec(create_plot, !!!append_list(data(), parameters, "data"))
+                  rv$plot <- rlang::exec(
+                    create_plot,
+                    !!!append_list(
+                      data(),
+                      parameters,
+                      "data"
+                    )
+                  )
                 })
 
-                rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
+                rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})")
               },
               # warning = function(warn) {
               #   showNotification(paste0(warn), type = "warning")
@@ -356,7 +362,7 @@ data_visuals_server <- function(id,
 
       output$code_plot <- shiny::renderUI({
         shiny::req(rv$code)
-        prismCodeBlock(paste0("#Plotting\n", rv$code))
+        prismCodeBlock(paste0(i18n$t("#Plotting\n"), rv$code))
       })
 
       shiny::observeEvent(
@@ -393,16 +399,15 @@ data_visuals_server <- function(id,
           paste0("plot.", input$plot_type)
         }),
         content = function(file) {
-          if (inherits(rv$plot,"patchwork")){
+          if (inherits(rv$plot, "patchwork")) {
             plot <- rv$plot
-          } else if (inherits(rv$plot,"ggplot")){
+          } else if (inherits(rv$plot, "ggplot")) {
             plot <- rv$plot
-          }else {
+          } else {
             plot <- rv$plot[[1]]
-
           }
           # browser()
-          shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
+          shiny::withProgress(message = i18n$t("Drawing the plot. Hold on for a moment.."), {
             ggplot2::ggsave(
               filename = file,
               plot = plot,
@@ -481,8 +486,8 @@ supported_plots <- function() {
   list(
     plot_hbars = list(
       fun = "plot_hbars",
-      descr = "Stacked horizontal bars",
+      descr = i18n$t("Stacked horizontal bars"),
-      note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
+      note = i18n$t("A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"),
       primary.type = c("dichotomous", "categorical"),
       secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
@@ -491,8 +496,8 @@ supported_plots <- function() {
     ),
     plot_violin = list(
       fun = "plot_violin",
-      descr = "Violin plot",
+      descr = i18n$t("Violin plot"),
-      note = "A modern alternative to the classic boxplot to visualise data distribution",
+      note = i18n$t("A modern alternative to the classic boxplot to visualise data distribution"),
       primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
       secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
@@ -509,8 +514,8 @@ supported_plots <- function() {
     # ),
     plot_sankey = list(
       fun = "plot_sankey",
-      descr = "Sankey plot",
+      descr = i18n$t("Sankey plot"),
-      note = "A way of visualising change between groups",
+      note = i18n$t("A way of visualising change between groups"),
       primary.type = c("dichotomous", "categorical"),
       secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
@@ -519,8 +524,8 @@ supported_plots <- function() {
     ),
     plot_scatter = list(
       fun = "plot_scatter",
-      descr = "Scatter plot",
+      descr = i18n$t("Scatter plot"),
-      note = "A classic way of showing the association between to variables",
+      note = i18n$t("A classic way of showing the association between to variables"),
       primary.type = c("datatime", "continuous"),
       secondary.type = c("datatime", "continuous", "categorical"),
       secondary.multi = FALSE,
@@ -529,8 +534,8 @@ supported_plots <- function() {
     ),
     plot_box = list(
       fun = "plot_box",
-      descr = "Box plot",
+      descr = i18n$t("Box plot"),
-      note = "A classic way to plot data distribution by groups",
+      note = i18n$t("A classic way to plot data distribution by groups"),
       primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
       secondary.type = c("dichotomous", "categorical"),
       secondary.multi = FALSE,
@@ -539,8 +544,8 @@ supported_plots <- function() {
     ),
     plot_euler = list(
       fun = "plot_euler",
-      descr = "Euler diagram",
+      descr = i18n$t("Euler diagram"),
-      note = "Generate area-proportional Euler diagrams to display set relationships",
+      note = i18n$t("Generate area-proportional Euler diagrams to display set relationships"),
       primary.type = c("dichotomous", "categorical"),
       secondary.type = c("dichotomous", "categorical"),
       secondary.multi = TRUE,
@@ -659,12 +664,12 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
 
   out <- do.call(
     type,
-    modifyList(parameters,list(data=data))
+    modifyList(parameters, list(data = data))
   )
 
-  code <- rlang::call2(type,!!!parameters,.ns = "FreesearchR")
+  code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
 
-  attr(out,"code") <- code
+  attr(out, "code") <- code
   out
 }
 
@@ -719,6 +724,7 @@ get_label <- function(data, var = NULL) {
 #' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
 line_break <- function(data, lineLength = 20, force = FALSE) {
   if (isTRUE(force)) {
+    ## This eats some letters when splitting a sentence... ??
     gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
   } else {
     paste(strwrap(data, lineLength), collapse = "\n")
@@ -731,11 +737,23 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
 #'
 #' @param data list of ggplot2 objects
 #' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
+#' @param title panel title
+#' @param guides passed to patchwork::wrap_plots()
+#' @param axes passed to patchwork::wrap_plots()
+#' @param axis_titles passed to patchwork::wrap_plots()
+#' @param ... passed to patchwork::wrap_plots()
 #'
 #' @returns list of ggplot2 objects
 #' @export
 #'
-wrap_plot_list <- function(data, tag_levels = NULL) {
+wrap_plot_list <- function(data,
+                           tag_levels = NULL,
+                           title = NULL,
+                           axis.font.family = NULL,
+                           guides = "collect",
+                           axes = "collect",
+                           axis_titles = "collect",
+                           ...) {
   if (ggplot2::is_ggplot(data[[1]])) {
     if (length(data) > 1) {
       out <- data |>
@@ -749,16 +767,39 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
           }
         })() |>
         align_axes() |>
-        patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
+        patchwork::wrap_plots(
+          guides = guides,
+          axes = axes,
+          axis_titles = axis_titles,
+          ...
+        )
       if (!is.null(tag_levels)) {
         out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
       }
+      if (!is.null(title)) {
+        out <- out +
+          patchwork::plot_annotation(
+            title = title,
+            theme = ggplot2::theme(plot.title = ggplot2::element_text(size = 25))
+          )
+      }
     } else {
-      out <- data
+      out <- data[[1]]
     }
   } else {
     cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
   }
+
+  if (!is.null(axis.font.family)) {
+    if (inherits(x = out, what = "patchwork")) {
+      out <- out &
+        ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
+    } else {
+      out <- out +
+        ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
+    }
+  }
+
   out
 }
 
@@ -770,7 +811,7 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
 #' @returns list of ggplot2 objects
 #' @export
 #'
-align_axes <- function(...) {
+align_axes <- function(..., x.axis = TRUE, y.axis = TRUE) {
   # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
   # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
   if (ggplot2::is_ggplot(..1)) {
@@ -788,7 +829,16 @@ align_axes <- function(...) {
   xr <- clean_common_axis(p, "x")
 
   suppressWarnings({
-    p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
+    purrr::map(p, \(.x){
+      out <- .x
+      if (isTRUE(x.axis)) {
+        out <- out + ggplot2::xlim(xr)
+      }
+      if (isTRUE(y.axis)) {
+        out <- out + ggplot2::ylim(yr)
+      }
+      out
+    })
   })
 }
 

R/datagrid-infos-mod.R

@@ -129,14 +129,14 @@ describe_col_char <- function(x, with_summary = TRUE) {
       tagList(
         tags$hr(style = htmltools::css(margin = "3px 0")),
         tags$div(
-          datamods:::i18n("Unique:"), length(unique(x))
+          i18n$t("Unique:"), length(unique(x))
         ),
         tags$div(
-          datamods:::i18n("Missing:"), sum(is.na(x))
+          i18n$t("Missing:"), sum(is.na(x))
         ),
         tags$div(
           style = htmltools::css(whiteSpace = "normal", wordBreak = "break-all"),
-          datamods:::i18n("Most Common:"), gsub(
+          i18n$t("Most Common:"), gsub(
             pattern = "'",
             replacement = "\u07F4",
             x = names(sort(table(x), decreasing = TRUE))[1]
@@ -178,7 +178,7 @@ describe_col_factor <- function(x, with_summary = TRUE) {
           names(two), ":", fmt_p(two, total)
         ),
         tags$div(
-          "Missing", ":", fmt_p(missing, total)
+          i18n$t("Missing:"), fmt_p(missing, total)
         ),
         tags$div(
           "\u00A0"
@@ -201,16 +201,16 @@ describe_col_num <- function(x, with_summary = TRUE) {
       tagList(
         tags$hr(style = htmltools::css(margin = "3px 0")),
         tags$div(
-          datamods:::i18n("Min:"), round(min(x, na.rm = TRUE), 2)
+          i18n$t("Min:"), round(min(x, na.rm = TRUE), 2)
         ),
         tags$div(
-          datamods:::i18n("Mean:"), round(mean(x, na.rm = TRUE), 2)
+          i18n$t("Mean:"), round(mean(x, na.rm = TRUE), 2)
         ),
         tags$div(
-          datamods:::i18n("Max:"), round(max(x, na.rm = TRUE), 2)
+          i18n$t("Max:"), round(max(x, na.rm = TRUE), 2)
         ),
         tags$div(
-          datamods:::i18n("Missing:"), sum(is.na(x))
+          i18n$t("Missing:"), sum(is.na(x))
         )
       )
     }
@@ -231,13 +231,13 @@ describe_col_date <- function(x, with_summary = TRUE) {
       tagList(
         tags$hr(style = htmltools::css(margin = "3px 0")),
         tags$div(
-          datamods:::i18n("Min:"), min(x, na.rm = TRUE)
+          i18n$t("Min:"), min(x, na.rm = TRUE)
         ),
         tags$div(
-          datamods:::i18n("Max:"), max(x, na.rm = TRUE)
+          i18n$t("Max:"), max(x, na.rm = TRUE)
         ),
         tags$div(
-          datamods:::i18n("Missing:"), sum(is.na(x))
+          i18n$t("Missing:"), sum(is.na(x))
         ),
         tags$div(
           "\u00A0"
@@ -260,13 +260,13 @@ describe_col_datetime <- function(x, with_summary = TRUE) {
       tagList(
         tags$hr(style = htmltools::css(margin = "3px 0")),
         tags$div(
-          datamods:::i18n("Min:"), min(x, na.rm = TRUE)
+          i18n$t("Min:"), min(x, na.rm = TRUE)
         ),
         tags$div(
-          datamods:::i18n("Max:"), max(x, na.rm = TRUE)
+          i18n$t("Max:"), max(x, na.rm = TRUE)
         ),
         tags$div(
-          datamods:::i18n("Missing:"), sum(is.na(x))
+          i18n$t("Missing:"), sum(is.na(x))
         ),
         tags$div(
           "\u00A0"
@@ -290,10 +290,10 @@ describe_col_other <- function(x, with_summary = TRUE) {
       tagList(
         tags$hr(style = htmltools::css(margin = "3px 0")),
         tags$div(
-          datamods:::i18n("Unique:"), length(unique(x))
+          i18n$t("Unique:"), length(unique(x))
         ),
         tags$div(
-          datamods:::i18n("Missing:"), sum(is.na(x))
+          i18n$t("Missing:"), sum(is.na(x))
         ),
         tags$div(
           "\u00A0"

R/helpers.R

@@ -50,7 +50,7 @@ write_quarto <- function(data, ...) {
   )
 }
 
-write_rmd <- function(data, ...) {
+write_rmd <- function(data, ..., params.args=NULL) {
   # Exports data to temporary location
   #
   # I assume this is more secure than putting it in the www folder and deleting
@@ -65,7 +65,7 @@ write_rmd <- function(data, ...) {
   ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
   ## Outputs to the same as the .qmd file
   rmarkdown::render(
-    params = list(data.file = "web_data.rds",version=app_version()),
+    params = modifyList(list(data.file = "web_data.rds",version=app_version()),params.args),
     # execute_params = list(data.file = temp),
     ...
   )
@@ -153,7 +153,8 @@ dummy_Imports <- function() {
     cardx::all_of(),
     parameters::ci(),
     DT::addRow(),
-    bslib::accordion()
+    bslib::accordion(),
+    NHANES::NHANES()
   )
   # https://github.com/hadley/r-pkgs/issues/828
 }
@@ -360,16 +361,17 @@ data_description <- function(data, data_text = "Data") {
   n <- nrow(data)
   n_var <- ncol(data)
   n_complete <- sum(complete.cases(data))
-  p_complete <- n_complete / n
+  p_complete <- signif(100 * n_complete / n, 3)
 
-  sprintf(
+  glue::glue(i18n$t("{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases."))
-    "%s has %s observations and %s variables, with %s (%s%%) complete cases.",
+  # sprintf(
-    data_text,
+  #   "%s has %s observations and %s variables, with %s (%s%%) complete cases.",
-    n,
+  #   data_text,
-    n_var,
+  #   n,
-    n_complete,
+  #   n_var,
-    signif(100 * p_complete, 3)
+  #   n_complete,
-  )
+  #   p_complete
+  # )
 }
 
 

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v25.6.1-250604'
+hosted_version <- function()'v25.8.3-250911'

R/import-file-ext.R

@@ -24,7 +24,7 @@ import_file_ui <- function(id,
 
   if (isTRUE(title)) {
     title <- shiny::tags$h4(
-      datamods:::i18n("Import a file"),
+      "Import a file",
       class = "datamods-title"
     )
   }
@@ -35,7 +35,7 @@ import_file_ui <- function(id,
       width = 6,
       shinyWidgets::numericInputIcon(
         inputId = ns("skip_rows"),
-        label = datamods:::i18n("Rows to skip before reading data:"),
+        label = i18n$t("Rows to skip before reading data:"),
         value = 0,
         min = 0,
         icon = list("n ="),
@@ -45,20 +45,20 @@ import_file_ui <- function(id,
       shiny::tagAppendChild(
         shinyWidgets::textInputIcon(
           inputId = ns("na_label"),
-          label = datamods:::i18n("Missing values character(s):"),
+          label = i18n$t("Missing values character(s):"),
           value = "NA,,'',na",
           icon = list("NA"),
           size = "sm",
           width = "100%"
         ),
-        shiny::helpText(phosphoricons::ph("info"), datamods:::i18n("if several use a comma (',') to separate them"))
+        shiny::helpText(phosphoricons::ph("info"), i18n$t("if several use a comma (',') to separate them"))
       )
     ),
     shiny::column(
       width = 6,
       shinyWidgets::textInputIcon(
         inputId = ns("dec"),
-        label = datamods:::i18n("Decimal separator:"),
+        label = i18n$t("Decimal separator:"),
         value = ".",
         icon = list("0.00"),
         size = "sm",
@@ -66,7 +66,7 @@ import_file_ui <- function(id,
       ),
       selectInputIcon(
         inputId = ns("encoding"),
-        label = datamods:::i18n("Encoding:"),
+        label = i18n$t("Encoding:"),
         choices = c(
           "UTF-8" = "UTF-8",
           "Latin1" = "latin1"
@@ -81,9 +81,9 @@ import_file_ui <- function(id,
   file_ui <- shiny::tagAppendAttributes(
     shiny::fileInput(
       inputId = ns("file"),
-      label = datamods:::i18n("Upload a file:"),
+      label = i18n$t("Upload a file:"),
-      buttonLabel = datamods:::i18n("Browse..."),
+      buttonLabel = i18n$t("Browse..."),
-      placeholder = datamods:::i18n("No file selected; maximum file size is 5 mb"),
+      placeholder = "No file selected; maximum file size is 5 mb",
       accept = file_extensions,
       width = "100%",
       ## A solution to allow multiple file upload is being considered
@@ -130,7 +130,7 @@ import_file_ui <- function(id,
       id = ns("sheet-container"),
       shinyWidgets::pickerInput(
         inputId = ns("sheet"),
-        label = datamods:::i18n("Select sheet to import:"),
+        label = i18n$t("Select sheet to import:"),
         choices = NULL,
         width = "100%",
         multiple = TRUE
@@ -141,8 +141,11 @@ import_file_ui <- function(id,
       shinyWidgets::alert(
         id = ns("import-result"),
         status = "info",
-        shiny::tags$b(datamods:::i18n("No file selected:")),
+        shiny::tags$b(i18n$t("No file selected.")),
-        sprintf(datamods:::i18n("You can import %s files"), paste(file_extensions, collapse = ", ")),
+        # shiny::textOutput(ns("trans_format_text")),
+        # This is the easiest solution, though not gramatically perfect
+        i18n$t("You can choose between these file types:"), paste(file_extensions,collapse=', '),
+        # sprintf("You can import %s files", paste(file_extensions, collapse = ", ")),
         dismissible = TRUE
       )
     ),
@@ -206,6 +209,11 @@ import_file_server <- function(id,
       }
     })
 
+    # ## Translations
+    # shiny::observe({
+    #   output$trans_format_text <- shiny::renderText(glue::glue(i18n$t("You can import {file_extensions_text} files")))
+    # })
+
     shiny::observeEvent(input$file, {
       ## Several steps are taken to ensure no errors on changed input file
       temporary_rv$sheets <- 1
@@ -270,7 +278,7 @@ import_file_server <- function(id,
 
         if (inherits(imported, "try-error") || NROW(imported) < 1) {
           datamods:::toggle_widget(inputId = "confirm", enable = FALSE)
-          datamods:::insert_error(mssg = datamods:::i18n(attr(imported, "condition")$message))
+          datamods:::insert_error(mssg = i18n$t(attr(imported, "condition")$message))
           temporary_rv$status <- "error"
           temporary_rv$data <- NULL
           temporary_rv$name <- NULL
@@ -285,7 +293,7 @@ import_file_server <- function(id,
               imported,
               trigger_return = trigger_return,
               btn_show_data = btn_show_data,
-              extra = if (isTRUE(input$preview_data)) datamods:::i18n("First five rows are shown below:")
+              extra = if (isTRUE(input$preview_data)) i18n$t("First five rows are shown below:")
             )
           )
           temporary_rv$status <- "success"
@@ -300,7 +308,7 @@ import_file_server <- function(id,
     observeEvent(input$see_data, {
       tryCatch(
         {
-          datamods:::show_data(default_parsing(temporary_rv$data), title = datamods:::i18n("Imported data"), type = show_data_in)
+          datamods:::show_data(default_parsing(temporary_rv$data), title = i18n$t("Imported data"), type = show_data_in)
         },
         # warning = function(warn) {
         #     showNotification(warn, type = "warning")

R/missings-module.R

@@ -0,0 +1,143 @@
+#' Data correlations evaluation module
+#'
+#' @param id Module id
+#'
+#' @name data-missings
+#' @returns Shiny ui module
+#' @export
+data_missings_ui <- function(id) {
+  ns <- shiny::NS(id)
+
+  shiny::tagList(
+    gt::gt_output(outputId = ns("missings_table"))
+  )
+}
+
+
+#'
+#' @param data data
+#' @param output.format output format
+#'
+#' @name data-missings
+#' @returns shiny server module
+#' @export
+data_missings_server <- function(id,
+                                 data,
+                                 variable,
+                                 ...) {
+  shiny::moduleServer(
+    id = id,
+    module = function(input, output, session) {
+      # ns <- session$ns
+
+      datar <- if (is.reactive(data)) data else reactive(data)
+      variabler <- if (is.reactive(variable)) variable else reactive(variable)
+
+      rv <- shiny::reactiveValues(
+        data = NULL,
+        table = NULL
+      )
+
+      rv$data <- shiny::reactive({
+        df_tbl <- datar()
+        by_var <- variabler()
+
+        tryCatch(
+          {
+            out <- compare_missings(df_tbl,by_var)
+          },
+          error = function(err) {
+            showNotification(paste0("Error: ", err), type = "err")
+          }
+        )
+
+        out
+      })
+
+      output$missings_table <- gt::render_gt({
+        shiny::req(datar)
+        shiny::req(variabler)
+
+        if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
+          if (anyNA(datar())){
+            title <- "No variable chosen for analysis"
+          } else {
+          title <- "No missing observations"
+          }
+        } else {
+          title <- glue::glue("Missing vs non-missing observations in the variable **'{variabler()}'**")
+        }
+
+        out <- rv$data() |>
+          gtsummary::as_gt() |>
+          gt::tab_header(title = gt::md(title))
+
+        rv$table <- out
+
+        out
+      })
+
+      return(reactive(rv$table))
+    }
+  )
+}
+
+
+missing_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::actionButton(
+      inputId = "modal_missings",
+      label = "Browse data",
+      width = "100%",
+      disabled = FALSE
+    ),
+    shiny::selectInput(
+      inputId = "missings_var",
+      label = "Select variable to stratify analysis", choices = c("cyl", "vs")
+    ),
+    data_missings_ui("data")
+  )
+  server <- function(input, output, session) {
+    data_demo <- mtcars
+    data_demo[sample(1:32, 10), "cyl"] <- NA
+    data_demo[sample(1:32, 8), "vs"] <- NA
+
+    data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var))
+
+    visual_summary_server(id = "visual", data = data_demo)
+
+    observeEvent(input$modal_missings, {
+      tryCatch(
+        {
+          modal_visual_summary(id = "visual")
+        },
+        error = function(err) {
+          showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
+        }
+      )
+    })
+  }
+  shiny::shinyApp(ui, server)
+}
+
+missing_demo_app()
+
+#' Pairwise comparison of missings across covariables
+#'
+#' @param data data frame
+#' @param by_var variable to stratify by missingness
+#'
+#' @returns gtsummary list object
+#' @export
+#'
+compare_missings <- function(data,by_var){
+  if (!is.null(by_var) && by_var != "" && by_var %in% names(data)) {
+    data[[by_var]] <- ifelse(is.na(data[[by_var]]), "Missing", "Non-missing")
+
+    out <- gtsummary::tbl_summary(data, by = by_var) |>
+      gtsummary::add_p()
+  } else {
+    out <- gtsummary::tbl_summary(data)
+  }
+  out
+}

R/plot_box.R

@@ -1,16 +1,26 @@
 #' Beautiful box plot(s)
 #'
+#' @param data data frame
+#' @param pri primary variable
+#' @param sec secondary variable
+#' @param ter tertiary variable
+#' @param ... passed on to wrap_plot_list
+#'
 #' @returns ggplot2 object
 #' @export
 #'
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+#' mtcars |> plot_box(pri = "mpg", sec = "gear")
+#' mtcars |> plot_box(pri = "mpg", sec="cyl")
 #' mtcars |>
 #'   default_parsing() |>
 #'   plot_box(pri = "mpg", sec = "cyl", ter = "gear")
-plot_box <- function(data, pri, sec, ter = NULL) {
+#' mtcars |>
+#'   default_parsing() |>
+#'   plot_box(pri = "mpg", sec = "cyl", ter = "gear",axis.font.family="mono")
+plot_box <- function(data, pri, sec, ter = NULL,...) {
   if (!is.null(ter)) {
     ds <- split(data, data[ter])
   } else {
@@ -25,7 +35,7 @@ plot_box <- function(data, pri, sec, ter = NULL) {
     )
   })
 
-  wrap_plot_list(out)
+  wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}"),...)
 }
 
 
@@ -41,6 +51,7 @@ plot_box <- function(data, pri, sec, ter = NULL) {
 #' @examples
 #' mtcars |> plot_box_single("mpg")
 #' mtcars |> plot_box_single("mpg","cyl")
+#' gtsummary::trial |> plot_box_single("age","trt")
 plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
   set.seed(seed)
 
@@ -56,6 +67,8 @@ plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
     ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
     ## THis could be optional in future
     ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9, width = 0.1, height = .2) +
+    ggplot2::xlab(get_label(data,pri))+
+    ggplot2::ylab(get_label(data,sec)) +
     ggplot2::coord_flip() +
     viridis::scale_fill_viridis(discrete = discrete, option = "D") +
     # ggplot2::theme_void() +

R/plot_euler.R

@@ -76,6 +76,7 @@ ggeulerr <- function(
 #'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 #' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
 #' mtcars |> plot_euler("vs", "am", seed = 1)
+#' mtcars |> plot_euler("vs", "am", "cyl", seed = 1)
 plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   set.seed(seed = seed)
   if (!is.null(ter)) {
@@ -90,10 +91,9 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
       na.omit() |>
       plot_euler_single()
   })
-
+# browser()
-  # names(out)
+  wrap_plot_list(out,title=glue::glue("Grouped by {get_label(data,ter)}"))
-  wrap_plot_list(out)
+  # patchwork::wrap_plots(out)
-  # patchwork::wrap_plots(out, guides = "collect")
 }
 
 #' Easily plot single euler diagrams
@@ -123,8 +123,8 @@ plot_euler_single <- function(data) {
       legend.position = "none",
       # panel.grid.major = element_blank(),
       # panel.grid.minor = element_blank(),
-      # axis.text.y = element_blank(),
+      axis.text.y = ggplot2::element_blank(),
-      # axis.title.y = element_blank(),
+      axis.title.y = ggplot2::element_blank(),
       text = ggplot2::element_text(size = 20),
       axis.text = ggplot2::element_blank(),
       # plot.title = element_blank(),

R/plot_hbar.R

@@ -7,6 +7,7 @@
 #'
 #' @examples
 #' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+#' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 #' mtcars |> plot_hbars(pri = "carb", sec = NULL)
 plot_hbars <- function(data, pri, sec, ter = NULL) {
   out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)

R/plot_violin.R

@@ -14,6 +14,8 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
     ds <- list(data)
   }
 
+  # browser()
+  suppressWarnings({
     out <- lapply(ds, \(.ds){
       rempsyc::nice_violin(
         data = .ds,
@@ -24,6 +26,7 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
       )
     })
 
-  wrap_plot_list(out)
+    wrap_plot_list(out, title = glue::glue("Grouped by {get_label(data,ter)}"))
+  })
   # patchwork::wrap_plots(out,guides = "collect")
 }

R/redcap_read_shiny_module.R

@@ -18,18 +18,25 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
   }
 
   server_ui <- shiny::tagList(
-    # width = 6,
     shiny::tags$h4("REDCap server"),
     shiny::textInput(
       inputId = ns("uri"),
       label = "Web address",
-      value = if_not_missing(url, "https://redcap.your.institution/")
+      value = if_not_missing(url, "https://redcap.your.institution/"),
+      width = "100%"
     ),
     shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
-    shiny::textInput(
+    # shiny::textInput(
+    #   inputId = ns("api"),
+    #   label = "API token",
+    #   value = "",
+    #   width = "100%"
+    # ),
+    shiny::passwordInput(
       inputId = ns("api"),
       label = "API token",
-      value = ""
+      value = "",
+      width = "100%"
     ),
     shiny::helpText("The token is a string of 32 numbers and letters."),
     shiny::br(),
@@ -67,10 +74,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
 
   params_ui <-
     shiny::tagList(
-      # width = 6,
       shiny::tags$h4("Data import parameters"),
-      shiny::helpText("Options here will show, when API and uri are typed"),
+      shiny::tags$div(
-      shiny::tags$br(),
+        style = htmltools::css(
+          display = "grid",
+          gridTemplateColumns = "1fr 50px",
+          gridColumnGap = "10px"
+        ),
         shiny::uiOutput(outputId = ns("fields")),
         shiny::tags$div(
           class = "shiny-input-container",
@@ -83,15 +93,15 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           shinyWidgets::dropMenu(
             shiny::actionButton(
               inputId = ns("dropdown_params"),
-            label = "Add data filters",
+              label = shiny::icon("filter"),
-            icon = shiny::icon("filter"),
+              width = "50px"
-            width = "100%",
-            class = "px-1"
             ),
             filter_ui
+          )
+        )
       ),
-        shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
+      shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
-      ),
+      shiny::tags$br(),
       shiny::tags$br(),
       shiny::uiOutput(outputId = ns("data_type")),
       shiny::uiOutput(outputId = ns("fill")),
@@ -112,28 +122,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
         ),
         dismissible = TRUE
-      ) # ,
+      )
-      ## TODO: Use busy indicator like on download to have button activate/deactivate
-      # bslib::input_task_button(
-      #   id = ns("data_import"),
-      #   label = "Import",
-      #   icon = shiny::icon("download", lib = "glyphicon"),
-      #   label_busy = "Just a minute...",
-      #   icon_busy = fontawesome::fa_i("arrows-rotate",
-      #     class = "fa-spin",
-      #     "aria-hidden" = "true"
-      #   ),
-      #   type = "primary",
-      #   auto_reset = TRUE#,state="busy"
-      # ),
-      # shiny::br(),
-      # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
     )
 
 
   shiny::fluidPage(
     title = title,
     server_ui,
+    # shiny::uiOutput(ns("params_ui")),
     shiny::conditionalPanel(
       condition = "output.connect_success == true",
       params_ui,
@@ -257,6 +253,7 @@ m_redcap_readServer <- function(id) {
     output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
     shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
 
+
     shiny::observeEvent(input$see_dd, {
       show_data(
         purrr::pluck(data_rv$dd_list, "data"),
@@ -292,7 +289,7 @@ m_redcap_readServer <- function(id) {
       shiny::req(data_rv$dd_list)
       shinyWidgets::virtualSelectInput(
         inputId = ns("fields"),
-        label = "Select variables to import:",
+        label = "Select fields/variables to import:",
         choices = purrr::pluck(data_rv$dd_list, "data") |>
           dplyr::select(field_name, form_name) |>
           (\(.x){
@@ -301,7 +298,8 @@ m_redcap_readServer <- function(id) {
         updateOn = "change",
         multiple = TRUE,
         search = TRUE,
-        showValueAsTags = TRUE
+        showValueAsTags = TRUE,
+        width = "100%"
       )
     })
 
@@ -310,13 +308,14 @@ m_redcap_readServer <- function(id) {
       if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
         vectorSelectInput(
           inputId = ns("data_type"),
-          label = "Select the data format to import",
+          label = "Specify the data format",
           choices = c(
             "Wide data (One row for each subject)" = "wide",
             "Long data for project with repeating instruments (default REDCap)" = "long"
           ),
           selected = "wide",
-          multiple = FALSE
+          multiple = FALSE,
+          width = "100%"
         )
       }
     })
@@ -342,7 +341,8 @@ m_redcap_readServer <- function(id) {
             "No, leave the data as is" = "no"
           ),
           selected = "no",
-          multiple = FALSE
+          multiple = FALSE,
+          width = "100%"
         )
       }
     })
@@ -362,7 +362,8 @@ m_redcap_readServer <- function(id) {
           selected = NULL,
           label = "Filter by events/arms",
           choices = stats::setNames(arms()[[3]], arms()[[1]]),
-          multiple = TRUE
+          multiple = TRUE,
+          width = "100%"
         )
       }
     })

R/regression-module.R

@@ -44,7 +44,10 @@ regression_ui <- function(id, ...) {
   ns <- shiny::NS(id)
 
   shiny::tagList(
-    title = "",
+    # title = "",
+    bslib::nav_panel(
+      title = "Regression table",
+      bslib::layout_sidebar(
         sidebar = bslib::sidebar(
           shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
           bslib::accordion(
@@ -119,7 +122,19 @@ regression_ui <- function(id, ...) {
               #   )
               # ),
               shiny::tags$br()
+            )
+          )
         ),
+        gt::gt_output(outputId = ns("table2"))
+      )
+    ),
+    bslib::nav_panel(
+      title = "Coefficient plot",
+      bslib::layout_sidebar(
+        sidebar = bslib::sidebar(
+          bslib::accordion(
+            open = "acc_reg",
+            multiple = FALSE,
             do.call(
               bslib::accordion_panel,
               c(
@@ -173,7 +188,19 @@ regression_ui <- function(id, ...) {
                   )
                 )
               )
+            )
+          )
         ),
+        shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
+      )
+    ),
+    bslib::nav_panel(
+      title = "Model checks",
+      bslib::layout_sidebar(
+        sidebar = bslib::sidebar(
+          bslib::accordion(
+            open = "acc_reg",
+            multiple = FALSE,
             bslib::accordion_panel(
               value = "acc_checks",
               title = "Checks",
@@ -182,19 +209,10 @@ regression_ui <- function(id, ...) {
             )
           )
         ),
-    bslib::nav_panel(
-      title = "Regression table",
-      gt::gt_output(outputId = ns("table2"))
-    ),
-    bslib::nav_panel(
-      title = "Coefficient plot",
-      shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
-    ),
-    bslib::nav_panel(
-      title = "Model checks",
         shiny::plotOutput(outputId = ns("check"), height = "90vh")
       )
     )
+  )
 }
 
 

R/theme.R

@@ -46,7 +46,7 @@ FreesearchR_colors <- function(choose = NULL) {
     secondary = "#FF6F61",
     success = "#00C896",
     warning = "#FFB100",
-    danger = "#FF3A2F",
+    danger = "#CC2E25",
     extra = "#8A4FFF",
     info = "#11A0EC",
     bg = "#FFFFFF",
@@ -60,7 +60,18 @@ FreesearchR_colors <- function(choose = NULL) {
   }
 }
 
-
+#' Use the FreesearchR colors
+#'
+#' @param n number of colors
+#'
+#' @returns character vector
+#' @export
+#'
+#' @examples
+#' FreesearchR_palette(n=7)
+FreesearchR_palette <- function(n){
+  rep_len(FreesearchR_colors(),n)
+}
 
 
 

R/translate.R

@@ -0,0 +1,8 @@
+language_choices <- function() {
+  c(
+    "🇬🇧 English" = "en",
+    "🇹🇿 Kiswahili" = "sw",
+    "🇩🇰 Dansk" = "da"
+  )
+}
+

R/ui_elements.R

@@ -0,0 +1,618 @@
+#' FreesearchR UI elements list
+#'
+#' @param selection specify element to output
+#'
+#' @returns Shinu UI elements
+#' @export
+#'
+ui_elements <- function(selection) {
+  out <- list(
+    ##############################################################################
+    #########
+    #########  Home panel
+    #########
+    ##############################################################################
+    "home" = bslib::nav_panel(
+      title = "FreesearchR",
+      # title = shiny::div(htmltools::img(src="FreesearchR-logo-white-nobg-h80.png")),
+      icon = shiny::icon("house"),
+      shiny::fluidRow(
+        # "The browser language is",
+        # textOutput("your_lang"),
+        # p(i18n$t("Hello")),
+        # shiny::uiOutput(outputId = "language_select"),
+        ## On building the dev-version for shinyapps.io, the dev_banner() is redefined
+        ## Default just output "NULL"
+        ## This could probably be achieved more legantly, but this works.
+        dev_banner(),
+        shiny::column(width = 2),
+        shiny::column(
+          width = 8,
+          shiny::uiOutput(outputId = "language_select"),
+          htmlOutput("intro_text")
+          # shiny::includeHTML(i18n$t("www/intro.html"))
+          # shiny::markdown(readLines(i18n$t("www/intro.md")))
+        ),
+        shiny::column(width = 2)
+      )
+    ),
+    ##############################################################################
+    #########
+    #########  Import panel
+    #########
+    ##############################################################################
+    "import" = bslib::nav_panel(
+      title = i18n$t("Get started"),
+      icon = shiny::icon("play"),
+      value = "nav_import",
+      shiny::fluidRow(
+        shiny::column(width = 2),
+        shiny::column(
+          width = 8,
+          shiny::h4(i18n$t("Choose your data")),
+          # shiny::br(),
+          # shiny::uiOutput(outputId = "source"),
+          # radioGroupButtons(
+          #   inputId = "source",
+          #   selected = "file",
+          #   choices = c("File" = "file"),
+          #   size = "lg"
+          # ),
+          shiny::selectInput(
+            inputId = "source",
+            label="",
+            selected = "file",
+            choices = "file",
+            width = "100%"
+          ),
+          # shiny::tags$script('document.querySelector("#source div").style.width = "100%"'),
+          ## Update this to change depending on run locally or hosted
+          shiny::helpText(i18n$t("Upload a file, get data directly from REDCap or use local or sample data.")),
+          shiny::br(),
+          shiny::br(),
+          shiny::conditionalPanel(
+            condition = "input.source=='file'",
+            import_file_ui(
+              id = "file_import",
+              layout_params = "dropdown",
+              # title = "Choose a datafile to upload",
+              file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta")
+            )
+          ),
+          shiny::conditionalPanel(
+            condition = "input.source=='redcap'",
+            shiny::uiOutput(outputId = "redcap_warning"),
+            # shinyWidgets::alert(
+            #   id = "redcap-warning",
+            #   status = "warning",
+            #   shiny::tags$h2(i18n$t("Please be mindfull handling sensitive data")),
+            #   shiny::HTML(i18n$t("<p>The <em><strong>FreesearchR</strong></em> app only stores data for analyses, but please only use with sensitive data when running locally. <a href='https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine'>Read more here</a></p>")),
+            #   dismissible = TRUE
+            # ),
+            m_redcap_readUI(
+              id = "redcap_import",
+              title = ""
+            )
+          ),
+          shiny::conditionalPanel(
+            condition = "input.source=='env'",
+            import_globalenv_ui(id = "env", title = NULL)
+          ),
+          # shiny::conditionalPanel(
+          #   condition = "input.source=='redcap'",
+          #   DT::DTOutput(outputId = "redcap_prev")
+          # ),
+          shiny::conditionalPanel(
+            condition = "output.data_loaded == true",
+            shiny::br(),
+            shiny::actionButton(
+              inputId = "modal_initial_view",
+              label = i18n$t("Quick overview"),
+              width = "100%",
+              icon = shiny::icon("binoculars"),
+              disabled = FALSE
+            ),
+            shiny::br(),
+            shiny::br(),
+            shiny::h5(i18n$t("Select variables for final import")),
+            shiny::fluidRow(
+              shiny::column(
+                width = 6,
+                shiny::p(i18n$t("Exclude incomplete variables:")),
+                shiny::br(),
+                shinyWidgets::noUiSliderInput(
+                  inputId = "complete_cutoff",
+                  label = NULL,
+                  update_on = "end",
+                  min = 0,
+                  max = 100,
+                  step = 5,
+                  value = 30,
+                  format = shinyWidgets::wNumbFormat(decimals = 0),
+                  color = datamods:::get_primary_color()
+                ),
+                shiny::helpText(i18n$t("At 0, only complete variables are included; at 100, all variables are included.")),
+                shiny::br()
+              ),
+              shiny::column(
+                width = 6,
+                shiny::p(i18n$t("Manual selection:")),
+                shiny::br(),
+                shiny::uiOutput(outputId = "import_var"),
+                shiny::br()
+              )
+            ),
+            shiny::uiOutput(outputId = "data_info_import", inline = TRUE),
+            shiny::br(),
+            shiny::br(),
+            shiny::actionButton(
+              inputId = "act_start",
+              label = i18n$t("Let's begin!"),
+              width = "100%",
+              icon = shiny::icon("play"),
+              disabled = TRUE
+            ),
+            shiny::br(),
+            shiny::br()
+          ),
+          shiny::column(width = 2)
+        ),
+        shiny::br(),
+        shiny::br()
+      )
+    ),
+    ##############################################################################
+    #########
+    #########  Data overview panel
+    #########
+    ##############################################################################
+    "prepare" = bslib::nav_menu(
+      title = i18n$t("Prepare"),
+      icon = shiny::icon("pen-to-square"),
+      value = "nav_prepare",
+      bslib::nav_panel(
+        title = i18n$t("Overview and filter"),
+        icon = shiny::icon("eye"),
+        value = "nav_prepare_overview",
+        tags$h3(i18n$t("Overview and filtering")),
+        fluidRow(
+          shiny::column(
+            width = 9,
+            shiny::uiOutput(outputId = "data_info", inline = TRUE),
+            shiny::tags$p(
+              i18n$t("Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse data and apply different data filters.")
+            )
+          ),
+          shiny::column(
+            width = 3,
+            shiny::actionButton(
+              inputId = "modal_visual_overview",
+              label = i18n$t("Visual overview"),
+              width = "100%",
+              disabled = TRUE
+            ),
+            shiny::br(),
+            shiny::br(),
+            shiny::actionButton(
+              inputId = "modal_browse",
+              label = i18n$t("Browse data"),
+              width = "100%",
+              disabled = TRUE
+            ),
+            shiny::br(),
+            shiny::br()
+          )
+        ),
+        fluidRow(
+          shiny::column(
+            width = 9,
+            data_summary_ui(id = "data_summary"),
+            shiny::br(),
+            shiny::br(),
+            shiny::br(),
+            shiny::br(),
+            shiny::br()
+          ),
+          shiny::column(
+            width = 3,
+            shiny::tags$h6(i18n$t("Filter data types")),
+            shiny::uiOutput(
+              outputId = "column_filter"
+            ),
+            ## This needs to run in server for translation
+            shiny::helpText("Read more on how ", tags$a(
+              "data types",
+              href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
+              target = "_blank",
+              rel = "noopener noreferrer"
+            ), " are defined."),
+            validation_ui("validation_var"),
+            shiny::br(),
+            shiny::br(),
+            shiny::tags$h6(i18n$t("Filter observations")),
+            shiny::tags$p(i18n$t("Apply filter on observation")),
+            IDEAFilter::IDEAFilter_ui("data_filter"),
+            validation_ui("validation_obs"),
+            shiny::br(),
+            shiny::br()
+          )
+        ),
+        shiny::br(),
+        shiny::br(),
+        shiny::br()
+      ),
+      bslib::nav_panel(
+        title = i18n$t("Edit and create data"),
+        icon = shiny::icon("file-pen"),
+        tags$h3(i18n$t("Subset, rename and convert variables")),
+        fluidRow(
+          shiny::column(
+            width = 9,
+            shiny::tags$p(
+              i18n$t("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."),
+              i18n$t("There are more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with R code. At the bottom you can restore the original data."),
+              i18n$t("Please note that data modifications are applied before any filtering.")
+            )
+          )
+        ),
+        update_variables_ui("modal_variables"),
+        shiny::tags$br(),
+        shiny::tags$br(),
+        shiny::tags$h4(i18n$t("Advanced data manipulation")),
+        shiny::tags$p(i18n$t("Below options allow more advanced varaible manipulations.")),
+        shiny::tags$br(),
+        shiny::tags$br(),
+        shiny::fluidRow(
+          shiny::column(
+            width = 4,
+            shiny::actionButton(
+              inputId = "modal_update",
+              label = i18n$t("Reorder factor levels"),
+              width = "100%"
+            ),
+            shiny::tags$br(),
+            shiny::helpText(i18n$t("Reorder the levels of factor/categorical variables.")),
+            shiny::tags$br(),
+            shiny::tags$br()
+          ),
+          shiny::column(
+            width = 4,
+            shiny::actionButton(
+              inputId = "modal_cut",
+              label = i18n$t("New factor"),
+              width = "100%"
+            ),
+            shiny::tags$br(),
+            shiny::helpText(i18n$t("Create factor/categorical variable from a continous variable (number/date/time).")),
+            shiny::tags$br(),
+            shiny::tags$br()
+          ),
+          shiny::column(
+            width = 4,
+            shiny::actionButton(
+              inputId = "modal_column",
+              label = i18n$t("New variable"),
+              width = "100%"
+            ),
+            shiny::tags$br(),
+            shiny::helpText(i18n$t("Create a new variable based on an R-expression.")),
+            shiny::tags$br(),
+            shiny::tags$br()
+          )
+        ),
+        tags$h4(i18n$t("Compare modified data to original")),
+        shiny::tags$br(),
+        shiny::tags$p(
+          i18n$t("Raw print of the original vs the modified data.")
+        ),
+        shiny::tags$br(),
+        shiny::fluidRow(
+          shiny::column(
+            width = 6,
+            shiny::tags$b(i18n$t("Original data:")),
+            shiny::verbatimTextOutput("original_str")
+          ),
+          shiny::column(
+            width = 6,
+            shiny::tags$b(i18n$t("Modified data:")),
+            shiny::verbatimTextOutput("modified_str")
+          )
+        ),
+        shiny::tags$br(),
+        shiny::actionButton(
+          inputId = "data_reset",
+          label = "Restore original data",
+          width = "100%"
+        ),
+        shiny::tags$br(),
+        shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
+        shiny::tags$br()
+      )
+      # )
+    ),
+    ##############################################################################
+    #########
+    #########  Descriptive analyses panel
+    #########
+    ##############################################################################
+    "describe" =
+      bslib::nav_menu(
+        title = i18n$t("Evaluate"),
+        icon = shiny::icon("magnifying-glass-chart"),
+        value = "nav_describe",
+        # id = "navdescribe",
+        # bslib::navset_bar(
+        #   title = "",
+        bslib::nav_panel(
+          title = "Characteristics",
+          icon = bsicons::bs_icon("table"),
+          bslib::layout_sidebar(
+            sidebar = bslib::sidebar(
+              shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
+              bslib::accordion(
+                open = "acc_chars",
+                multiple = FALSE,
+                bslib::accordion_panel(
+                  open = TRUE,
+                  value = "acc_chars",
+                  title = "Settings",
+                  icon = bsicons::bs_icon("table"),
+                  shiny::uiOutput("strat_var"),
+                  shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."),
+                  shiny::conditionalPanel(
+                    condition = "input.strat_var!='none'",
+                    shiny::radioButtons(
+                      inputId = "add_p",
+                      label = "Compare strata?",
+                      selected = "no",
+                      inline = TRUE,
+                      choices = list(
+                        "No" = "no",
+                        "Yes" = "yes"
+                      )
+                    ),
+                    shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
+                  ),
+                  shiny::br(),
+                  shiny::br(),
+                  shiny::actionButton(
+                    inputId = "act_eval",
+                    label = "Evaluate",
+                    width = "100%",
+                    icon = shiny::icon("calculator"),
+                    disabled = TRUE
+                  )
+                )
+              )
+            ),
+            gt::gt_output(outputId = "table1")
+          )
+        ),
+        bslib::nav_panel(
+          title = "Correlations",
+          icon = bsicons::bs_icon("bounding-box"),
+          bslib::layout_sidebar(
+            sidebar = bslib::sidebar(
+              # shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
+              bslib::accordion(
+                open = "acc_chars",
+                multiple = FALSE,
+                bslib::accordion_panel(
+                  value = "acc_cor",
+                  title = "Correlations",
+                  icon = bsicons::bs_icon("bounding-box"),
+                  shiny::uiOutput("outcome_var_cor"),
+                  shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
+                  shiny::br(),
+                  shinyWidgets::noUiSliderInput(
+                    inputId = "cor_cutoff",
+                    label = "Correlation cut-off",
+                    min = 0,
+                    max = 1,
+                    step = .01,
+                    value = .8,
+                    format = shinyWidgets::wNumbFormat(decimals = 2),
+                    color = datamods:::get_primary_color()
+                  ),
+                  shiny::helpText("Set the cut-off for considered 'highly correlated'.")
+                )
+              )
+            ),
+            data_correlations_ui(id = "correlations", height = 600)
+          )
+        ),
+        bslib::nav_panel(
+          title = "Missings",
+          icon = bsicons::bs_icon("x-circle"),
+          bslib::layout_sidebar(
+            sidebar = bslib::sidebar(
+              bslib::accordion(
+                open = "acc_chars",
+                multiple = FALSE,
+                bslib::accordion_panel(
+                  vlaue = "acc_mis",
+                  title = "Missings",
+                  icon = bsicons::bs_icon("x-circle"),
+                  shiny::uiOutput("missings_var"),
+                  shiny::helpText("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
+                )
+              )
+            ),
+            data_missings_ui(id = "missingness")
+          )
+        )
+      ),
+    ##############################################################################
+    #########
+    #########  Visuals panel
+    #########
+    ##############################################################################
+    "visuals" = do.call(
+      bslib::nav_panel,
+      c(
+        list(
+          title = i18n$t("Visuals"),
+          icon = shiny::icon("chart-line"),
+          value = "nav_visuals"
+        ),
+        data_visuals_ui("visuals")
+      )
+      # do.call(
+      #   bslib::navset_bar,
+      #     data_visuals_ui("visuals")#,
+      # c(
+
+      # )
+      # )
+    ),
+    ##############################################################################
+    #########
+    #########  Regression analyses panel
+    #########
+    ##############################################################################
+    "analyze" =
+      bslib::nav_panel(
+        title = i18n$t("Regression"),
+        icon = shiny::icon("calculator"),
+        value = "nav_analyses",
+        do.call(
+          bslib::navset_card_tab,
+          regression_ui("regression")
+        )
+      ),
+    ##############################################################################
+    #########
+    #########  Download panel
+    #########
+    ##############################################################################
+    "download" =
+      bslib::nav_panel(
+        title = i18n$t("Download"),
+        icon = shiny::icon("download"),
+        value = "nav_download",
+        shiny::fluidRow(
+          shiny::column(width = 2),
+          shiny::column(
+            width = 8,
+            shiny::h4(i18n$t("Analysis validation")),
+            validation_ui("validation_all"),
+            shiny::fluidRow(
+              shiny::column(
+                width = 6,
+                shiny::h4(i18n$t("Report")),
+                shiny::helpText(i18n$t("Choose your favourite output file format for further work, and download, when the analyses are done.")),
+                shiny::br(),
+                shiny::br(),
+                shiny::selectInput(
+                  inputId = "output_type",
+                  label = "Output format",
+                  selected = NULL,
+                  choices = list(
+                    "MS Word" = "docx",
+                    "LibreOffice" = "odt"
+                    # ,
+                    # "PDF" = "pdf",
+                    # "All the above" = "all"
+                  )
+                ),
+                shiny::br(),
+                # Button
+                shiny::downloadButton(
+                  outputId = "report",
+                  label = "Download report",
+                  icon = shiny::icon("download")
+                )
+                # shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
+              ),
+              shiny::column(
+                width = 6,
+                shiny::h4("Data"),
+                shiny::helpText("Choose your favourite output data format to download the modified data."),
+                shiny::br(),
+                shiny::br(),
+                shiny::selectInput(
+                  inputId = "data_type",
+                  label = "Data format",
+                  selected = NULL,
+                  choices = list(
+                    "R" = "rds",
+                    "stata" = "dta",
+                    "CSV" = "csv"
+                  )
+                ),
+                shiny::helpText("No metadata is saved when exporting to csv."),
+                shiny::br(),
+                shiny::br(),
+                # Button
+                shiny::downloadButton(
+                  outputId = "data_modified",
+                  label = "Download data",
+                  icon = shiny::icon("download")
+                )
+              )
+            ),
+            shiny::br(),
+            shiny::br(),
+            shiny::h4("Code snippets"),
+            shiny::tags$p("Below are the code bits used to create the final data set and the main analyses."),
+            shiny::tags$p("This can be used as a starting point for learning to code and for reproducibility."),
+            shiny::tagList(
+              lapply(
+                paste0("code_", c(
+                  "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
+                )),
+                \(.x)shiny::htmlOutput(outputId = .x)
+              )
+            ),
+            shiny::tags$br(),
+            shiny::br()
+          ),
+          shiny::column(width = 2)
+        )
+      ),
+    ##############################################################################
+    #########
+    #########  Feedback link
+    #########
+    ##############################################################################
+    "feedback" = bslib::nav_item(
+      # shiny::img(shiny::icon("book")),
+      shiny::tags$a(
+        href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8",
+        "Feedback", shiny::icon("arrow-up-right-from-square"),
+        target = "_blank",
+        rel = "noopener noreferrer"
+      )
+    ),
+    ##############################################################################
+    #########
+    #########  Documentation link
+    #########
+    ##############################################################################
+    "docs" = bslib::nav_item(
+      # shiny::img(shiny::icon("book")),
+      shiny::tags$a(
+        href = "https://agdamsbo.github.io/FreesearchR/",
+        "Docs", shiny::icon("arrow-up-right-from-square"),
+        target = "_blank",
+        rel = "noopener noreferrer"
+      )
+    )
+    #   bslib::nav_panel(
+    #   title = "Documentation",
+    #   # shiny::tags$iframe("www/docs.html", height=600, width=535),
+    #   shiny::htmlOutput("docs_file"),
+    #   shiny::br()
+    # )
+  )
+  if (!is.null(selection)) {
+    out[[selection]]
+  } else {
+    out
+  }
+}
+
+
+# ls <- list("home"=1:4,
+#            "test"=1:4)
+#

R/update-factor-ext.R

@@ -33,7 +33,7 @@ update_factor_ui <- function(id) {
         width = 6,
         shinyWidgets::virtualSelectInput(
           inputId = ns("variable"),
-          label = i18n("Factor variable to reorder:"),
+          label = i18n$t("Factor variable to reorder:"),
           choices = NULL,
           width = "100%",
           zIndex = 50
@@ -46,7 +46,7 @@ update_factor_ui <- function(id) {
           inputId = ns("sort_levels"),
           label = tagList(
             phosphoricons::ph("sort-ascending"),
-            datamods:::i18n("Sort by levels")
+            i18n$t("Sort by levels")
           ),
           class = "btn-outline-primary mb-3",
           width = "100%"
@@ -59,7 +59,7 @@ update_factor_ui <- function(id) {
           inputId = ns("sort_occurrences"),
           label = tagList(
             phosphoricons::ph("sort-ascending"),
-            datamods:::i18n("Sort by count")
+            i18n$t("Sort by count")
           ),
           class = "btn-outline-primary mb-3",
           width = "100%"
@@ -71,7 +71,7 @@ update_factor_ui <- function(id) {
       class = "float-end",
       shinyWidgets::prettyCheckbox(
         inputId = ns("new_var"),
-        label = datamods:::i18n("Create a new variable (otherwise replaces the one selected)"),
+        label = i18n$t("Create a new variable (otherwise replaces the one selected)"),
         value = FALSE,
         status = "primary",
         outline = TRUE,
@@ -79,7 +79,7 @@ update_factor_ui <- function(id) {
       ),
       actionButton(
         inputId = ns("create"),
-        label = tagList(phosphoricons::ph("arrow-clockwise"), datamods:::i18n("Update factor variable")),
+        label = tagList(phosphoricons::ph("arrow-clockwise"), i18n$t("Update factor variable")),
         class = "btn-outline-primary"
       )
     ),
@@ -146,13 +146,13 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
           decreasing <- FALSE
           label <- tagList(
             phosphoricons::ph("sort-descending"),
-            datamods:::i18n("Sort count")
+            i18n$t("Sort count")
           )
         } else {
           decreasing <- TRUE
           label <- tagList(
             phosphoricons::ph("sort-ascending"),
-            datamods:::i18n("Sort count")
+            i18n$t("Sort count")
           )
         }
         updateActionButton(inputId = "sort_occurrences", label = as.character(label))
@@ -179,7 +179,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
         grid <- grid_columns(
           grid,
           columns = c("Var1", "Var1_toset", "Freq"),
-          header = c(datamods:::i18n("Levels"), "New label", datamods:::i18n("Count"))
+          header = c(i18n$t("Levels"), "New label", i18n$t("Count"))
         )
         grid <- grid_colorbar(
           grid,
@@ -241,7 +241,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) {
 #'
 #' @rdname update-factor
 modal_update_factor <- function(id,
-                                title = i18n("Update levels of a factor"),
+                                title = i18n$t("Update levels of a factor"),
                                 easyClose = TRUE,
                                 size = "l",
                                 footer = NULL) {
@@ -267,7 +267,7 @@ modal_update_factor <- function(id,
 #' @importFrom htmltools tagList
 #' @rdname update-factor
 winbox_update_factor <- function(id,
-                                 title = i18n("Update levels of a factor"),
+                                 title = i18n$t("Update levels of a factor"),
                                  options = shinyWidgets::wbOptions(),
                                  controls = shinyWidgets::wbControls()) {
   ns <- NS(id)

R/update-variables-ext.R

@@ -13,7 +13,7 @@ update_variables_ui <- function(id, title = "") {
   ns <- NS(id)
   if (isTRUE(title)) {
     title <- htmltools::tags$h4(
-      i18n("Update & select variables"),
+      i18n$t("Update & select variables"),
       class = "datamods-title"
     )
   }
@@ -35,19 +35,19 @@ update_variables_ui <- function(id, title = "") {
             ),
             shinyWidgets::textInputIcon(
               inputId = ns("format"),
-              label = i18n("Date format:"),
+              label = i18n$t("Date format:"),
               value = "%Y-%m-%d",
               icon = list(phosphoricons::ph("clock"))
             ),
             shinyWidgets::textInputIcon(
               inputId = ns("origin"),
-              label = i18n("Date to use as origin to convert date/datetime:"),
+              label = i18n$t("Date to use as origin to convert date/datetime:"),
               value = "1970-01-01",
               icon = list(phosphoricons::ph("calendar"))
             ),
             shinyWidgets::textInputIcon(
               inputId = ns("dec"),
-              label = i18n("Decimal separator:"),
+              label = i18n$t("Decimal separator:"),
               value = ".",
               icon = list("0.00")
             )
@@ -75,8 +75,8 @@ update_variables_ui <- function(id, title = "") {
     shiny::actionButton(
       inputId = ns("validate"),
       label = htmltools::tagList(
-        phosphoricons::ph("arrow-circle-right", title = datamods::i18n("Apply changes")),
+        phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes")),
-        datamods::i18n("Apply changes")
+        i18n$t("Apply changes")
       ),
       width = "100%"
     )
@@ -115,12 +115,11 @@ update_variables_server <- function(id,
       output$data_info <- shiny::renderUI({
         shiny::req(data_r())
         data_description(data_r())
-        # sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data))
       })
 
       variables_r <- shiny::reactive({
         shiny::validate(
-          shiny::need(data(), i18n("No data to display."))
+          shiny::need(data(), i18n$t("No data to display."))
         )
         data <- data_r()
         if (isTRUE(return_data_on_init)) {
@@ -225,7 +224,7 @@ update_variables_server <- function(id,
             datamods:::insert_alert(
               selector = ns("update"),
               status = "success",
-              tags$b(phosphoricons::ph("check"), datamods::i18n("Data successfully updated!"))
+              tags$b(phosphoricons::ph("check"), i18n$t("Data successfully updated!"))
             )
             updated_data$x <- data
             updated_data$list_rename <- list_rename
@@ -804,3 +803,4 @@ clean_date <- function(data) {
     }) |>
     unname()
 }
+#

R/validation.R

@@ -0,0 +1,390 @@
+# Description of warning with text description incl metric
+# Color coded (green (OK) or yellow (WARNING))
+# option to ignore/accept warnings ### to simplify things, this is gone for now ###
+# Only show warnings based on performed analyses
+
+## 250825
+## Works in demo
+## Not alert is printed in app interface
+## I believe it comes down to the reactivity
+
+
+########################################################################
+############# Server and UI
+########################################################################
+
+#' @title Validation module
+#'
+#' @description Check that a dataset respect some validation expectations.
+#'
+#' @param id Module's ID.
+#' @param max_height Maximum height for validation results element, useful if you have many rules.
+#' @param ... Arguments passed to \code{actionButton} or \code{uiOutput} depending on display mode,
+#'  you cannot use \code{inputId}/\code{outputId}, \code{label} or \code{icon} (button only).
+#'
+#' @return
+#'  * UI: HTML tags that can be included in shiny's UI
+#'  * Server: a \code{list} with two slots:
+#'    + **status**: a \code{reactive} function returning the best status available between \code{"OK"}, \code{"Failed"} or \code{"Error"}.
+#'    + **details**: a \code{reactive} function returning a \code{list} with validation details.
+#' @export
+#'
+#' @rdname validation
+#'
+#' @example examples/validation_module_demo.R
+validation_ui <- function(id, max_height = NULL, ...) {
+  ns <- shiny::NS(id)
+
+  max_height <- if (!is.null(max_height)) {
+    paste0("overflow-y: auto; max-height:", htmltools::validateCssUnit(max_height), ";")
+  }
+
+  ui <- shiny::uiOutput(
+    outputId = ns("results"),
+    ...,
+    style = max_height
+  )
+
+  htmltools::tagList(
+    ui, datamods:::html_dependency_datamods()
+  )
+}
+
+#' @export
+#'
+#' @param data a \code{reactive} function returning a \code{data.frame}.
+#'
+#' @rdname validation
+#'
+validation_server <- function(id,
+                              data) {
+  moduleServer(
+    id = id,
+    module = function(input, output, session) {
+      valid_ui <- reactiveValues(x = NULL)
+
+      data_r <- if (shiny::is.reactive(data)) data else shiny::reactive(data)
+
+      # observeEvent(data_r(), {
+      #   to_validate <- data()
+      #   valid_dims <- check_data(to_validate, n_row = n_row, n_col = n_col)
+      #
+      #   if (all(c(valid_dims$nrows, valid_dims$ncols))) {
+      #     valid_status <- "OK"
+      #   } else {
+      #     valid_status <- "Failed"
+      #   }
+      #
+      #   valid_results <- lapply(
+      #     X = c("nrows", "ncols"),
+      #     FUN = function(x) {
+      #       if (is.null(valid_dims[[x]]))
+      #         return(NULL)
+      #       label <- switch(
+      #         x,
+      #         "nrows" = n_row_label,
+      #         "ncols" = n_col_label
+      #       )
+      #       list(
+      #         status = ifelse(valid_dims[[x]], "OK", "Failed"),
+      #         label = paste0("<b>", label, "</b>")
+      #       )
+      #     }
+      #   )
+
+      shiny::observeEvent(
+        data_r(),
+        {
+          # browser()
+          to_validate <- data_r()
+          if (is.reactivevalues(to_validate))
+            out <- lapply(
+              reactiveValuesToList(to_validate),
+              make_validation_alerts) |>
+            purrr::list_flatten()
+
+          if (length(to_validate) > 0) {
+            out <- make_validation_alerts(to_validate)
+          }
+          valid_ui$x <- tagList(out)
+        }
+      )
+
+      output$results <- renderUI({
+        valid_ui$x
+      })
+    }
+  )
+}
+
+
+########################################################################
+############# Validation functions
+########################################################################
+
+#' Dimensions validation
+#'
+#' @param before data before
+#' @param after data after
+#' @param fun dimension function. ncol or nrow
+#'
+#' @returns data.frame
+#'
+dim_change_call <- function(before, after, fun) {
+  # browser()
+  if (!0 %in% c(dim(before), dim(after))) {
+    n_before <- fun(before)
+    n_after <- fun(after)
+    n_out <- n_before - n_after
+    p_after <- n_after / fun(before) * 100
+    p_out <- 100 - p_after
+
+    data.frame(
+      n_before = n_before,
+      n_after = n_after,
+      n_out = n_out,
+      p_after = p_after,
+      p_out = p_out
+    ) |>
+      dplyr::mutate(
+        dplyr::across(
+          dplyr::where(
+            is.numeric
+          ),
+          \(.y) round(.y, 0)
+        )
+      )
+  } else {
+    data.frame(NULL)
+  }
+}
+
+#' Variable filter test wrapper
+#'
+#' @param before data before
+#' @param after data after
+#'
+#' @returns vector
+#'
+#' @examples
+#' vars_filter_validate(mtcars, mtcars[1:6])
+#' vars_filter_validate(mtcars, mtcars[0])
+vars_filter_validate <- function(before, after) {
+  dim_change_call(before, after, ncol)
+}
+
+#' Observations filter test wrapper
+#'
+#' @param before data before
+#' @param after data after
+#'
+#' @returns vector
+#'
+obs_filter_validate <- function(before, after) {
+  dim_change_call(before, after, nrow)
+}
+
+#' Validate function of missingness in data
+#'
+#' @param data data set
+#'
+#' @returns data.frame
+#' @export
+#'
+#' @examples
+#' df <- mtcars
+#' df[1,2:4] <- NA
+#' missings_validate(df)
+missings_validate <- function(data){
+  if (!0 %in% dim(data)) {
+    # browser()
+    p_miss <- sum(is.na(data))/prod(dim(data))*100
+    data.frame(
+      p_miss = p_miss
+    ) |>
+      dplyr::mutate(
+        dplyr::across(
+          dplyr::where(
+            is.numeric
+          ),
+          \(.y) signif(.y, 2)
+        )
+      )
+  } else {
+    data.frame(NULL)
+  }
+}
+
+
+########################################################################
+############# Collected validation functions in a library-like function
+########################################################################
+
+
+#' Validation library
+#'
+#' @param name Index name
+#'
+#' @returns list
+#'
+#' @examples
+#' validation_lib()
+#' validation_lib("missings")
+validation_lib <- function(name=NULL) {
+  ls <- list(
+    "obs_filter" = function(x, y) {
+      ## Validation function for observations filter
+      list(
+        string = i18n$t("You removed {p_out} % of observations."),
+        summary.fun = obs_filter_validate,
+        summary.fun.args = list(
+          before = x,
+          after = y
+        ),
+        test.fun = function(x, var, cut) {
+          test.var <- x[var]
+          ifelse(test.var > cut, "warning", "succes")
+        },
+        test.fun.args = list(var = "p_out", cut = 50)
+      )
+    },
+    "var_filter" = function(x, y) {
+      ## Validation function for variables filter
+      list(
+        string = i18n$t("You removed {p_out} % of variables."),
+        summary.fun = vars_filter_validate,
+        summary.fun.args = list(
+          before = x,
+          after = y
+        ),
+        test.fun = function(x, var, cut) {
+          test.var <- x[var]
+          ifelse(test.var > cut, "warning", "succes")
+        },
+        test.fun.args = list(var = "p_out", cut = 50)
+      )
+    },
+    "missings" = function(x, y) {
+      ### Placeholder for missingness validation
+      list(
+        string = "There are {p_miss} % missing observations.",
+        summary.fun = missings_validate,
+        summary.fun.args = list(
+          data = x
+        ),
+        test.fun = function(x, var, cut) {
+          test.var <- x[var]
+          ifelse(test.var > cut, "warning", "succes")
+        },
+        test.fun.args = list(var = "p_miss", cut = 30)
+      )
+    }
+  )
+
+  if (!is.null(name)){
+    name <- match.arg(name,choices = names(ls))
+    ls[[name]]
+  } else {
+    ls
+  }
+}
+
+
+########################################################################
+############# Validation creation
+########################################################################
+
+#' Create validation data.frame
+#'
+#' @param ls validation list
+#' @param ... magic dots
+#'
+#' @returns data.frame
+#' @export
+#'
+#' @examples
+#' i18n <- shiny.i18n::Translator$new(translation_csvs_path = here::here("inst/translations"))
+#' i18n$set_translation_language("en")
+#' df_original <- mtcars
+#' df_original[1,2:4] <- NA
+#' df_obs <- df_original |> dplyr::filter(carb==4)
+#' df_vars <- df_original[1:7]
+#' val <- purrr::map2(
+#'   .x = validation_lib(),
+#'   .y = list(
+#'   list(x = df_original, y = df_obs),
+#'   list(x = df_original, y = df_vars),
+#'   list(x=df_original)),
+#'   make_validation
+#' )
+#' val |> make_validation_alerts()
+#'
+#' val2 <- purrr::map2(
+#'   .x = validation_lib()[2],
+#'   .y = list(list(x = mtcars, y = mtcars[0])),
+#'   make_validation
+#' )
+#' val2 |> make_validation_alerts()
+#'
+#' val3 <- make_validation(
+#'   ls = validation_lib()[[2]],
+#'   list(x = mtcars, y = mtcars[0])
+#' )
+make_validation <- function(ls, ...) {
+  ls <- do.call(ls, ...)
+
+  df <- do.call(ls$summary.fun, ls$summary.fun.args)
+
+  if (!any(dim(df) == c(0))) {
+    label <- with(df, {
+      glue::glue(ls$string)
+    })
+
+    # browser()
+    status <- do.call(ls$test.fun, modifyList(ls$test.fun.args, list(x = df)))
+
+    data.frame(
+      label = label,
+      status = status[1]
+    )
+  } else {
+    data.frame(NULL)
+  }
+}
+
+
+#' Create alert from validation data.frame
+#'
+#' @param data
+#'
+#' @export
+make_validation_alerts <- function(data) {
+  # browser()
+  if (is.data.frame(data)){
+    ls <- list(data)
+  } else {
+    ls <- data
+  }
+
+  lapply(
+    X = ls,
+    FUN = function(x) {
+      # browser()
+      if (!is.null(dim(x)) && !any(dim(x) == c(0))) {
+        icon <- switch(x$status,
+          "succes" = phosphoricons::ph("check", title = "OK"),
+          "warning" = phosphoricons::ph("warning", title = "Warning")
+        )
+
+        shinyWidgets::alert(
+          icon,
+          htmltools::HTML(x$label),
+          status = x$status,
+          style = "margin-bottom: 10px; padding: 10px;"
+        )
+      } else {
+        return(NULL)
+      }
+    }
+  )
+}

R/visual_summary.R

@@ -0,0 +1,291 @@
+#' Data correlations evaluation module
+#'
+#' @param id Module id
+#'
+#' @name data-missings
+#' @returns Shiny ui module
+#' @export
+visual_summary_ui <- function(id) {
+  ns <- shiny::NS(id)
+
+  shiny::tagList(
+    shiny::plotOutput(outputId = ns("visual_plot"), height = "70vh")
+  )
+}
+
+visual_summary_server <- function(id,
+                                  data_r=shiny::reactive(NULL),
+                                  ...) {
+  shiny::moduleServer(
+    id = id,
+    module = function(input, output, session) {
+      # ns <- session$ns
+      rv <- shiny::reactiveValues(data = NULL)
+
+      shiny::bindEvent(shiny::observe({
+        data <- data_r()
+        rv$data <- data
+        # vars_num <- vapply(data, \(.x){
+        #   is.numeric(.x) || is_datetime(.x)
+        # }, logical(1))
+        # vars_num <- names(vars_num)[vars_num]
+        # shinyWidgets::updateVirtualSelect(
+        #   inputId = "variable",
+        #   choices = vars_num,
+        #   selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
+        # )
+      }), data_r(), input$hidden)
+
+      # datar <- if (is.reactive(data)) data else reactive(data)
+
+
+      # apexcharter::renderApexchart({
+      #   missings_apex_plot(datar(), ...)
+      # })
+      output$visual_plot <- shiny::renderPlot(expr = {
+        visual_summary(data = rv$data,...)
+      })
+    }
+  )
+}
+
+visual_summary_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::actionButton(
+      inputId = "modal_missings",
+      label = "Visual summary",
+      width = "100%",
+      disabled = FALSE
+    )
+  )
+  server <- function(input, output, session) {
+    data_demo <- mtcars
+    data_demo[sample(1:32, 10), "cyl"] <- NA
+    data_demo[sample(1:32, 8), "vs"] <- NA
+
+    visual_summary_server(id = "data", data = shiny::reactive(data_demo))
+
+    observeEvent(input$modal_missings, {
+      tryCatch(
+        {
+          modal_visual_summary(id = "data")
+        },
+        error = function(err) {
+          showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
+        }
+      )
+    })
+  }
+  shiny::shinyApp(ui, server)
+}
+
+visual_summary_demo_app()
+
+
+modal_visual_summary <- function(id,
+                                 title = "Visual overview of data classes and missing observations",
+                                 easyClose = TRUE,
+                                 size = "xl",
+                                 footer = NULL,
+                                 ...) {
+  showModal(modalDialog(
+    title = tagList(title, datamods:::button_close_modal()),
+    visual_summary_ui(id = id),
+    easyClose = easyClose,
+    size = size,
+    footer = footer
+  ))
+}
+
+
+## Slow with many observations...
+
+#' Plot missings and class with apexcharter
+#'
+#' @param data data frame
+#'
+#' @returns An [apexchart()] `htmlwidget` object.
+#' @export
+#'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[2:4, "cyl"] <- NA
+#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
+#' data_demo |> missings_apex_plot()
+#' mtcars |> missings_apex_plot(animation = TRUE)
+#' # dplyr::storms |> missings_apex_plot()
+#' visdat::vis_dat(dplyr::storms)
+missings_apex_plot <- function(data, animation = FALSE, ...) {
+  l <- data_summary_gather(data, ...)
+
+  df_plot <- l$data
+
+  out <- apexcharter::apex(
+    data = df_plot,
+    type = "heatmap",
+    mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num),
+    ...
+  ) |>
+    apexcharter::ax_stroke(width = NULL) |>
+    apexcharter::ax_plotOptions(
+      heatmap = apexcharter::heatmap_opts(
+        radius = 0,
+        enableShades = FALSE,
+        colorScale = list(
+          ranges = l$labels
+        ),
+        useFillColorAsStroke = TRUE
+      )
+    ) |>
+    apexcharter::ax_dataLabels(enabled = FALSE) |>
+    apexcharter::ax_tooltip(
+      enabled = FALSE,
+      intersect = FALSE
+    )
+
+  if (!isTRUE(animation)) {
+    out <- out |>
+      apexcharter::ax_chart(animations = list(enabled = FALSE))
+  }
+
+  out
+}
+
+
+
+#' Ggplot2 data summary visualisation based on visdat::vis_dat.
+#'
+#' @param data data
+#' @param ... optional arguments passed to data_summary_gather()
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @examples
+#' data_demo <- mtcars
+#' data_demo[sample(1:32, 10), "cyl"] <- NA
+#' data_demo[sample(1:32, 8), "vs"] <- NA
+#' visual_summary(data_demo)
+#' visual_summary(data_demo, palette.fun = scales::hue_pal())
+#' visual_summary(dplyr::storms)
+#' visual_summary(dplyr::storms, summary.fun = data_type)
+visual_summary <- function(data, legend.title = "Data class", ...) {
+  l <- data_summary_gather(data, ...)
+
+  df <- l$data
+
+  df$valueType <- factor(df$valueType, levels = names(l$colors))
+  df$variable <- factor(df$variable, levels = unique_short(names(data)))
+
+  ggplot2::ggplot(data = df, ggplot2::aes(x = variable, y = rows)) +
+    ggplot2::geom_raster(ggplot2::aes(fill = valueType)) +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(
+      angle = 45,
+      vjust = 1, hjust = 1
+    )) +
+    ggplot2::scale_fill_manual(values = l$colors) +
+    ggplot2::labs(x = "", y = "Observations") +
+    ggplot2::scale_y_reverse() +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) +
+    ggplot2::guides(colour = "none") +
+    ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) +
+    # change the limits etc.
+    ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) +
+    # add info about the axes
+    ggplot2::scale_x_discrete(position = "top") +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) +
+    ggplot2::theme(
+      panel.grid.major = ggplot2::element_blank(),
+      panel.grid.minor = ggplot2::element_blank(),
+      text = ggplot2::element_text(size = 18),
+      plot.title = ggplot2::element_blank()
+    )
+}
+
+#' Data summary for printing visual summary
+#'
+#' @param data data.frame
+#' @param fun summary function. Default is "class"
+#' @param palette.fun optionally use specific palette functions. First argument
+#' has to be the length.
+#'
+#' @returns data.frame
+#' @export
+#'
+#' @examples
+#' mtcars |> data_summary_gather()
+data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) {
+  df_plot <- setNames(data, unique_short(names(data))) |>
+    purrr::map_df(\(x){
+      ifelse(is.na(x),
+        yes = NA,
+        no = glue::glue_collapse(summary.fun(x),
+          sep = "\n"
+        )
+      )
+    }) |>
+    dplyr::mutate(rows = dplyr::row_number()) |>
+    tidyr::pivot_longer(
+      cols = -rows,
+      names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character)
+    ) |>
+    dplyr::arrange(rows, variable, valueType)
+
+
+  df_plot$valueType_num <- df_plot$valueType |>
+    forcats::as_factor() |>
+    as.numeric()
+
+  df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
+  df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
+
+  labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort()
+
+  if (any(df_plot$valueType == "NA")) {
+    colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels))
+  } else {
+    colors <- setNames(palette.fun(length(labels)), names(labels))
+  }
+
+
+  label_list <- labels |>
+    purrr::imap(\(.x, .i){
+      list(
+        from = .x,
+        to = .x,
+        color = colors[[.i]],
+        name = .i
+      )
+    }) |>
+    setNames(NULL)
+
+  list(data = df_plot, colors = colors, labels = label_list)
+}
+
+
+
+#' Create unique short names of character vector items based on index
+#'
+#' @description
+#' The function will prefer original names, and only append index to long
+#' strings.
+#'
+#'
+#' @param data character vector
+#' @param max maximum final name length
+#'
+#' @returns character vector
+#' @export
+#'
+#' @examples
+#' c("kahdleidnsallskdj", "hej") |> unique_short()
+unique_short <- function(data, max = 15) {
+  purrr::imap(data, \(.x, .i){
+    if (nchar(.x) > max) {
+      glue::glue("{substr(.x,1,(max-(nchar(.i)+1)))}_{.i}")
+    } else {
+      .x
+    }
+  }) |> unlist()
+}

README.md

@@ -27,7 +27,13 @@ This app has the following simple goals:
 
 ## Run locally on your own machine
 
-The ***FreesearchR*** app can also run on your own machine with no data transmitted anywhere. Any data.frame available in the global environment will be accessible from the interface. Just follow the below steps:
+The ***FreesearchR*** app can also run on your own machine with no data transmitted anywhere. Blow are the available options.
+
+### Run from R (or RStduio)
+
+Working with data in R, FreesearchR is a quick and easy tool to get overview and perform the first explorative analyses to get you going.
+
+Any data available in the your R session will be available to the FreesearchR app. Just follow the below steps to get going:
 
 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/). 
 
@@ -43,6 +49,21 @@ The ***FreesearchR*** app can also run on your own machine with no data transmit
      launch_FreesearchR()
      ```
 
+### Running with docker compose
+
+For advanced users, wanting to deploy the FreesearchR app to run anywhere, a docker image is available.
+
+Below is the minimal `docker_compose.yml` file:
+
+```
+services:
+  freesearchr: 
+    image: ghcr.io/agdamsbo/freesearchr:latest 
+    ports: 
+      - '3838:3838'
+    restart: on-failure
+```
+
 ## Code of Conduct
 
 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.

SESSION.md

@@ -4,18 +4,18 @@
 |setting     |value                                      |
 |:-----------|:------------------------------------------|
 |version     |R version 4.4.1 (2024-06-14)               |
-|os          |macOS 15.3.1                               |
+|os          |macOS 15.6.1                               |
 |system      |aarch64, darwin20                          |
 |ui          |RStudio                                    |
 |language    |(EN)                                       |
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2025-06-04                                 |
+|date        |2025-09-10                                 |
 |rstudio     |2025.05.0+496 Mariposa Orchid (desktop)    |
 |pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
 |quarto      |1.7.30 @ /usr/local/bin/quarto             |
-|FreesearchR |25.6.1.250604                              |
+|FreesearchR |25.8.3.250910                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -28,19 +28,19 @@
 |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) |
+|bayestestR        |0.16.1        |2025-07-01 |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) |
 |bitops            |1.0-9         |2024-10-03 |CRAN (R 4.4.1) |
 |boot              |1.3-31        |2024-08-28 |CRAN (R 4.4.1) |
 |brio              |1.1.5         |2024-04-24 |CRAN (R 4.4.1) |
-|broom             |1.0.8         |2025-03-28 |CRAN (R 4.4.1) |
+|broom             |1.0.9         |2025-07-28 |CRAN (R 4.4.1) |
 |broom.helpers     |1.21.0        |2025-04-24 |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) |
-|cards             |0.6.0         |2025-04-11 |CRAN (R 4.4.1) |
+|cards             |0.6.1         |2025-07-03 |CRAN (R 4.4.1) |
-|cardx             |0.2.4         |2025-04-12 |CRAN (R 4.4.1) |
+|cardx             |0.2.5         |2025-07-03 |CRAN (R 4.4.1) |
 |caTools           |1.18.3        |2024-09-04 |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) |
@@ -51,13 +51,13 @@
 |cluster           |2.1.8.1       |2025-03-12 |CRAN (R 4.4.1) |
 |codetools         |0.2-20        |2024-03-31 |CRAN (R 4.4.1) |
 |colorspace        |2.1-1         |2024-07-26 |CRAN (R 4.4.1) |
-|commonmark        |1.9.5         |2025-03-17 |CRAN (R 4.4.1) |
+|commonmark        |2.0.0         |2025-07-07 |CRAN (R 4.4.1) |
 |crayon            |1.5.3         |2024-06-20 |CRAN (R 4.4.1) |
-|curl              |6.2.2         |2025-03-24 |CRAN (R 4.4.1) |
+|curl              |6.4.0         |2025-06-22 |CRAN (R 4.4.1) |
-|data.table        |1.17.0        |2025-02-22 |CRAN (R 4.4.1) |
+|data.table        |1.17.8        |2025-07-10 |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) |
+|datawizard        |1.2.0         |2025-07-17 |CRAN (R 4.4.1) |
-|DEoptimR          |1.1-3-1       |2024-11-23 |CRAN (R 4.4.1) |
+|DEoptimR          |1.1-4         |2025-07-27 |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) |
@@ -66,16 +66,16 @@
 |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) |
+|easystats         |0.7.5         |2025-07-11 |CRAN (R 4.4.1) |
 |ellipsis          |0.3.2         |2021-04-29 |CRAN (R 4.4.1) |
-|emmeans           |1.11.1        |2025-05-04 |CRAN (R 4.4.1) |
+|emmeans           |1.11.2        |2025-07-11 |CRAN (R 4.4.1) |
 |esquisse          |2.1.0         |2025-02-21 |CRAN (R 4.4.1) |
-|estimability      |1.5.1         |2024-05-12 |CRAN (R 4.4.0) |
+|estimability      |1.5.1         |2024-05-12 |CRAN (R 4.4.1) |
 |eulerr            |7.0.2         |2024-03-28 |CRAN (R 4.4.0) |
-|evaluate          |1.0.3         |2025-01-10 |CRAN (R 4.4.1) |
+|evaluate          |1.0.4         |2025-06-18 |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) |
-|flextable         |0.9.7         |2024-10-27 |CRAN (R 4.4.1) |
+|flextable         |0.9.9         |2025-05-31 |CRAN (R 4.4.1) |
 |fontawesome       |0.5.3         |2024-11-16 |CRAN (R 4.4.1) |
 |fontBitstreamVera |0.1.1         |2017-02-01 |CRAN (R 4.4.1) |
 |fontLiberation    |0.1.0         |2016-10-15 |CRAN (R 4.4.1) |
@@ -84,22 +84,22 @@
 |foreach           |1.5.2         |2022-02-02 |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) |
-|FreesearchR       |25.6.1        |NA         |NA             |
+|FreesearchR       |25.8.3        |NA         |NA             |
 |fs                |1.6.6         |2025-04-12 |CRAN (R 4.4.1) |
 |gdtools           |0.4.2         |2025-03-27 |CRAN (R 4.4.1) |
-|generics          |0.1.3         |2022-07-05 |CRAN (R 4.4.1) |
+|generics          |0.1.4         |2025-05-09 |CRAN (R 4.4.1) |
 |ggalluvial        |0.12.5        |2023-02-22 |CRAN (R 4.4.0) |
 |ggcorrplot        |0.1.4.1       |2023-09-05 |CRAN (R 4.4.0) |
-|ggforce           |0.4.2         |2024-02-19 |CRAN (R 4.4.0) |
+|ggforce           |0.5.0         |2025-06-18 |CRAN (R 4.4.1) |
 |ggplot2           |3.5.2         |2025-04-09 |CRAN (R 4.4.1) |
 |ggridges          |0.5.6         |2024-01-23 |CRAN (R 4.4.0) |
-|ggstats           |0.9.0         |2025-03-10 |CRAN (R 4.4.1) |
+|ggstats           |0.10.0        |2025-07-02 |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) |
+|gtsummary         |2.3.0         |2025-07-03 |CRAN (R 4.4.1) |
-|haven             |2.5.4         |2023-11-30 |CRAN (R 4.4.0) |
+|haven             |2.5.5         |2025-05-30 |CRAN (R 4.4.1) |
 |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) |
@@ -107,14 +107,14 @@
 |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) |
+|IDEAFilter        |0.2.1         |2025-07-29 |CRAN (R 4.4.1) |
-|insight           |1.2.0         |2025-04-22 |CRAN (R 4.4.1) |
+|insight           |1.4.0         |2025-08-18 |CRAN (R 4.4.1) |
 |iterators         |1.0.14        |2022-02-05 |CRAN (R 4.4.1) |
 |jquerylib         |0.1.4         |2021-04-26 |CRAN (R 4.4.0) |
 |jsonlite          |2.0.0         |2025-03-27 |CRAN (R 4.4.1) |
 |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) |
+|keyring           |1.4.1         |2025-06-15 |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) |
 |lattice           |0.22-7        |2025-04-02 |CRAN (R 4.4.1) |
@@ -129,20 +129,21 @@
 |miniUI            |0.1.2         |2025-04-17 |CRAN (R 4.4.1) |
 |minqa             |1.2.8         |2024-08-17 |CRAN (R 4.4.1) |
 |mvtnorm           |1.3-3         |2025-01-10 |CRAN (R 4.4.1) |
+|NHANES            |2.1.0         |2015-07-02 |CRAN (R 4.4.0) |
 |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) |
-|officer           |0.6.8         |2025-03-23 |CRAN (R 4.4.1) |
+|officer           |0.6.10        |2025-05-30 |CRAN (R 4.4.1) |
 |opdisDownsampling |1.0.1         |2024-04-15 |CRAN (R 4.4.0) |
-|openssl           |2.3.2         |2025-02-03 |CRAN (R 4.4.1) |
+|openssl           |2.3.3         |2025-05-26 |CRAN (R 4.4.1) |
-|openxlsx2         |1.15          |2025-04-25 |CRAN (R 4.4.1) |
+|openxlsx2         |1.18          |2025-07-29 |CRAN (R 4.4.1) |
-|parameters        |0.24.2        |2025-03-04 |CRAN (R 4.4.1) |
+|parameters        |0.27.0        |2025-07-09 |CRAN (R 4.4.1) |
-|patchwork         |1.3.0         |2024-09-16 |CRAN (R 4.4.1) |
+|patchwork         |1.3.1         |2025-06-21 |CRAN (R 4.4.1) |
 |pbmcapply         |1.5.1         |2022-04-28 |CRAN (R 4.4.1) |
-|performance       |0.13.0        |2025-01-15 |CRAN (R 4.4.1) |
+|performance       |0.15.0        |2025-07-10 |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) |
+|pillar            |1.11.0        |2025-07-04 |CRAN (R 4.4.1) |
-|pkgbuild          |1.4.7         |2025-03-24 |CRAN (R 4.4.1) |
+|pkgbuild          |1.4.8         |2025-05-26 |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) |
@@ -150,31 +151,36 @@
 |pracma            |2.4.4         |2023-11-10 |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) |
+|promises          |1.3.3         |2025-05-29 |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) |
+|purrr             |1.1.0         |2025-07-10 |CRAN (R 4.4.1) |
 |qqconf            |1.3.2         |2023-04-14 |CRAN (R 4.4.0) |
 |qqplotr           |0.0.6         |2023-01-25 |CRAN (R 4.4.0) |
-|quarto            |1.4.4         |2024-07-20 |CRAN (R 4.4.0) |
+|quarto            |1.5.0         |2025-07-28 |RSPM (R 4.4.0) |
+|R.cache           |0.17.0        |2025-05-02 |CRAN (R 4.4.1) |
+|R.methodsS3       |1.8.2         |2022-06-13 |CRAN (R 4.4.1) |
+|R.oo              |1.27.1        |2025-05-02 |CRAN (R 4.4.1) |
+|R.utils           |2.13.0        |2025-02-24 |CRAN (R 4.4.1) |
 |R6                |2.6.1         |2025-02-15 |CRAN (R 4.4.1) |
 |ragg              |1.4.0         |2025-04-10 |CRAN (R 4.4.1) |
 |rankinPlot        |1.1.0         |2023-01-30 |CRAN (R 4.4.0) |
+|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) |
+|Rcpp              |1.1.0         |2025-07-02 |CRAN (R 4.4.1) |
-|RcppArmadillo     |14.4.2-1      |2025-04-25 |CRAN (R 4.4.1) |
+|RcppArmadillo     |14.6.0-1      |2025-07-02 |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) |
+|REDCapR           |1.5.0         |2025-07-28 |CRAN (R 4.4.1) |
-|reformulas        |0.4.0         |2024-11-03 |CRAN (R 4.4.1) |
+|reformulas        |0.4.1         |2025-04-30 |CRAN (R 4.4.1) |
 |remotes           |2.5.0         |2024-03-17 |CRAN (R 4.4.1) |
 |rempsyc           |0.1.9         |2025-02-01 |CRAN (R 4.4.1) |
-|renv              |1.1.4         |2025-03-20 |CRAN (R 4.4.1) |
+|renv              |1.1.5         |2025-07-24 |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) |
@@ -182,25 +188,27 @@
 |robustbase        |0.99-4-1      |2024-09-27 |CRAN (R 4.4.1) |
 |roxygen2          |7.3.2         |2024-06-28 |CRAN (R 4.4.0) |
 |rpart             |4.1.24        |2025-01-07 |CRAN (R 4.4.1) |
-|rprojroot         |2.0.4         |2023-11-05 |CRAN (R 4.4.1) |
+|rprojroot         |2.1.0         |2025-07-12 |CRAN (R 4.4.1) |
-|rsconnect         |1.3.4         |2025-01-22 |CRAN (R 4.4.1) |
+|rsconnect         |1.5.0         |2025-06-26 |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.4.0         |2025-04-24 |CRAN (R 4.4.1) |
 |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) |
+|shiny             |1.11.1        |2025-07-03 |CRAN (R 4.4.1) |
+|shiny.i18n        |0.3.0         |2023-01-16 |CRAN (R 4.4.0) |
 |shinybusy         |0.3.3         |2024-03-09 |CRAN (R 4.4.0) |
 |shinyjs           |2.1.0         |2021-12-23 |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) |
-|systemfonts       |1.2.2         |2025-04-04 |CRAN (R 4.4.1) |
+|styler            |1.10.3        |2024-04-07 |CRAN (R 4.4.0) |
+|systemfonts       |1.2.3         |2025-04-30 |CRAN (R 4.4.1) |
 |testthat          |3.2.3         |2025-01-13 |CRAN (R 4.4.1) |
-|textshaping       |1.0.0         |2025-01-20 |CRAN (R 4.4.1) |
+|textshaping       |1.0.1         |2025-05-01 |CRAN (R 4.4.1) |
-|thematic          |0.1.6         |2024-07-29 |CRAN (R 4.4.0) |
+|thematic          |0.1.7         |2025-06-19 |CRAN (R 4.4.1) |
-|tibble            |3.2.1         |2023-03-20 |CRAN (R 4.4.0) |
+|tibble            |3.3.0         |2025-06-08 |CRAN (R 4.4.1) |
 |tidyr             |1.3.1         |2024-01-24 |CRAN (R 4.4.1) |
 |tidyselect        |1.2.1         |2024-03-11 |CRAN (R 4.4.0) |
 |timechange        |0.3.0         |2024-01-18 |CRAN (R 4.4.1) |
@@ -210,8 +218,9 @@
 |tzdb              |0.5.0         |2025-03-15 |CRAN (R 4.4.1) |
 |urlchecker        |1.0.1         |2021-11-30 |CRAN (R 4.4.1) |
 |usethis           |3.1.0         |2024-11-26 |CRAN (R 4.4.1) |
+|utf8              |1.2.6         |2025-06-08 |CRAN (R 4.4.1) |
 |uuid              |1.2-1         |2024-07-29 |CRAN (R 4.4.1) |
-|V8                |6.0.3         |2025-03-26 |CRAN (R 4.4.1) |
+|V8                |6.0.6         |2025-08-18 |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) |
@@ -220,4 +229,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) |
+|zip               |2.3.3         |2025-05-13 |CRAN (R 4.4.1) |

app_docker/.dockerignore

@@ -0,0 +1,6 @@
+.Rhistory
+.git
+.gitignore
+manifest.json
+rsconnect/
+.Rproj.user

app_docker/Dockerfile

@@ -0,0 +1,12 @@
+FROM rocker/geospatial:4.4.1
+RUN apt-get update -y && apt-get install -y  cmake make libcurl4-openssl-dev libicu-dev libssl-dev pandoc zlib1g-dev libsecret-1-dev libxml2-dev libx11-dev libcairo2-dev libfontconfig1-dev libfreetype6-dev libfribidi-dev libharfbuzz-dev libjpeg-dev libpng-dev libtiff-dev libfftw3-dev && rm -rf /var/lib/apt/lists/*
+RUN mkdir -p /usr/local/lib/R/etc/ /usr/lib/R/etc/
+RUN echo "options(renv.config.pak.enabled = FALSE, repos = c(CRAN = 'https://cran.rstudio.com/'), download.file.method = 'libcurl', Ncpus = 4)" | tee /usr/local/lib/R/etc/Rprofile.site | tee /usr/lib/R/etc/Rprofile.site
+RUN R -e 'install.packages("remotes")'
+RUN R -e 'remotes::install_version("renv", version = "1.1.5")'
+COPY renv.lock renv.lock
+RUN --mount=type=cache,id=renv-cache,target=/root/.cache/R/renv R -e 'renv::restore()'
+WORKDIR /srv/shiny-server/
+COPY . /srv/shiny-server/
+EXPOSE 3838
+CMD R -e 'shiny::runApp("/srv/shiny-server",host="0.0.0.0",port=3838)'

app_docker/www/intro.md

@@ -0,0 +1,19 @@
+# Welcome <img src="FreesearchR-logo.png" style="float: right;"/>
+
+This is the ***FreesearchR*** data analysis tool, a free tool for basic data evaluation and analysis. If you need more advanced tools, start with ***FreesearchR*** and then you'll probably be better off using *R* or similar directly.
+
+With this tool you can:
+
+1.  **Import data** from a spreadsheet/file on your machine, directly from a [REDCap](https://projectredcap.org/ "Read more on the data capture tool REDCap") server, try it with sample data or access data directly [if run in R locally](https://agdamsbo.github.io/FreesearchR//#run-locally-on-your-own-machine "Read about running FreesearchR on your local machine")
+
+2.  **Prepare** data for analysis by filtering data, modifying variables or create new variables
+
+3.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations as well as [missing observations](https://agdamsbo.github.io/FreesearchR/articles/missingness.html "Read more about missing data")
+
+4.  **Visualise data** by [creating simple, clean plots](https://agdamsbo.github.io/FreesearchR/articles/visuals.html "See available plot types") for overview and quick insights
+
+5.  **Create simple regression models** for even more advanced data analyses
+
+6.  **Download** results as a report, get the modified data set and save the code for learning and to reproduce the results later
+
+The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed descriptions of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).

app_docker/www/references.bib

@@ -0,0 +1,11 @@
+
+@book{andreasgammelgaarddamsbo2025,
+	title = {agdamsbo/FreesearchR: FreesearchR 25.4.3},
+	author = {Damsbo, Andreas Gammelgaard},
+	year = {2025},
+	month = {04},
+	date = {2025-04-24},
+	publisher = {Zenodo},
+	doi = {10.5281/ZENODO.14527429},
+	url = {https://zenodo.org/doi/10.5281/zenodo.14527429}
+}

app_docker/www/report.rmd

@@ -0,0 +1,83 @@
+---
+title: "FreesearchR data report"
+date: "Report generated `r gsub('(\\D)0', '\\1', format(Sys.time(), '%A, %d.%m.%Y'))`"
+format: docx
+author: FreesearchR data analysis tool
+toc: false
+params:
+  data.file: NA
+  version: NA
+  regression.p: NA
+---
+
+```{r setup, echo = FALSE}
+knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
+# glue::glue("{format(lubridate::today(),'%A')}, {lubridate::day(lubridate::today())}.{lubridate::month(lubridate::today())}.{lubridate::year(lubridate::today())}")
+```
+
+```{r}
+web_data <- readr::read_rds(file = params$data.file)
+# web_data <- readr::read_rds(file = "~/FreesearchR/inst/apps/FreesearchR/www/web_data.rds")
+library(gtsummary)
+library(gt)
+
+tbl_merge <- function(data) {
+  if (is.null(names(data))) {
+    data |> gtsummary::tbl_merge()
+  } else {
+    data |> gtsummary::tbl_merge(tab_spanner = names(data))
+  }
+}
+
+vec2sentence <- function(data, sep.word = "and") {
+  sep.word <- paste0(" ", gsub(" ", "", sep.word), " ")
+  if (length(data) < 2) {
+    out <- data
+  } else if (length(data) == 2) {
+    out <- paste(data, collapse = sep.word)
+  } else {
+    out <- paste(paste(data[-length(data)], collapse = ","), data[length(data)], sep = sep.word)
+  }
+  return(out)
+}
+```
+
+## Introduction
+
+Research should be free and open with easy access for all. The *FreesearchR* tool attempts to help lower the bar to participate in research by making basic data exploration and analyses easily accessible.
+
+## Methods
+
+Analyses were conducted using the *FreesearchR* data analysis web-tool version `r params$version` based on *R* version 4.4.1.
+
+## Results
+
+Below are the baseline characteristics.
+
+```{r, results = 'asis'}
+if ("table1" %in% names(web_data)) {
+  tbl <- gtsummary::as_gt(web_data$table1)
+  knitr::knit_print(tbl)
+}
+```
+
+`r if (length(web_data$regression) > 0) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$regression$tables)))} {web_data$regression$regression$params$descr}.")`
+
+```{r, results = 'asis'}
+if ("regression" %in% names(web_data) && length(web_data$regression) > 0) {
+  reg_tbl <- web_data$regression$regression$tables
+  
+  merged <- tbl_merge(reg_tbl)
+  
+  if (params$regression.p == "no") {
+            merged <- merged |>
+              gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
+          }
+  
+  knitr::knit_print(merged)
+}
+```
+
+## Discussion
+
+Good luck on your further work!

app_docker/www/scripts.js

@@ -0,0 +1,57 @@
+// Automatically close drop-downs on navigation
+// Thanks to claude.ai
+$(document).on('shown.bs.tab', '#main_panel', function(e) {
+  // Close dropdown in this specific navset only
+  $('#main_panel .dropdown-menu').removeClass('show');
+  $('#main_panel .dropdown-toggle').removeClass('show').attr('aria-expanded', 'false');
+});
+
+
+$(document).on('shiny:sessioninitialized', function() {
+  // Function to collapse navbar on mobile
+  function collapseNavbar() {
+    var navbar = $('.navbar-collapse');
+    if (navbar.hasClass('show')) {
+      navbar.removeClass('show');
+      $('.navbar-toggler').addClass('collapsed');
+      $('.navbar-toggler').attr('aria-expanded', 'false');
+    }
+  }
+
+  // Main approach: Handle clicks on nav elements
+  $(document).on('click', '.navbar-nav .nav-link, .dropdown-item', function(event) {
+    var $target = $(event.currentTarget);
+
+    // Don't collapse if this is a dropdown toggle
+    if ($target.hasClass('dropdown-toggle')) {
+      return;
+    }
+
+    // Don't collapse if this is inside a dropdown and the dropdown should stay open
+    if ($target.hasClass('nav-link') && $target.closest('.dropdown').length &&
+        !$target.attr('data-bs-toggle')) {
+      return;
+    }
+
+    // Collapse the navbar after a short delay
+    setTimeout(collapseNavbar, 10);
+  });
+
+  // Handle tab toggles specifically
+  $(document).on('click', '.nav-link[data-bs-toggle="tab"]', function() {
+    if (!$(this).hasClass('dropdown-toggle')) {
+      setTimeout(collapseNavbar, 10);
+    }
+  });
+
+  // Optional: Handle clicks outside the navbar to close it
+  $(document).on('click', function(event) {
+    var navbar = $('.navbar-collapse');
+
+    // Check if click is outside navbar and navbar is open
+    if (navbar.hasClass('show') &&
+        !$(event.target).closest('.navbar').length) {
+      collapseNavbar();
+    }
+  });
+});

app_docker/www/style.css

@@ -0,0 +1,125 @@
+
+/*!
+ * Copyright (c) 2025 FreesearchR
+ *
+ * FreesearchR, CSS styles
+ * https://github.com/agdamsbo/FreesearchR
+ *
+ * @version 0.0.1
+ */
+
+.container-fluid > .nav > li >
+                        a[data-value='FreesearchR'] {font-size: 28px}
+
+
+/* from datamods */
+.show-block {
+  display: block !important;
+}
+.show-inline {
+  display: inline !important;
+}
+.hidden {
+  display: none !important;
+}
+.invisible {
+  visibility: hidden;
+}
+
+.container-rule {
+  position: relative;
+  text-align: center;
+  height: 25px;
+  margin-bottom: 5px;
+}
+
+.horizontal-rule {
+  position: absolute;
+  top: 11px;
+  right: 0;
+  left: 0;
+  background-color: #d0cfcf;
+  height: 1px;
+  z-index: 100;
+  margin: 0;
+  border: none;
+}
+
+.label-rule {
+  background: #FFF;
+  opacity: 1;
+  z-index: 101;
+  background-color: #FFF;
+  position: relative;
+  padding: 0 10px 0 10px;
+}
+
+.datamods-table-container {
+  overflow: auto;
+  word-break: keep-all;
+  white-space: nowrap;
+}
+
+.datamods-table-container > .table {
+  margin-bottom: 0 !important;
+}
+
+.datamods-file-import {
+  display: grid;
+  grid-template-columns: auto 50px;
+  grid-column-gap: 10px;
+}
+
+.datamods-dt-nowrap {
+  word-break: keep-all;
+  white-space: nowrap;
+}
+
+
+
+/* validation */
+.datamods-validation-results {
+  display: grid;
+  grid-template-columns: repeat(3, 1fr);
+  grid-template-rows: 1fr;
+  height: 50px;
+  line-height: 50px;
+  font-size: large;
+}
+
+.datamods-validation-summary {
+  font-weight: bold;
+  text-align: center;
+}
+
+.datamods-validation-item {
+  font-size: larger;
+}
+
+
+
+/* modified from esquisse for data types */
+.btn-column-categorical {
+  background-color: #00C896;
+  color: #FFFFFF;
+}
+.btn-column-continuous {
+  background-color: #FFB100;
+  color: #FFFFFF;
+}
+.btn-column-dichotomous {
+  background-color: #8A4FFF;
+  color: #FFFFFF;
+}
+.btn-column-datetime {
+  background-color: #11A0EC;
+  color: #FFFFFF;
+}
+.btn-column-id {
+  background-color: #848484;
+  color: #FFFFFF;
+}
+.btn-column-text {
+  background-color: #2E2E2E;
+  color: #FFFFFF;
+}

app_docker/www/umami-app.html

@@ -0,0 +1 @@
+<script defer src="https://stats.freesearchr.org/script.js" data-website-id="63976000-9836-45bc-90da-37ec5717fb22"></script>

examples/validation_module_demo.R

@@ -0,0 +1,133 @@
+#' Data and analyses validation demo
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' validation_demo_app()
+#' }
+validation_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::tags$h2("Validation"),
+    IDEAFilter::IDEAFilter_ui("data_filter"),
+    shiny::br(),
+    DT::DTOutput("data_final"),
+    shiny::br(),
+    validation_ui("validation_demo_2")
+  )
+
+  server <- function(input, output, session) {
+    rv <- shiny::reactiveValues(
+      data_original = shiny::reactive(mtcars),
+      data_filtered = NULL
+    )
+
+    rv_validation <- shiny::reactiveValues(
+      obs_filter = NULL,
+      vars_filter = NULL
+    )
+
+    data_filter <- IDEAFilter::IDEAFilter(
+      id = "data_filter",
+      data = mtcars,
+      verbose = TRUE
+    )
+
+    shiny::observeEvent(
+      data_filter(),
+      {
+        rv$data_filtered <- data_filter()
+      }
+    )
+
+    output$data_final <- DT::renderDT(
+      data_filter()
+    )
+
+    shiny::observeEvent(
+      list(
+        data_filter()
+      ),
+      {
+        to_make_validation <- data_filter()
+        ## Validation
+        if (!is.null(to_make_validation)) {
+          validation <-
+            make_validation(
+              ls = validation_lib("obs_filter"),
+              list(
+                x = mtcars,
+                y = to_make_validation
+              )
+            )
+
+        rv_validation$vars_filter <- validation
+
+        validation_server(id = "validation_demo_2", data = rv_validation$vars_filter)
+
+        }
+
+
+      }
+    )
+
+    # shiny::observeEvent(
+    #   list(
+    #     shiny::reactive(rv_validation$vars_filter)(),
+    #     data_filter()
+    #   ),
+    #   {
+    #     # browser()
+    #     # to_make_alert <- shiny::isolate(rv_validation$vars_filter)
+    #     to_make_alert <- shiny::reactive(rv_validation$vars_filter)()
+    #     if (!is.null(rv_validation$vars_filter)) {
+    #       validation_server(id = "validation_demo_2", data = to_make_alert)
+    #     }
+    #   }
+    # )
+  }
+  shiny::shinyApp(ui, server)
+}
+
+
+#' Title
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' validation_nr_demo_app()
+validation_nr_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::tags$h2("Validation"),
+    shiny::br(),
+    validation_ui("validation_demo_1", max_height = "30px"),
+    shiny::br(),
+    validation_ui("validation_demo_2")
+  )
+
+  server <- function(input, output, session) {
+    df_original <- mtcars
+
+    df_obs <- mtcars |> dplyr::filter(mpg > 20)
+
+    df_vars <- df_obs[1:6]
+
+    val1 <- purrr::map2(
+      .x = validation_lib()[1],
+      .y = list(list(x = df_original, y = df_obs)),
+      make_validation
+    )
+
+    val2 <- make_validation(
+      ls = validation_lib()[[2]],
+      list(x = df_original, y = df_vars)
+    )
+
+    validation_server(id = "validation_demo_1", data = val1)
+
+    validation_server(id = "validation_demo_2", data = val2)
+  }
+  shiny::shinyApp(ui, server)
+}

inst/apps/FreesearchR/ui.R

@@ -1,554 +0,0 @@
-# ns <- NS(id)
-
-
-
-ui_elements <- list(
-  ##############################################################################
-  #########
-  #########  Home panel
-  #########
-  ##############################################################################
-  "home" = bslib::nav_panel(
-    title = "FreesearchR",
-    shiny::fluidRow(
-      shiny::column(width = 2),
-      shiny::column(
-        width = 8,
-        shiny::markdown(readLines("www/intro.md")),
-        shiny::column(width = 2)
-      )
-    ),
-    icon = shiny::icon("home")
-  ),
-  ##############################################################################
-  #########
-  #########  Import panel
-  #########
-  ##############################################################################
-  "import" = bslib::nav_panel(
-    title = "Import",
-    shiny::fluidRow(
-      shiny::column(width = 2),
-      shiny::column(
-        width = 8,
-        shiny::h4("Choose your data source"),
-        shiny::br(),
-        shinyWidgets::radioGroupButtons(
-          inputId = "source",
-          selected = "file",
-          choices = c(
-            "File upload" = "file",
-            "REDCap server export" = "redcap",
-            "Local or sample data" = "env"
-          ),
-          size = "lg"
-        ),
-        shiny::tags$script('document.querySelector("#source div").style.width = "100%"'),
-        shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
-        shiny::br(),
-        shiny::br(),
-        shiny::conditionalPanel(
-          condition = "input.source=='file'",
-          import_file_ui(
-            id = "file_import",
-            layout_params = "dropdown",
-            # title = "Choose a datafile to upload",
-            file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta")
-          )
-        ),
-        shiny::conditionalPanel(
-          condition = "input.source=='redcap'",
-          m_redcap_readUI(
-            id = "redcap_import",
-            title = ""
-          )
-        ),
-        shiny::conditionalPanel(
-          condition = "input.source=='env'",
-          import_globalenv_ui(id = "env", title = NULL)
-        ),
-        shiny::conditionalPanel(
-          condition = "input.source=='redcap'",
-          DT::DTOutput(outputId = "redcap_prev")
-        ),
-        shiny::conditionalPanel(
-          condition = "output.data_loaded == true",
-          shiny::br(),
-          shiny::br(),
-          shiny::h5("Specify variables to include"),
-          shiny::fluidRow(
-            shiny::column(
-              width = 6,
-              shiny::br(),
-              shiny::p("Filter by completeness threshold and manual selection:"),
-              shiny::br(),
-              shiny::br()
-            ),
-            shiny::column(
-              width = 6,
-              shinyWidgets::noUiSliderInput(
-                inputId = "complete_cutoff",
-                label = NULL,
-                update_on = "end",
-                min = 0,
-                max = 100,
-                step = 5,
-                value = 70,
-                format = shinyWidgets::wNumbFormat(decimals = 0),
-                color = datamods:::get_primary_color()
-              ),
-              shiny::helpText("Exclude variables with completeness below the specified percentage."),
-              shiny::br(),
-              shiny::br(),
-              shiny::uiOutput(outputId = "import_var"),
-              shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
-            )
-          )
-        ),
-        shiny::br(),
-        shiny::br(),
-        shiny::actionButton(
-          inputId = "act_start",
-          label = "Start",
-          width = "100%",
-          icon = shiny::icon("play"),
-          disabled = TRUE
-        ),
-        shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
-        shiny::br(),
-        shiny::br(),
-        shiny::column(width = 2)
-      )
-    )
-  ),
-  ##############################################################################
-  #########
-  #########  Data overview panel
-  #########
-  ##############################################################################
-  "overview" =
-  # bslib::nav_panel_hidden(
-    bslib::nav_panel(
-      # value = "overview",
-      title = "Data",
-      bslib::navset_bar(
-        fillable = TRUE,
-        bslib::nav_panel(
-          title = "Overview",
-          tags$h3("Overview and filtering"),
-          fluidRow(
-            shiny::column(
-              width = 9,
-              shiny::uiOutput(outputId = "data_info", inline = TRUE),
-              shiny::tags$p(
-                "Below is a short summary table, on the right you can click to browse data and create data filters."
-              )
-            )
-          ),
-          fluidRow(
-            shiny::column(
-              width = 9,
-              data_summary_ui(id = "data_summary")
-            ),
-            shiny::column(
-              width = 3,
-              shiny::actionButton(
-                inputId = "modal_browse",
-                label = "Browse data",
-                width = "100%",
-                disabled = TRUE
-              ),
-              shiny::tags$br(),
-              shiny::tags$br(),
-              shiny::uiOutput(outputId = "column_filter"),
-              shiny::helpText("Variable ", tags$a(
-                "data type",
-                href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
-                target = "_blank",
-                rel = "noopener noreferrer"
-              ), " filtering."),
-              shiny::tags$br(),
-              shiny::tags$br(),
-              IDEAFilter::IDEAFilter_ui("data_filter"),
-              shiny::helpText("Observations level filtering."),
-              shiny::tags$br(),
-              shiny::tags$br()
-            )
-          ),
-          shiny::tags$br(),
-          shiny::tags$br(),
-          shiny::tags$br(),
-          shiny::tags$br(),
-          shiny::tags$br()
-        ),
-        bslib::nav_panel(
-          title = "Modify",
-          tags$h3("Subset, rename and convert variables"),
-          fluidRow(
-            shiny::column(
-              width = 9,
-              shiny::tags$p(
-                shiny::markdown("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."),
-                shiny::markdown("There are also more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code. At the bottom you can restore the original data."),
-                shiny::markdown("Please note that data modifications are applied before any data or variable filtering is applied.")
-              )
-            )
-          ),
-          # shiny::tags$br(),
-          update_variables_ui("modal_variables"),
-          shiny::tags$br(),
-          shiny::tags$br(),
-          shiny::tags$h4("Advanced data manipulation"),
-          shiny::tags$p("Below options allow more advanced varaible manipulations."),
-          shiny::tags$br(),
-          shiny::tags$br(),
-          shiny::fluidRow(
-            shiny::column(
-              width = 4,
-              shiny::actionButton(
-                inputId = "modal_update",
-                label = "Reorder factor levels",
-                width = "100%"
-              ),
-              shiny::tags$br(),
-              shiny::helpText("Reorder the levels of factor/categorical variables."),
-              shiny::tags$br(),
-              shiny::tags$br()
-            ),
-            shiny::column(
-              width = 4,
-              shiny::actionButton(
-                inputId = "modal_cut",
-                label = "New factor",
-                width = "100%"
-              ),
-              shiny::tags$br(),
-              shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."),
-              shiny::tags$br(),
-              shiny::tags$br()
-            ),
-            shiny::column(
-              width = 4,
-              shiny::actionButton(
-                inputId = "modal_column",
-                label = "New variable",
-                width = "100%"
-              ),
-              shiny::tags$br(),
-              shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")),
-              shiny::tags$br(),
-              shiny::tags$br()
-            )
-          ),
-          tags$h4("Compare modified data to original"),
-          shiny::tags$br(),
-          shiny::tags$p(
-            "Raw print of the original vs the modified data."
-          ),
-          shiny::tags$br(),
-          shiny::fluidRow(
-            shiny::column(
-              width = 6,
-              shiny::tags$b("Original data:"),
-              # verbatimTextOutput("original"),
-              shiny::verbatimTextOutput("original_str")
-            ),
-            shiny::column(
-              width = 6,
-              shiny::tags$b("Modified data:"),
-              # verbatimTextOutput("modified"),
-              shiny::verbatimTextOutput("modified_str")
-            )
-          ),
-          shiny::tags$br(),
-          shiny::actionButton(
-            inputId = "data_reset",
-            label = "Restore original data",
-            width = "100%"
-          ),
-          shiny::tags$br(),
-          shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
-          shiny::tags$br()
-        )
-      )
-    ),
-  ##############################################################################
-  #########
-  #########  Descriptive analyses panel
-  #########
-  ##############################################################################
-  "describe" =
-    bslib::nav_panel(
-      title = "Evaluate",
-      id = "navdescribe",
-      bslib::navset_bar(
-        title = "",
-        sidebar = bslib::sidebar(
-          shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
-          bslib::accordion(
-            open = "acc_chars",
-            multiple = FALSE,
-            bslib::accordion_panel(
-              value = "acc_chars",
-              title = "Characteristics",
-              icon = bsicons::bs_icon("table"),
-              shiny::uiOutput("strat_var"),
-              shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Data' tab to reclass a variable if it's not on the list."),
-              shiny::conditionalPanel(
-                condition = "input.strat_var!='none'",
-                shiny::radioButtons(
-                  inputId = "add_p",
-                  label = "Compare strata?",
-                  selected = "no",
-                  inline = TRUE,
-                  choices = list(
-                    "No" = "no",
-                    "Yes" = "yes"
-                  )
-                ),
-                shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
-              ),
-              shiny::br(),
-              shiny::br(),
-              shiny::actionButton(
-                inputId = "act_eval",
-                label = "Evaluate",
-                width = "100%",
-                icon = shiny::icon("calculator"),
-                disabled = TRUE
-              )
-            ),
-            bslib::accordion_panel(
-              vlaue = "acc_cor",
-              title = "Correlations",
-              icon = bsicons::bs_icon("bounding-box"),
-              shiny::uiOutput("outcome_var_cor"),
-              shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
-              shiny::br(),
-              shinyWidgets::noUiSliderInput(
-                inputId = "cor_cutoff",
-                label = "Correlation cut-off",
-                min = 0,
-                max = 1,
-                step = .01,
-                value = .8,
-                format = shinyWidgets::wNumbFormat(decimals = 2),
-                color = datamods:::get_primary_color()
-              ),
-              shiny::helpText("Set the cut-off for considered 'highly correlated'.")
-            )
-          )
-        ),
-        bslib::nav_panel(
-          title = "Characteristics",
-          gt::gt_output(outputId = "table1")
-        ),
-        bslib::nav_panel(
-          title = "Correlations",
-          data_correlations_ui(id = "correlations", height = 600)
-        )
-      )
-    ),
-  ##############################################################################
-  #########
-  #########  Download panel
-  #########
-  ##############################################################################
-  "visuals" = bslib::nav_panel(
-    title = "Visuals",
-    id = "navvisuals",
-    do.call(
-      bslib::navset_bar,
-      c(
-        data_visuals_ui("visuals"),
-        shiny::tagList(
-          bslib::nav_spacer(),
-          bslib::nav_item(
-            # shiny::img(shiny::icon("book")),
-            shiny::tags$a(
-              href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
-              "Notes (external)",
-              target = "_blank",
-              rel = "noopener noreferrer"
-            )
-          )
-        )
-      )
-    )
-  ),
-  ##############################################################################
-  #########
-  #########  Regression analyses panel
-  #########
-  ##############################################################################
-  "analyze" =
-    bslib::nav_panel(
-      title = "Regression",
-      id = "navanalyses",
-      do.call(
-        bslib::navset_bar,
-        regression_ui("regression")
-      )
-    ),
-  ##############################################################################
-  #########
-  #########  Download panel
-  #########
-  ##############################################################################
-  "download" =
-    bslib::nav_panel(
-      title = "Download",
-      id = "navdownload",
-      shiny::fluidRow(
-        shiny::column(width = 2),
-        shiny::column(
-          width = 8,
-          shiny::fluidRow(
-            shiny::column(
-              width = 6,
-              shiny::h4("Report"),
-              shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
-              shiny::br(),
-              shiny::br(),
-              shiny::selectInput(
-                inputId = "output_type",
-                label = "Output format",
-                selected = NULL,
-                choices = list(
-                  "MS Word" = "docx",
-                  "LibreOffice" = "odt"
-                  # ,
-                  # "PDF" = "pdf",
-                  # "All the above" = "all"
-                )
-              ),
-              shiny::br(),
-              # Button
-              shiny::downloadButton(
-                outputId = "report",
-                label = "Download report",
-                icon = shiny::icon("download")
-              )
-              # shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
-            ),
-            shiny::column(
-              width = 6,
-              shiny::h4("Data"),
-              shiny::helpText("Choose your favourite output data format to download the modified data."),
-              shiny::br(),
-              shiny::br(),
-              shiny::selectInput(
-                inputId = "data_type",
-                label = "Data format",
-                selected = NULL,
-                choices = list(
-                  "R" = "rds",
-                  "stata" = "dta",
-                  "CSV" = "csv"
-                )
-              ),
-              shiny::helpText("No metadata is saved when exporting to csv."),
-              shiny::br(),
-              shiny::br(),
-              # Button
-              shiny::downloadButton(
-                outputId = "data_modified",
-                label = "Download data",
-                icon = shiny::icon("download")
-              )
-            )
-          ),
-          shiny::br(),
-          shiny::br(),
-          shiny::h4("Code snippets"),
-          shiny::tags$p("Below are the code bits used to create the final data set and the main analyses."),
-          shiny::tags$p("This can be used as a starting point for learning to code and for reproducibility."),
-          shiny::tagList(
-            lapply(
-              paste0("code_", c(
-                "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
-              )),
-              \(.x)shiny::htmlOutput(outputId = .x)
-            )
-          ),
-          shiny::tags$br(),
-          shiny::br()
-        ),
-        shiny::column(width = 2)
-      )
-    ),
-  ##############################################################################
-  #########
-  #########  Documentation panel
-  #########
-  ##############################################################################
-  "docs" = bslib::nav_item(
-    # shiny::img(shiny::icon("book")),
-    shiny::tags$a(
-      href = "https://agdamsbo.github.io/FreesearchR/",
-      "Docs (external)",
-      target = "_blank",
-      rel = "noopener noreferrer"
-    )
-  )
-  #   bslib::nav_panel(
-  #   title = "Documentation",
-  #   # shiny::tags$iframe("www/docs.html", height=600, width=535),
-  #   shiny::htmlOutput("docs_file"),
-  #   shiny::br()
-  # )
-)
-# Initial attempt at creating light and dark versions
-light <- custom_theme()
-dark <- custom_theme(
-  bg = "#000",
-  fg = "#fff"
-)
-
-# Fonts to consider:
-# https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/
-
-ui_list <- shiny::tagList(
-  prismDependencies,
-  prismRDependency,
-  header_include(),
-  ## This adds the actual favicon
-  ## png and ico versions are kept for compatibility
-  shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")),
-  title = "FreesearchR",
-  theme = light,
-  shiny::useBusyIndicators(),
-  bslib::page_navbar(
-    id = "main_panel",
-    ui_elements$home,
-    ui_elements$import,
-    ui_elements$overview,
-    ui_elements$describe,
-    ui_elements$visuals,
-    ui_elements$analyze,
-    ui_elements$download,
-    bslib::nav_spacer(),
-    ui_elements$docs,
-    fillable = FALSE,
-    footer = shiny::tags$footer(
-      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."
-      ),
-      shiny::p(
-        style = "margin: 1; color: #888;",
-        shiny::tags$a("Docs", href = "https://agdamsbo.github.io/FreesearchR/", target = "_blank", rel = "noopener noreferrer")," | ", app_version(), " | ", shiny::tags$a("License: AGPLv3", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Share feedback", href = "https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8", target = "_blank", rel = "noopener noreferrer")
-      ),
-    )
-  )
-)
-
-# 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/images/da.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 36 36"><path fill="#C60C30" d="M32 5H15v11h21V9c0-2.209-1.791-4-4-4zM15 31h17c2.209 0 4-1.791 4-4.5V20H15v11zM0 20v6.5C0 29.209 1.791 31 4 31h7V20H0zM11 5H4C1.791 5 0 6.791 0 9v7h11V5z"/><path fill="#EEE" d="M15 5h-4v11H0v4h11v11h4V20h21v-4H15z"/></svg>

inst/apps/FreesearchR/www/images/en.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 36 36"><path fill="#00247D" d="M0 9.059V13h5.628zM4.664 31H13v-5.837zM23 25.164V31h8.335zM0 23v3.941L5.63 23zM31.337 5H23v5.837zM36 26.942V23h-5.631zM36 13V9.059L30.371 13zM13 5H4.664L13 10.837z"/><path fill="#CF1B2B" d="M25.14 23l9.712 6.801c.471-.479.808-1.082.99-1.749L28.627 23H25.14zM13 23h-2.141l-9.711 6.8c.521.53 1.189.909 1.938 1.085L13 23.943V23zm10-10h2.141l9.711-6.8c-.521-.53-1.188-.909-1.937-1.085L23 12.057V13zm-12.141 0L1.148 6.2C.677 6.68.34 7.282.157 7.949L7.372 13h3.487z"/><path fill="#EEE" d="M36 21H21v10h2v-5.836L31.335 31H32c1.117 0 2.126-.461 2.852-1.199L25.14 23h3.487l7.215 5.052c.093-.337.158-.686.158-1.052v-.058L30.369 23H36v-2zM0 21v2h5.63L0 26.941V27c0 1.091.439 2.078 1.148 2.8l9.711-6.8H13v.943l-9.914 6.941c.294.07.598.116.914.116h.664L13 25.163V31h2V21H0zM36 9c0-1.091-.439-2.078-1.148-2.8L25.141 13H23v-.943l9.915-6.942C32.62 5.046 32.316 5 32 5h-.663L23 10.837V5h-2v10h15v-2h-5.629L36 9.059V9zM13 5v5.837L4.664 5H4c-1.118 0-2.126.461-2.852 1.2l9.711 6.8H7.372L.157 7.949C.065 8.286 0 8.634 0 9v.059L5.628 13H0v2h15V5h-2z"/><path fill="#CF1B2B" d="M21 15V5h-6v10H0v6h15v10h6V21h15v-6z"/></svg>

inst/apps/FreesearchR/www/images/sw.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 36 36"><path fill="#1EB53A" d="M4 5C1.791 5 0 6.791 0 9v15.627L26.456 5H4z"/><path fill="#00A3DD" d="M32 31c2.209 0 4-1.791 4-4V11.33L9.479 31H32z"/><path fill="#141414" d="M32 5h-2.532L0 26.638V27c0 2.209 1.791 4 4 4h2.467L36 9.318V9c0-2.209-1.791-4-4-4z"/><path fill="#FBD035" d="M26.456 5L0 24.627v2.011L29.468 5zM9.479 31L36 11.33V9.318L6.467 31z"/></svg>

inst/apps/FreesearchR/www/intro.md

@@ -1,31 +1,23 @@
-# Welcome <img style="float: right;" src="FreesearchR-logo.png">
+---
+output: html_fragment
+---
 
-This is the ***FreesearchR*** data analysis tool. We intend ***FreesearchR*** to be a free tool for easy data evaluation and analysis. If you need more advanced tools, start with ***FreesearchR*** and then you'll probably be better off using *R* or similar directly.
+# Welcome <img src="FreesearchR-logo.png" style="float: right;"/>
 
-Here is a brief summary of the functions:
+This is the ***FreesearchR*** data analysis tool, a free tool for basic data evaluation and analysis. If you need more advanced tools, start with ***FreesearchR*** and then you'll probably be better off using *R* or similar directly.
 
-1.  **Import data** from a spreadsheet/file on your machine, direct export from a REDCap server, sample data or data from a your local environment if run locally.
+With this tool you can:
 
-1.  **Data inspection** and  **modification** like modifying variables or creating new (categorical from numeric or time data, or completely new variables from the data)
+1.  **Import data** from a spreadsheet/file on your machine, directly from a [REDCap](https://projectredcap.org/ "Read more on the data capture tool REDCap") server, try it with sample data or access data directly [if run in R locally](https://agdamsbo.github.io/FreesearchR//#run-locally-on-your-own-machine "Read about running FreesearchR on your local machine")
 
-1.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations
+2.  **Prepare** data for analysis by filtering data, modifying variables or create new variables
 
-1.  **Create and export simple, clean plots** for data overview and insights
+3.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations as well as [missing observations](https://agdamsbo.github.io/FreesearchR/articles/missingness.html "Read more about missing data")
 
-1.  **Create regression simple models** for even more advanced data analyses
+4.  **Visualise data** by [creating simple, clean plots](https://agdamsbo.github.io/FreesearchR/articles/visuals.html "See available plot types") for overview and quick insights
 
-    -   Linear, dichotomous or ordinal logistic regression will be used depending on specified outcome variable
+5.  **Create simple regression models** for even more advanced data analyses
 
-    -   Plot regression analysis coefficients
+6.  **Download** results as a report, get the modified data set and save the code for learning and to reproduce the results later
 
-    -   Evaluate model assumptions
+The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed descriptions of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).
-
-1.  **Export results**
-
-    -   Descriptive and regression analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/)
-    
-    -   Modified data with preserved metadata
-    
-    -   Code to recreate all steps locally
-
-The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed description of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).

inst/apps/FreesearchR/www/intro_da.md

@@ -0,0 +1,23 @@
+---
+output: html_fragment
+---
+
+# Velkommen <img src="FreesearchR-logo.png" style="float: right;"/>
+
+Dette er ***FreesearchR***-værktøjet, et gratis værktøj til databehandling og -analyse. Har du brug for mere avancerede værktøjer, så kan du starte ***FreesearchR*** og senere selv hente *R* og *RStudio* eller lignende.
+
+Herunder kan du helt kort se, hvad du kan bruge ***FreesearchR*** til:
+
+1.  **Import data** from a spreadsheet/file on your machine, directly from a [REDCap](https://projectredcap.org/ "Read more on the data capture tool REDCap") server, try it with sample data or access data directly [if run in R locally](https://agdamsbo.github.io/FreesearchR//#run-locally-on-your-own-machine "Read about running FreesearchR on your local machine")
+
+2.  **Prepare** data for analysis by filtering data, modifying variables or create new variables
+
+3.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations as well as [missing observations](https://agdamsbo.github.io/FreesearchR/articles/missingness.html "Read more about missing data")
+
+4.  **Visualise data** by [creating simple, clean plots](https://agdamsbo.github.io/FreesearchR/articles/visuals.html "See available plot types") for overview and quick insights
+
+5.  **Create simple regression models** for even more advanced data analyses
+
+6.  **Download** results as a report, get the modified data set and save the code for learning and to reproduce the results later
+
+The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed descriptions of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).

inst/apps/FreesearchR/www/intro_sw.md

@@ -0,0 +1,23 @@
+---
+output: html_fragment
+---
+
+# Karibu <img src="FreesearchR-logo.png" style="float: right;"/>
+
+This is the ***FreesearchR*** data analysis tool, a free tool for basic data evaluation and analysis. If you need more advanced tools, start with ***FreesearchR*** and then you'll probably be better off using *R* or similar directly.
+
+With this tool you can:
+
+1.  **Import data** from a spreadsheet/file on your machine, directly from a [REDCap](https://projectredcap.org/ "Read more on the data capture tool REDCap") server, try it with sample data or access data directly [if run in R locally](https://agdamsbo.github.io/FreesearchR//#run-locally-on-your-own-machine "Read about running FreesearchR on your local machine")
+
+2.  **Prepare** data for analysis by filtering data, modifying variables or create new variables
+
+3.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations as well as [missing observations](https://agdamsbo.github.io/FreesearchR/articles/missingness.html "Read more about missing data")
+
+4.  **Visualise data** by [creating simple, clean plots](https://agdamsbo.github.io/FreesearchR/articles/visuals.html "See available plot types") for overview and quick insights
+
+5.  **Create simple regression models** for even more advanced data analyses
+
+6.  **Download** results as a report, get the modified data set and save the code for learning and to reproduce the results later
+
+The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) where you'll find detailed descriptions of the app and link to the source code! If you want to [share feedback, please follow this link to a simple survey](https://redcap.au.dk/surveys/?s=JPCLPTXYDKFA8DA8).

inst/apps/FreesearchR/www/report.rmd

@@ -7,6 +7,7 @@ toc: false
 params:
   data.file: NA
   version: NA
+  regression.p: NA
 ---
 
 ```{r setup, echo = FALSE}
@@ -65,7 +66,15 @@ if ("table1" %in% names(web_data)) {
 ```{r, results = 'asis'}
 if ("regression" %in% names(web_data) && length(web_data$regression) > 0) {
   reg_tbl <- web_data$regression$regression$tables
-  knitr::knit_print(tbl_merge(reg_tbl))
+  
+  merged <- tbl_merge(reg_tbl)
+  
+  if (params$regression.p == "no") {
+            merged <- merged |>
+              gtsummary::modify_column_hide(column = dplyr::starts_with("p.value"))
+          }
+  
+  knitr::knit_print(merged)
 }
 ```
 

inst/apps/FreesearchR/www/scripts.js

@@ -0,0 +1,74 @@
+// Automatically close drop-downs on navigation
+// Thanks to claude.ai
+$(document).ready(function() {
+ var language =  window.navigator.userLanguage || window.navigator.language;
+ var iso639Language = language.split('-')[0];
+ Shiny.onInputChange('browser_lang', iso639Language);
+ console.log('Browser language:',iso639Language);
+});
+
+
+$(document).on('shown.bs.tab', '#main_panel', function(e) {
+  // Close dropdown in this specific navset only
+  $('#main_panel .dropdown-menu').removeClass('show');
+  $('#main_panel .dropdown-toggle').removeClass('show').attr('aria-expanded', 'false');
+});
+
+
+$(document).on('shiny:sessioninitialized', function() {
+  // Function to get browser language
+  // var language =  window.navigator.userLanguage || window.navigator.language;
+  // var iso639Language = language.split('-')[0];
+  // Shiny.onInputChange('browser_lang', iso639Language);
+  // console.log('Browser language:',iso639Language);
+
+  // Function to collapse navbar on mobile
+  function collapseNavbar() {
+    var navbar = $('.navbar-collapse');
+    if (navbar.hasClass('show')) {
+      navbar.removeClass('show');
+      $('.navbar-toggler').addClass('collapsed');
+      $('.navbar-toggler').attr('aria-expanded', 'false');
+    }
+  }
+
+  // Main approach: Handle clicks on nav elements
+  $(document).on('click', '.navbar-nav .nav-link, .dropdown-item', function(event) {
+    var $target = $(event.currentTarget);
+
+    // Don't collapse if this is a dropdown toggle
+    if ($target.hasClass('dropdown-toggle')) {
+      return;
+    }
+
+    // Don't collapse if this is inside a dropdown and the dropdown should stay open
+    if ($target.hasClass('nav-link') && $target.closest('.dropdown').length &&
+        !$target.attr('data-bs-toggle')) {
+      return;
+    }
+
+    // Collapse the navbar after a short delay
+    setTimeout(collapseNavbar, 10);
+  });
+
+  // Handle tab toggles specifically
+  $(document).on('click', '.nav-link[data-bs-toggle="tab"]', function() {
+    if (!$(this).hasClass('dropdown-toggle')) {
+      setTimeout(collapseNavbar, 10);
+    }
+  });
+
+  // Optional: Handle clicks outside the navbar to close it
+  $(document).on('click', function(event) {
+    var navbar = $('.navbar-collapse');
+
+    // Check if click is outside navbar and navbar is open
+    if (navbar.hasClass('show') &&
+        !$(event.target).closest('.navbar').length) {
+      collapseNavbar();
+    }
+  });
+
+
+});
+

inst/apps/FreesearchR/www/style.css

@@ -123,3 +123,5 @@
   background-color: #2E2E2E;
   color: #FFFFFF;
 }
+
+

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

@@ -0,0 +1 @@
+<script defer src="https://stats.freesearchr.org/script.js" data-website-id="349608b9-78f8-47ee-9185-0d3716095fd5"></script>

inst/assets/css/FreesearchR.css

@@ -123,3 +123,5 @@
   background-color: #2E2E2E;
   color: #FFFFFF;
 }
+
+

inst/assets/js/FreesearchR.js

@@ -0,0 +1,74 @@
+// Automatically close drop-downs on navigation
+// Thanks to claude.ai
+$(document).ready(function() {
+ var language =  window.navigator.userLanguage || window.navigator.language;
+ var iso639Language = language.split('-')[0];
+ Shiny.onInputChange('browser_lang', iso639Language);
+ console.log('Browser language:',iso639Language);
+});
+
+
+$(document).on('shown.bs.tab', '#main_panel', function(e) {
+  // Close dropdown in this specific navset only
+  $('#main_panel .dropdown-menu').removeClass('show');
+  $('#main_panel .dropdown-toggle').removeClass('show').attr('aria-expanded', 'false');
+});
+
+
+$(document).on('shiny:sessioninitialized', function() {
+  // Function to get browser language
+  // var language =  window.navigator.userLanguage || window.navigator.language;
+  // var iso639Language = language.split('-')[0];
+  // Shiny.onInputChange('browser_lang', iso639Language);
+  // console.log('Browser language:',iso639Language);
+
+  // Function to collapse navbar on mobile
+  function collapseNavbar() {
+    var navbar = $('.navbar-collapse');
+    if (navbar.hasClass('show')) {
+      navbar.removeClass('show');
+      $('.navbar-toggler').addClass('collapsed');
+      $('.navbar-toggler').attr('aria-expanded', 'false');
+    }
+  }
+
+  // Main approach: Handle clicks on nav elements
+  $(document).on('click', '.navbar-nav .nav-link, .dropdown-item', function(event) {
+    var $target = $(event.currentTarget);
+
+    // Don't collapse if this is a dropdown toggle
+    if ($target.hasClass('dropdown-toggle')) {
+      return;
+    }
+
+    // Don't collapse if this is inside a dropdown and the dropdown should stay open
+    if ($target.hasClass('nav-link') && $target.closest('.dropdown').length &&
+        !$target.attr('data-bs-toggle')) {
+      return;
+    }
+
+    // Collapse the navbar after a short delay
+    setTimeout(collapseNavbar, 10);
+  });
+
+  // Handle tab toggles specifically
+  $(document).on('click', '.nav-link[data-bs-toggle="tab"]', function() {
+    if (!$(this).hasClass('dropdown-toggle')) {
+      setTimeout(collapseNavbar, 10);
+    }
+  });
+
+  // Optional: Handle clicks outside the navbar to close it
+  $(document).on('click', function(event) {
+    var navbar = $('.navbar-collapse');
+
+    // Check if click is outside navbar and navbar is open
+    if (navbar.hasClass('show') &&
+        !$(event.target).closest('.navbar').length) {
+      collapseNavbar();
+    }
+  });
+
+
+});
+

inst/translations/translation_da.csv

@@ -0,0 +1,145 @@
+"en","da"
+"Hello","Hej"
+"Get started","Kom i gang"
+"File upload","Upload fil"
+"REDCap server export","REDCap server export"
+"Local or sample data","Lokal eller testdata"
+"Please be mindfull handling sensitive data","Pas godt på og overvej nøje hvordan du håndterer personfølsomme data"
+"The ***FreesearchR*** app only stores data for analyses, but please only use with sensitive data when running locally. [Read more here](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine).","***FreesearchR*** opbevarer alene data i forbindelse med din analyse, men du bør kun behandle personfølsomme data når du kører ***FreesearchR*** direkte på din egen maskine. [Læs mere her](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine)."
+"Quick overview","Hurtigt overblik"
+"Select variables for final import","Vælg variabler til den endelige import"
+"Exclude incomplete variables:","Ekskluder inkomplette variabler:"
+"Manual selection:","Manuel udvælgelse:"
+"Let's begin!","Kom i gang!"
+"Analysis validation","Analysevalidering"
+"Report","Rapport"
+"Choose your favourite output file format for further work, and download, when the analyses are done.","Vælge dit foretrukne dataformat, og hent data, når du er ærdig med databehandlingen."
+"www/intro.html","www/intro_da.html"
+"<p>The <em><strong>FreesearchR</strong></em> app only stores data for analyses, but please only use with sensitive data when running locally. <a href='https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine'>Read more here</a></p>","<p><em><strong>FreesearchR</strong></em> opbevarer alene data i forbindelse med din analyse, men du bør kun behandle personfølsomme data når du kører <em><strong>FreesearchR</strong></em> direkte på dine egen maskine. <a href='https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine'>Læs mere her</a></p>"
+"Overview and filter","Overblik og filtre"
+"Overview and filtering","Overblik og filtrering"
+"Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse data and apply different data filters.","Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse data and apply different data filters."
+"Visual overview","Visuelt overblik"
+"Browse data","Udforsk data"
+"Filter data types","Filtrer datatyper"
+"Filter observations","Filtrer observationer"
+"Apply filter on observation","Anvend filtre af observationer"
+"Edit and create data","Ændr og opret variabler"
+"Subset, rename and convert variables","Udvælg, omdøb og konverter variabler"
+"Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.).","Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."
+"There are more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with R code. At the bottom you can restore the original data."
+"Please note that data modifications are applied before any filtering.","Please note that data modifications are applied before any filtering."
+"Advanced data manipulation","Avanceret datamanipulation"
+"Below options allow more advanced varaible manipulations.","Below options allow more advanced varaible manipulations."
+"Reorder factor levels","Arranger niveuer i faktor"
+"Reorder the levels of factor/categorical variables.","Reorder the levels of factor/categorical variables."
+"New factor","Ny faktor"
+"Create factor/categorical variable from a continous variable (number/date/time).","Create factor/categorical variable from a continous variable (number/date/time)."
+"New variable","Ny variabel"
+"Create a new variable based on an R-expression.","Create a new variable based on an R-expression."
+"Compare modified data to original","Compare modified data to original"
+"Raw print of the original vs the modified data.","Raw print of the original vs the modified data."
+"Original data:","Original data:"
+"Modified data:","Ændret data:"
+"New column name:","Navn til ny variabel:"
+"Group calculation by:","Group calculation by:"
+"Enter an expression to define new column:","Enter an expression to define new column:"
+"Click on a column name to add it to the expression:","Click on a column name to add it to the expression:"
+"Create column","Create column"
+"Choose a name for the column to be created or modified,","Choose a name for the column to be created or modified,"
+"then enter an expression before clicking on the button above to validate or on","then enter an expression before clicking on the button above to validate or on"
+"to delete it.","to delete it."
+"New column name cannot be empty","New column name cannot be empty"
+"Create a new column","Create a new column"
+"Some operations are not allowed","Some operations are not allowed"
+"Column added!","Column added!"
+"Unique values:","Unique values:"
+"Variable to cut:","Variable to cut:"
+"Number of breaks:","Number of breaks:"
+"Close intervals on the right","Close intervals on the right"
+"Include lowest value","Include lowest value"
+"Create factor variable","Create factor variable"
+"Fixed breaks:","Fixed breaks:"
+"Method:","Method:"
+"Convert Numeric to Factor","Convert Numeric to Factor"
+"Unique:","Unique:"
+"Missing:","Missing:"
+"Most Common:","Most Common:"
+"Min:","Min:"
+"Mean:","Mean:"
+"Max:","Max:"
+"Decimal separator:","Decimal separator:"
+"First five rows are shown below:","First five rows are shown below:"
+"Imported data","Imported data"
+"www/intro.md","www/intro.md"
+"Choose your data","Choose your data"
+"Upload a file, get data directly from REDCap or use local or sample data.","Upload a file, get data directly from REDCap or use local or sample data."
+"Factor variable to reorder:","Factor variable to reorder:"
+"Sort by levels","Sort by levels"
+"Sort by count","Sort by count"
+"Create a new variable (otherwise replaces the one selected)","Create a new variable (otherwise replaces the one selected)"
+"Update factor variable","Updater faktor-variabel"
+"Sort count","Sorter antal"
+"Levels","Niveauer"
+"Count","Antal"
+"Update levels of a factor","Updater niveauerne for en faktor"
+"Update & select variables","Update & select variables"
+"Date format:","Datoformat:"
+"Date to use as origin to convert date/datetime:","Date to use as origin to convert date/datetime:"
+"Apply changes","Apply changes"
+"No data to display.","Ingen data at vise."
+"Data successfully updated!","Data er opdateret!"
+"You removed {p_out} % of observations.","Du har fjernet {p_out} % af observationerne."
+"You removed {p_out} % of variables.","Du har fjernet {p_out} % af variablerne."
+"You can import {file_extensions_text} files","Du kan vælge mellem disse filtyper: {file_extensions_text}."
+"You can choose between these file types:","Du kan vælge mellem følgene filtyper:"
+"Rows to skip before reading data:","Rækker der skal springes over:"
+"Missing values character(s):","Tegn for manglende værdier:"
+"if several use a comma (',') to separate them","if several use a comma (',') to separate them"
+"Encoding:","Kodning:"
+"Upload a file:","Upload en fil:"
+"Browse...","Vælg..."
+"Select sheet to import:","Vælg ark:"
+"No file selected.","Ingen fil valgt."
+"Evaluate","Evaluer"
+"Visuals","Grafik"
+"Regression","Regression"
+"Download","Download"
+"{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases.","{data_text} har {n} observationer og {n_var} variabler, med {n_complete} ({p_complete} %) komplette cases."
+"Prepare","Forbered"
+"At 0, only complete variables are included; at 100, all variables are included.","At 0, only complete variables are included; at 100, all variables are included."
+"The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.","The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent."
+"No variables have a correlation measure above the threshold.","Ingen variabler er korrelerede over den angivne tærskelværdi."
+"and","og"
+"from each pair","fra hvert par"
+"Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot.","Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot."
+"Plot","Plot"
+"Adjust settings, then press ""Plot"".","Adjust settings, then press ""Plot""."
+"Plot height (mm)","Plot height (mm)"
+"Plot width (mm)","Plot width (mm)"
+"File format","File format"
+"Download plot","Download plot"
+"Select variable","Select variable"
+"Response variable","Response variable"
+"Plot type","Plot type"
+"Please select","Please select"
+"Additional variables","Additional variables"
+"Secondary variable","Secondary variable"
+"No variable","No variable"
+"Grouping variable","Grouping variable"
+"No stratification","No stratification"
+"Drawing the plot. Hold tight for a moment..","Drawing the plot. Hold tight for a moment.."
+"#Plotting\n","#Plotting\n"
+"Drawing the plot. Hold on for a moment..","Drawing the plot. Hold on for a moment.."
+"Stacked horizontal bars","Stacked horizontal bars"
+"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars","A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"
+"Violin plot","Violin plot"
+"A modern alternative to the classic boxplot to visualise data distribution","A modern alternative to the classic boxplot to visualise data distribution"
+"Sankey plot","Sankey plot"
+"A way of visualising change between groups","A way of visualising change between groups"
+"Scatter plot","Scatter plot"
+"A classic way of showing the association between to variables","A classic way of showing the association between to variables"
+"Box plot","Box plot"
+"A classic way to plot data distribution by groups","A classic way to plot data distribution by groups"
+"Euler diagram","Euler diagram"
+"Generate area-proportional Euler diagrams to display set relationships","Generate area-proportional Euler diagrams to display set relationships"

inst/translations/translation_sw.csv

@@ -0,0 +1,145 @@
+"en","sw"
+"Hello","Habari"
+"Get started","Get started"
+"File upload","File upload"
+"REDCap server export","REDCap server export"
+"Local or sample data","Local or sample data"
+"Please be mindfull handling sensitive data","Please be mindfull handling sensitive data"
+"The ***FreesearchR*** app only stores data for analyses, but please only use with sensitive data when running locally. [Read more here](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine).","The ***FreesearchR*** app only stores data for analyses, but please only use with sensitive data when running locally. [Read more here](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine)."
+"Quick overview","Quick overview"
+"Select variables for final import","Select variables for final import"
+"Exclude incomplete variables:","Exclude incomplete variables:"
+"Manual selection:","Manual selection:"
+"Let's begin!","Let's begin!"
+"Analysis validation","Analysis validation"
+"Report","Report"
+"Choose your favourite output file format for further work, and download, when the analyses are done.","Choose your favourite output file format for further work, and download, when the analyses are done."
+"www/intro.html","www/intro_sw.html"
+"<p>The <em><strong>FreesearchR</strong></em> app only stores data for analyses, but please only use with sensitive data when running locally. <a href='https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine'>Read more here</a></p>","<p>The <em><strong>FreesearchR</strong></em> app only stores data for analyses, but please only use with sensitive data when running locally. <a href='https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine'>Read more here</a></p>"
+"Overview and filter","Overview and filter"
+"Overview and filtering","Overview and filtering"
+"Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse data and apply different data filters.","Below you find a summary table for quick insigths, and on the right you can visualise data classes, browse data and apply different data filters."
+"Visual overview","Visual overview"
+"Browse data","Browse data"
+"Filter data types","Filter data types"
+"Filter observations","Filter observations"
+"Apply filter on observation","Apply filter on observation"
+"Edit and create data","Edit and create data"
+"Subset, rename and convert variables","Subset, rename and convert variables"
+"Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.).","Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."
+"There are more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with R code. At the bottom you can restore the original data.","There are more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with R code. At the bottom you can restore the original data."
+"Please note that data modifications are applied before any filtering.","Please note that data modifications are applied before any filtering."
+"Advanced data manipulation","Advanced data manipulation"
+"Below options allow more advanced varaible manipulations.","Below options allow more advanced varaible manipulations."
+"Reorder factor levels","Reorder factor levels"
+"Reorder the levels of factor/categorical variables.","Reorder the levels of factor/categorical variables."
+"New factor","New factor"
+"Create factor/categorical variable from a continous variable (number/date/time).","Create factor/categorical variable from a continous variable (number/date/time)."
+"New variable","New variable"
+"Create a new variable based on an R-expression.","Create a new variable based on an R-expression."
+"Compare modified data to original","Compare modified data to original"
+"Raw print of the original vs the modified data.","Raw print of the original vs the modified data."
+"Original data:","Original data:"
+"Modified data:","Modified data:"
+"New column name:","New column name:"
+"Group calculation by:","Group calculation by:"
+"Enter an expression to define new column:","Enter an expression to define new column:"
+"Click on a column name to add it to the expression:","Click on a column name to add it to the expression:"
+"Create column","Create column"
+"Choose a name for the column to be created or modified,","Choose a name for the column to be created or modified,"
+"then enter an expression before clicking on the button above to validate or on","then enter an expression before clicking on the button above to validate or on"
+"to delete it.","to delete it."
+"New column name cannot be empty","New column name cannot be empty"
+"Create a new column","Create a new column"
+"Some operations are not allowed","Some operations are not allowed"
+"Column added!","Column added!"
+"Unique values:","Unique values:"
+"Variable to cut:","Variable to cut:"
+"Number of breaks:","Number of breaks:"
+"Close intervals on the right","Close intervals on the right"
+"Include lowest value","Include lowest value"
+"Create factor variable","Create factor variable"
+"Fixed breaks:","Fixed breaks:"
+"Method:","Method:"
+"Convert Numeric to Factor","Convert Numeric to Factor"
+"Unique:","Unique:"
+"Missing:","Missing:"
+"Most Common:","Most Common:"
+"Min:","Min:"
+"Mean:","Mean:"
+"Max:","Max:"
+"Decimal separator:","Decimal separator:"
+"First five rows are shown below:","First five rows are shown below:"
+"Imported data","Imported data"
+"www/intro.md","www/intro.md"
+"Choose your data","Choose your data"
+"Upload a file, get data directly from REDCap or use local or sample data.","Upload a file, get data directly from REDCap or use local or sample data."
+"Factor variable to reorder:","Factor variable to reorder:"
+"Sort by levels","Sort by levels"
+"Sort by count","Sort by count"
+"Create a new variable (otherwise replaces the one selected)","Create a new variable (otherwise replaces the one selected)"
+"Update factor variable","Update factor variable"
+"Sort count","Sort count"
+"Levels","Levels"
+"Count","Count"
+"Update levels of a factor","Update levels of a factor"
+"Update & select variables","Update & select variables"
+"Date format:","Date format:"
+"Date to use as origin to convert date/datetime:","Date to use as origin to convert date/datetime:"
+"Apply changes","Apply changes"
+"No data to display.","No data to display."
+"Data successfully updated!","Data successfully updated!"
+"You removed {p_out} % of observations.","You removed {p_out} % of observations."
+"You removed {p_out} % of variables.","You removed {p_out} % of variables."
+"You can import {file_extensions_text} files","You can import {file_extensions_text} files"
+"You can choose between these file types:","You can choose between these file types:"
+"Rows to skip before reading data:","Rows to skip before reading data:"
+"Missing values character(s):","Missing values character(s):"
+"if several use a comma (',') to separate them","if several use a comma (',') to separate them"
+"Encoding:","Encoding:"
+"Upload a file:","Upload a file:"
+"Browse...","Browse..."
+"Select sheet to import:","Select sheet to import:"
+"No file selected.","No file selected."
+"Evaluate","Evaluate"
+"Visuals","Visuals"
+"Regression","Regression"
+"Download","Download"
+"{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases.","{data_text} has {n} observations and {n_var} variables, with {n_complete} ({p_complete} %) complete cases."
+"Prepare","Prepare"
+"At 0, only complete variables are included; at 100, all variables are included.","At 0, only complete variables are included; at 100, all variables are included."
+"The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.","The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent."
+"No variables have a correlation measure above the threshold.","No variables have a correlation measure above the threshold."
+"and","and"
+"from each pair","from each pair"
+"Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot.","Only non-text variables are available for plotting. Go the ""Data"" to reclass data to plot."
+"Plot","Plot"
+"Adjust settings, then press ""Plot"".","Adjust settings, then press ""Plot""."
+"Plot height (mm)","Plot height (mm)"
+"Plot width (mm)","Plot width (mm)"
+"File format","File format"
+"Download plot","Download plot"
+"Select variable","Select variable"
+"Response variable","Response variable"
+"Plot type","Plot type"
+"Please select","Please select"
+"Additional variables","Additional variables"
+"Secondary variable","Secondary variable"
+"No variable","No variable"
+"Grouping variable","Grouping variable"
+"No stratification","No stratification"
+"Drawing the plot. Hold tight for a moment..","Drawing the plot. Hold tight for a moment.."
+"#Plotting\n","#Plotting\n"
+"Drawing the plot. Hold on for a moment..","Drawing the plot. Hold on for a moment.."
+"Stacked horizontal bars","Stacked horizontal bars"
+"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars","A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"
+"Violin plot","Violin plot"
+"A modern alternative to the classic boxplot to visualise data distribution","A modern alternative to the classic boxplot to visualise data distribution"
+"Sankey plot","Sankey plot"
+"A way of visualising change between groups","A way of visualising change between groups"
+"Scatter plot","Scatter plot"
+"A classic way of showing the association between to variables","A classic way of showing the association between to variables"
+"Box plot","Box plot"
+"A classic way to plot data distribution by groups","A classic way to plot data distribution by groups"
+"Euler diagram","Euler diagram"
+"Generate area-proportional Euler diagrams to display set relationships","Generate area-proportional Euler diagrams to display set relationships"

man/FreesearchR_palette.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/theme.R
+\name{FreesearchR_palette}
+\alias{FreesearchR_palette}
+\title{Use the FreesearchR colors}
+\usage{
+FreesearchR_palette(n)
+}
+\arguments{
+\item{n}{number of colors}
+}
+\value{
+character vector
+}
+\description{
+Use the FreesearchR colors
+}
+\examples{
+FreesearchR_palette(n=7)
+}

man/align_axes.Rd

@@ -4,7 +4,7 @@
 \alias{align_axes}
 \title{Aligns axes between plots}
 \usage{
-align_axes(...)
+align_axes(..., x.axis = TRUE, y.axis = TRUE)
 }
 \arguments{
 \item{...}{ggplot2 objects or list of ggplot2 objects}

man/compare_missings.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/missings-module.R
+\name{compare_missings}
+\alias{compare_missings}
+\title{Pairwise comparison of missings across covariables}
+\usage{
+compare_missings(data, by_var)
+}
+\arguments{
+\item{data}{data frame}
+
+\item{by_var}{variable to stratify by missingness}
+}
+\value{
+gtsummary list object
+}
+\description{
+Pairwise comparison of missings across covariables
+}

man/create-column.Rd

@@ -21,7 +21,7 @@ list_allowed_operations()
 
 modal_create_column(
   id,
-  title = i18n("Create a new column"),
+  title = i18n$t("Create a new column"),
   easyClose = TRUE,
   size = "l",
   footer = NULL
@@ -29,7 +29,7 @@ modal_create_column(
 
 winbox_create_column(
   id,
-  title = i18n("Create a new column"),
+  title = i18n$t("Create a new column"),
   options = shinyWidgets::wbOptions(),
   controls = shinyWidgets::wbControls()
 )

man/cut-variable.Rd

@@ -13,7 +13,7 @@ cut_variable_server(id, data_r = reactive(NULL))
 
 modal_cut_variable(
   id,
-  title = datamods:::i18n("Convert Numeric to Factor"),
+  title = i18n$t("Convert Numeric to Factor"),
   easyClose = TRUE,
   size = "l",
   footer = NULL

man/data-correlations.Rd

@@ -8,18 +8,34 @@
 \usage{
 data_correlations_ui(id, ...)
 
-data_correlations_server(id, data, include.class = NULL, cutoff = 0.7, ...)
+data_correlations_server(
+  id,
+  data,
+  include.class = NULL,
+  cutoff = 0.7,
+  warning_str =
+    i18n$t("The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\\nConsider excluding one {more}from the dataset to ensure variables are independent."),
+  warning_no_str = i18n$t("No variables have a correlation measure above the threshold."),
+  and_str = i18n$t("and"),
+  ...
+)
 }
 \arguments{
-\item{id}{Module id. (Use 'ns("id")')}
+\item{id}{id}
 
 \item{...}{arguments passed to toastui::datagrid}
 
 \item{data}{data}
 
-\item{color.main}{main color}
+\item{include.class}{character vector of classes to include. Default is NULL}
 
-\item{color.sec}{secondary color}
+\item{cutoff}{numeric}
+
+\item{warning_str}{Character string. Exposed to allow dynamic translations}
+
+\item{warning_no_str}{Character string. Exposed to allow dynamic translations}
+
+\item{and_strCharacter}{string. Exposed to allow dynamic translations}
 }
 \value{
 Shiny ui module

man/data-missings.Rd

@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/missings-module.R, R/visual_summary.R
+\name{data-missings}
+\alias{data-missings}
+\alias{data_missings_ui}
+\alias{data_missings_server}
+\alias{visual_summary_ui}
+\title{Data correlations evaluation module}
+\usage{
+data_missings_ui(id)
+
+data_missings_server(id, data, variable, ...)
+
+visual_summary_ui(id)
+}
+\arguments{
+\item{id}{Module id}
+
+\item{data}{data}
+
+\item{output.format}{output format}
+}
+\value{
+Shiny ui module
+
+shiny server module
+
+Shiny ui module
+}
+\description{
+Data correlations evaluation module
+
+Data correlations evaluation module
+}

man/data-plots.Rd

@@ -22,7 +22,7 @@ data_visuals_server(id, data, ...)
 
 create_plot(data, type, pri, sec, ter = NULL, ...)
 
-plot_box(data, pri, sec, ter = NULL)
+plot_box(data, pri, sec, ter = NULL, ...)
 
 plot_box_single(data, pri, sec = NULL, seed = 2103)
 
@@ -41,9 +41,9 @@ plot_violin(data, pri, sec, ter = NULL)
 \arguments{
 \item{id}{Module id. (Use 'ns("id")')}
 
-\item{...}{ignored for now}
+\item{...}{passed on to wrap_plot_list}
 
-\item{data}{data.frame}
+\item{data}{data frame}
 
 \item{type}{plot type (derived from possible_plots() and matches custom function)}
 
@@ -99,13 +99,19 @@ Beatiful violin plot
 }
 \examples{
 create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
-mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+mtcars |> plot_box(pri = "mpg", sec = "gear")
+mtcars |> plot_box(pri = "mpg", sec="cyl")
 mtcars |>
   default_parsing() |>
   plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+mtcars |>
+  default_parsing() |>
+  plot_box(pri = "mpg", sec = "cyl", ter = "gear",axis.font.family="mono")
 mtcars |> plot_box_single("mpg")
 mtcars |> plot_box_single("mpg","cyl")
+gtsummary::trial |> plot_box_single("age","trt")
 mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 mtcars |> plot_hbars(pri = "carb", sec = NULL)
 mtcars |>
   default_parsing() |>

man/data_summary_gather.Rd

@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/visual_summary.R
+\name{data_summary_gather}
+\alias{data_summary_gather}
+\title{Data summary for printing visual summary}
+\usage{
+data_summary_gather(
+  data,
+  summary.fun = class,
+  palette.fun = viridisLite::viridis
+)
+}
+\arguments{
+\item{data}{data.frame}
+
+\item{palette.fun}{optionally use specific palette functions. First argument
+has to be the length.}
+
+\item{fun}{summary function. Default is "class"}
+}
+\value{
+data.frame
+}
+\description{
+Data summary for printing visual summary
+}
+\examples{
+mtcars |> data_summary_gather()
+}

man/dim_change_call.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{dim_change_call}
+\alias{dim_change_call}
+\title{Dimensions validation}
+\usage{
+dim_change_call(before, after, fun)
+}
+\arguments{
+\item{before}{data before}
+
+\item{after}{data after}
+
+\item{fun}{dimension function. ncol or nrow}
+}
+\value{
+data.frame
+}
+\description{
+Dimensions validation
+}

man/make_validation.Rd

@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{make_validation}
+\alias{make_validation}
+\title{Create validation data.frame}
+\usage{
+make_validation(ls, ...)
+}
+\arguments{
+\item{ls}{validation list}
+
+\item{...}{magic dots}
+}
+\value{
+data.frame
+}
+\description{
+Create validation data.frame
+}
+\examples{
+i18n <- shiny.i18n::Translator$new(translation_csvs_path = here::here("inst/translations"))
+i18n$set_translation_language("en")
+df_original <- mtcars
+df_original[1,2:4] <- NA
+df_obs <- df_original |> dplyr::filter(carb==4)
+df_vars <- df_original[1:7]
+val <- purrr::map2(
+  .x = validation_lib(),
+  .y = list(
+  list(x = df_original, y = df_obs),
+  list(x = df_original, y = df_vars),
+  list(x=df_original)),
+  make_validation
+)
+val |> make_validation_alerts()
+
+val2 <- purrr::map2(
+  .x = validation_lib()[2],
+  .y = list(list(x = mtcars, y = mtcars[0])),
+  make_validation
+)
+val2 |> make_validation_alerts()
+
+val3 <- make_validation(
+  ls = validation_lib()[[2]],
+  list(x = mtcars, y = mtcars[0])
+)
+}

man/make_validation_alerts.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{make_validation_alerts}
+\alias{make_validation_alerts}
+\title{Create alert from validation data.frame}
+\usage{
+make_validation_alerts(data)
+}
+\arguments{
+\item{data}{}
+}
+\description{
+Create alert from validation data.frame
+}

man/missings_apex_plot.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/visual_summary.R
+\name{missings_apex_plot}
+\alias{missings_apex_plot}
+\title{Plot missings and class with apexcharter}
+\usage{
+missings_apex_plot(data, animation = FALSE, ...)
+}
+\arguments{
+\item{data}{data frame}
+}
+\value{
+An \code{\link[=apexchart]{apexchart()}} \code{htmlwidget} object.
+}
+\description{
+Plot missings and class with apexcharter
+}
+\examples{
+data_demo <- mtcars
+data_demo[2:4, "cyl"] <- NA
+rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
+data_demo |> missings_apex_plot()
+mtcars |> missings_apex_plot(animation = TRUE)
+# dplyr::storms |> missings_apex_plot()
+visdat::vis_dat(dplyr::storms)
+}

man/missings_validate.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{missings_validate}
+\alias{missings_validate}
+\title{Validate function of missingness in data}
+\usage{
+missings_validate(data)
+}
+\arguments{
+\item{data}{data set}
+}
+\value{
+data.frame
+}
+\description{
+Validate function of missingness in data
+}
+\examples{
+df <- mtcars
+df[1,2:4] <- NA
+missings_validate(df)
+}

man/obs_filter_validate.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{obs_filter_validate}
+\alias{obs_filter_validate}
+\title{Observations filter test wrapper}
+\usage{
+obs_filter_validate(before, after)
+}
+\arguments{
+\item{before}{data before}
+
+\item{after}{data after}
+}
+\value{
+vector
+}
+\description{
+Observations filter test wrapper
+}

man/plot_euler.Rd

@@ -31,4 +31,5 @@ data.frame(
   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
 mtcars |> plot_euler("vs", "am", seed = 1)
+mtcars |> plot_euler("vs", "am", "cyl", seed = 1)
 }

man/ui_elements.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ui_elements.R
+\name{ui_elements}
+\alias{ui_elements}
+\title{FreesearchR UI elements list}
+\usage{
+ui_elements(selection)
+}
+\arguments{
+\item{selection}{specify element to output}
+}
+\value{
+Shinu UI elements
+}
+\description{
+FreesearchR UI elements list
+}

man/unique_short.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/visual_summary.R
+\name{unique_short}
+\alias{unique_short}
+\title{Create unique short names of character vector items based on index}
+\usage{
+unique_short(data, max = 15)
+}
+\arguments{
+\item{data}{character vector}
+
+\item{max}{maximum final name length}
+}
+\value{
+character vector
+}
+\description{
+The function will prefer original names, and only append index to long
+strings.
+}
+\examples{
+c("kahdleidnsallskdj", "hej") |> unique_short()
+}

man/update-factor.Rd

@@ -14,7 +14,7 @@ update_factor_server(id, data_r = reactive(NULL))
 
 modal_update_factor(
   id,
-  title = i18n("Update levels of a factor"),
+  title = i18n$t("Update levels of a factor"),
   easyClose = TRUE,
   size = "l",
   footer = NULL
@@ -22,7 +22,7 @@ modal_update_factor(
 
 winbox_update_factor(
   id,
-  title = i18n("Update levels of a factor"),
+  title = i18n$t("Update levels of a factor"),
   options = shinyWidgets::wbOptions(),
   controls = shinyWidgets::wbControls()
 )

man/validation.Rd

@@ -0,0 +1,169 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{validation_ui}
+\alias{validation_ui}
+\alias{validation_server}
+\title{Validation module}
+\usage{
+validation_ui(id, max_height = NULL, ...)
+
+validation_server(id, data)
+}
+\arguments{
+\item{id}{Module's ID.}
+
+\item{max_height}{Maximum height for validation results element, useful if you have many rules.}
+
+\item{...}{Arguments passed to \code{actionButton} or \code{uiOutput} depending on display mode,
+you cannot use \code{inputId}/\code{outputId}, \code{label} or \code{icon} (button only).}
+
+\item{data}{a \code{reactive} function returning a \code{data.frame}.}
+}
+\value{
+\itemize{
+\item UI: HTML tags that can be included in shiny's UI
+\item Server: a \code{list} with two slots:
+\itemize{
+\item \strong{status}: a \code{reactive} function returning the best status available between \code{"OK"}, \code{"Failed"} or \code{"Error"}.
+\item \strong{details}: a \code{reactive} function returning a \code{list} with validation details.
+}
+}
+}
+\description{
+Check that a dataset respect some validation expectations.
+}
+\examples{
+#' Data and analyses validation demo
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' validation_demo_app()
+#' }
+validation_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::tags$h2("Validation"),
+    IDEAFilter::IDEAFilter_ui("data_filter"),
+    shiny::br(),
+    DT::DTOutput("data_final"),
+    shiny::br(),
+    validation_ui("validation_demo_2")
+  )
+
+  server <- function(input, output, session) {
+    rv <- shiny::reactiveValues(
+      data_original = shiny::reactive(mtcars),
+      data_filtered = NULL
+    )
+
+    rv_validation <- shiny::reactiveValues(
+      obs_filter = NULL,
+      vars_filter = NULL
+    )
+
+    data_filter <- IDEAFilter::IDEAFilter(
+      id = "data_filter",
+      data = mtcars,
+      verbose = TRUE
+    )
+
+    shiny::observeEvent(
+      data_filter(),
+      {
+        rv$data_filtered <- data_filter()
+      }
+    )
+
+    output$data_final <- DT::renderDT(
+      data_filter()
+    )
+
+    shiny::observeEvent(
+      list(
+        data_filter()
+      ),
+      {
+        to_make_validation <- data_filter()
+        ## Validation
+        if (!is.null(to_make_validation)) {
+          validation <-
+            make_validation(
+              ls = validation_lib("obs_filter"),
+              list(
+                x = mtcars,
+                y = to_make_validation
+              )
+            )
+
+        rv_validation$vars_filter <- validation
+
+        validation_server(id = "validation_demo_2", data = rv_validation$vars_filter)
+
+        }
+
+
+      }
+    )
+
+    # shiny::observeEvent(
+    #   list(
+    #     shiny::reactive(rv_validation$vars_filter)(),
+    #     data_filter()
+    #   ),
+    #   {
+    #     # browser()
+    #     # to_make_alert <- shiny::isolate(rv_validation$vars_filter)
+    #     to_make_alert <- shiny::reactive(rv_validation$vars_filter)()
+    #     if (!is.null(rv_validation$vars_filter)) {
+    #       validation_server(id = "validation_demo_2", data = to_make_alert)
+    #     }
+    #   }
+    # )
+  }
+  shiny::shinyApp(ui, server)
+}
+
+
+#' Title
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' validation_nr_demo_app()
+validation_nr_demo_app <- function() {
+  ui <- shiny::fluidPage(
+    shiny::tags$h2("Validation"),
+    shiny::br(),
+    validation_ui("validation_demo_1", max_height = "30px"),
+    shiny::br(),
+    validation_ui("validation_demo_2")
+  )
+
+  server <- function(input, output, session) {
+    df_original <- mtcars
+
+    df_obs <- mtcars |> dplyr::filter(mpg > 20)
+
+    df_vars <- df_obs[1:6]
+
+    val1 <- purrr::map2(
+      .x = validation_lib()[1],
+      .y = list(list(x = df_original, y = df_obs)),
+      make_validation
+    )
+
+    val2 <- make_validation(
+      ls = validation_lib()[[2]],
+      list(x = df_original, y = df_vars)
+    )
+
+    validation_server(id = "validation_demo_1", data = val1)
+
+    validation_server(id = "validation_demo_2", data = val2)
+  }
+  shiny::shinyApp(ui, server)
+}
+}

man/validation_lib.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{validation_lib}
+\alias{validation_lib}
+\title{Validation library}
+\usage{
+validation_lib(name = NULL)
+}
+\arguments{
+\item{name}{Index name}
+}
+\value{
+list
+}
+\description{
+Validation library
+}
+\examples{
+validation_lib()
+validation_lib("missings")
+}

man/vars_filter_validate.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validation.R
+\name{vars_filter_validate}
+\alias{vars_filter_validate}
+\title{Variable filter test wrapper}
+\usage{
+vars_filter_validate(before, after)
+}
+\arguments{
+\item{before}{data before}
+
+\item{after}{data after}
+}
+\value{
+vector
+}
+\description{
+Variable filter test wrapper
+}
+\examples{
+vars_filter_validate(mtcars, mtcars[1:6])
+vars_filter_validate(mtcars, mtcars[0])
+}