new attempt

.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 }}

CITATION.cff

@@ -1002,19 +1002,6 @@ references:
     email: russell-lenth@uiowa.edu
   year: '2025'
   doi: 10.32614/CRAN.package.emmeans
-- type: software
-  title: visdat
-  abstract: 'visdat: Preliminary Visualisation of Data'
-  notes: Imports
-  url: https://docs.ropensci.org/visdat/
-  repository: https://CRAN.R-project.org/package=visdat
-  authors:
-  - family-names: Tierney
-    given-names: Nicholas
-    email: nicholas.tierney@gmail.com
-    orcid: https://orcid.org/0000-0003-1460-8722
-  year: '2025'
-  doi: 10.32614/CRAN.package.visdat
 - type: software
   title: styler
   abstract: 'styler: Non-Invasive Pretty Printing of R Code'

DESCRIPTION

@@ -64,8 +64,7 @@ Imports:
     RcppArmadillo,
     ggcorrplot,
     shinyjs,
-    emmeans,
-    visdat
+    emmeans
 Suggests: 
     styler,
     devtools,
@@ -80,7 +79,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)
@@ -32,6 +33,7 @@ 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)
@@ -121,12 +123,15 @@ export(supported_plots)
 export(symmetrical_scale_x_log10)
 export(tbl_merge)
 export(type_icons)
+export(unique_short)
 export(update_factor_server)
 export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_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,6 +1,6 @@
 # FreesearchR 25.6.3
 
-- *NEW* First go at introducing more options to evaluate missings. This has introduced a new dependency to use the visdat package and visualisation. The solution includes the option to visualise data classes and missingness as well as comparisons of variables by missing outcome variable or not to determine the nature of missingness.
+- *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.
 

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v25.6.3-250625'
+hosted_version <- function()'v25.6.3-250626'

R/missings-module.R

@@ -34,7 +34,8 @@ data_missings_server <- function(id,
       variabler <- if (is.reactive(variable)) variable else reactive(variable)
 
       rv <- shiny::reactiveValues(
-        data = NULL
+        data = NULL,
+        table = NULL
       )
 
       rv$data <- shiny::reactive({
@@ -65,15 +66,25 @@ data_missings_server <- function(id,
         shiny::req(variabler)
 
         if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
-          title <- "No missing observations"
+          if (anyNA(datar())){
+            title <- "No variable chosen for analysis"
           } else {
-          title <- paste("Missing vs non-missing observations in", variabler())
+          title <- "No missing observations"
+          }
+        } else {
+          title <- glue::glue("Missing vs non-missing observations in the variable **'{variabler()}'**")
         }
 
-        rv$data() |>
+        out <- rv$data() |>
           gtsummary::as_gt() |>
           gt::tab_header(title = gt::md(title))
+
+        rv$table <- out
+
+        out
       })
+
+      return(reactive(rv$table))
     }
   )
 }
@@ -100,10 +111,12 @@ missing_demo_app <- function() {
 
     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_missings(data = data_demo, id = "modal_missings")
+          modal_visual_summary(id = "visual")
         },
         error = function(err) {
           showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
@@ -117,137 +130,9 @@ missing_demo_app <- function() {
 missing_demo_app()
 
 
-modal_visual_missings <- function(data,
-                                  title = "Visual overview of data classes and missing observations",
-                                  easyClose = TRUE,
-                                  size = "xl",
-                                  footer = NULL,
-                                  ...) {
-  datar <- if (is.reactive(data)) data else reactive(data)
-
-  showModal(modalDialog(
-    title = tagList(title, datamods:::button_close_modal()),
-    tags$div(
-      # apexcharter::renderApexchart({
-      #   missings_apex_plot(datar(), ...)
-      # })
-      shiny::renderPlot({
-        visdat::vis_dat(datar(),sort_type = FALSE) +
-          ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) +
-          # ggplot2::theme_void() +
-          ggplot2::theme(
-            # legend.position = "none",
-            panel.grid.major = ggplot2::element_blank(),
-            panel.grid.minor = ggplot2::element_blank(),
-            # axis.text.y = element_blank(),
-            # axis.title.y = element_blank(),
-            text = ggplot2::element_text(size = 18),
-            # axis.text = ggplot2::element_blank(),
-            # panel.background = ggplot2::element_rect(fill = "white"),
-            # plot.background = ggplot2::element_rect(fill = "white"),
-            # panel.border = ggplot2::element_blank()
-            plot.title = ggplot2::element_blank()
-          )
-      })
-    ),
-    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, ...) {
-  browser()
-
-  df_plot <- purrr::map_df(data, \(x){
-    ifelse(is.na(x),
-      yes = NA,
-      no = glue::glue_collapse(class(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))
-
-  if (any(df_plot$valueType == "NA")) {
-    colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels))
-  } else {
-    colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels))
-  }
-
-
-  label_list <- labels |>
-    purrr::imap(\(.x, .i){
-      list(
-        from = .x,
-        to = .x,
-        color = colors[[.i]],
-        name = .i
-      )
-    }) |>
-    setNames(NULL)
-
-  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 = label_list
-        ),
-        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
-}

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/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()
+}

SESSION.md

@@ -11,11 +11,11 @@
 |collate     |en_US.UTF-8                                |
 |ctype       |en_US.UTF-8                                |
 |tz          |Europe/Copenhagen                          |
-|date        |2025-06-25                                 |
+|date        |2025-06-26                                 |
 |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.3.250625                              |
+|FreesearchR |25.6.3.250626                              |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -43,6 +43,7 @@
 |cardx             |0.2.4         |2025-04-12 |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) |
 |checkmate         |2.3.2         |2024-07-29 |CRAN (R 4.4.0) |
 |class             |7.3-23        |2025-01-01 |CRAN (R 4.4.1) |
 |classInt          |0.4-11        |2025-01-08 |CRAN (R 4.4.1) |
@@ -106,12 +107,12 @@
 |htmltools         |0.5.8.1       |2024-04-04 |CRAN (R 4.4.1) |
 |htmlwidgets       |1.6.4         |2023-12-06 |CRAN (R 4.4.0) |
 |httpuv            |1.6.16        |2025-04-16 |CRAN (R 4.4.1) |
-|httr              |1.4.7         |2023-08-15 |CRAN (R 4.4.0) |
 |IDEAFilter        |0.2.0         |2024-04-15 |CRAN (R 4.4.0) |
 |insight           |1.2.0         |2025-04-22 |CRAN (R 4.4.1) |
 |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) |
 |knitr             |1.50          |2025-03-16 |CRAN (R 4.4.1) |
@@ -138,7 +139,6 @@
 |opdisDownsampling |1.0.1         |2024-04-15 |CRAN (R 4.4.0) |
 |openssl           |2.3.2         |2025-02-03 |CRAN (R 4.4.1) |
 |openxlsx2         |1.15          |2025-04-25 |CRAN (R 4.4.1) |
-|pak               |0.8.0.2       |2025-04-08 |CRAN (R 4.4.1) |
 |parameters        |0.24.2        |2025-03-04 |CRAN (R 4.4.1) |
 |patchwork         |1.3.0         |2024-09-16 |CRAN (R 4.4.1) |
 |pbmcapply         |1.5.1         |2022-04-28 |CRAN (R 4.4.1) |
@@ -167,6 +167,7 @@
 |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) |
@@ -198,7 +199,6 @@
 |sessioninfo       |1.2.3         |2025-02-05 |CRAN (R 4.4.1) |
 |shiny             |1.10.0        |2024-12-14 |CRAN (R 4.4.1) |
 |shinybusy         |0.3.3         |2024-03-09 |CRAN (R 4.4.0) |
-|shinydashboard    |0.7.3         |NA         |NA             |
 |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) |
@@ -220,8 +220,10 @@
 |urlchecker        |1.0.1         |2021-11-30 |CRAN (R 4.4.1) |
 |usethis           |3.1.0         |2024-11-26 |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) |
 |vctrs             |0.6.5         |2023-12-01 |CRAN (R 4.4.0) |
-|visdat            |0.6.0         |2023-02-02 |CRAN (R 4.4.0) |
+|viridisLite       |0.4.2         |2023-05-02 |CRAN (R 4.4.1) |
+|visdat            |0.6.0         |NA         |NA             |
 |vroom             |1.6.5         |2023-12-05 |CRAN (R 4.4.0) |
 |withr             |3.0.2         |2024-10-28 |CRAN (R 4.4.1) |
 |writexl           |1.5.4         |2025-04-15 |CRAN (R 4.4.1) |

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  make pandoc zlib1g-dev libicu-dev libcurl4-openssl-dev libsecret-1-dev libxml2-dev libssl-dev libx11-dev libfontconfig1-dev libfreetype6-dev git libsodium-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.0.3")'
+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,31 @@
+# Welcome <img style="float: right;" src="FreesearchR-logo.png">
+
+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.
+
+Here is a brief summary of the functions:
+
+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.
+
+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.  **Evaluate data** using descriptive analyses methods and inspect cross-correlations
+
+1.  **Create and export simple, clean plots** for data overview and insights
+
+1.  **Create regression simple models** for even more advanced data analyses
+
+    -   Linear, dichotomous or ordinal logistic regression will be used depending on specified outcome variable
+    
+    -   Plot regression analysis coefficients
+
+    -   Evaluate model assumptions
+
+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).

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/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>

inst/apps/FreesearchR/app.R

@@ -3996,7 +3996,7 @@ simple_snake <- function(data){
 #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R 
 ########
 
-hosted_version <- function()'v25.6.3-250625'
+hosted_version <- function()'v25.6.3-250626'
 
 
 ########
@@ -4695,7 +4695,8 @@ data_missings_server <- function(id,
       variabler <- if (is.reactive(variable)) variable else reactive(variable)
 
       rv <- shiny::reactiveValues(
-        data = NULL
+        data = NULL,
+        table = NULL
       )
 
       rv$data <- shiny::reactive({
@@ -4726,15 +4727,25 @@ data_missings_server <- function(id,
         shiny::req(variabler)
 
         if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
-          title <- "No missing observations"
+          if (anyNA(datar())){
+            title <- "No variable chosen for analysis"
           } else {
-          title <- paste("Missing vs non-missing observations in", variabler())
+          title <- "No missing observations"
+          }
+        } else {
+          title <- glue::glue("Missing vs non-missing observations in the variable **'{variabler()}'**")
         }
 
-        rv$data() |>
+        out <- rv$data() |>
           gtsummary::as_gt() |>
           gt::tab_header(title = gt::md(title))
+
+        rv$table <- out
+
+        out
       })
+
+      return(reactive(rv$table))
     }
   )
 }
@@ -4761,10 +4772,12 @@ missing_demo_app <- function() {
 
     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_missings(data = data_demo, id = "modal_missings")
+          modal_visual_summary(id = "visual")
         },
         error = function(err) {
           showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
@@ -4778,140 +4791,12 @@ missing_demo_app <- function() {
 missing_demo_app()
 
 
-modal_visual_missings <- function(data,
-                                  title = "Visual overview of data classes and missing observations",
-                                  easyClose = TRUE,
-                                  size = "xl",
-                                  footer = NULL,
-                                  ...) {
-  datar <- if (is.reactive(data)) data else reactive(data)
-
-  showModal(modalDialog(
-    title = tagList(title, datamods:::button_close_modal()),
-    tags$div(
-      # apexcharter::renderApexchart({
-      #   missings_apex_plot(datar(), ...)
-      # })
-      shiny::renderPlot({
-        visdat::vis_dat(datar(),sort_type = FALSE) +
-          ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) +
-          # ggplot2::theme_void() +
-          ggplot2::theme(
-            # legend.position = "none",
-            panel.grid.major = ggplot2::element_blank(),
-            panel.grid.minor = ggplot2::element_blank(),
-            # axis.text.y = element_blank(),
-            # axis.title.y = element_blank(),
-            text = ggplot2::element_text(size = 18),
-            # axis.text = ggplot2::element_blank(),
-            # panel.background = ggplot2::element_rect(fill = "white"),
-            # plot.background = ggplot2::element_rect(fill = "white"),
-            # panel.border = ggplot2::element_blank()
-            plot.title = ggplot2::element_blank()
-          )
-      })
-    ),
-    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, ...) {
-  browser()
-
-  df_plot <- purrr::map_df(data, \(x){
-    ifelse(is.na(x),
-      yes = NA,
-      no = glue::glue_collapse(class(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))
-
-  if (any(df_plot$valueType == "NA")) {
-    colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels))
-  } else {
-    colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels))
-  }
-
-
-  label_list <- labels |>
-    purrr::imap(\(.x, .i){
-      list(
-        from = .x,
-        to = .x,
-        color = colors[[.i]],
-        name = .i
-      )
-    }) |>
-    setNames(NULL)
-
-  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 = label_list
-        ),
-        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
-}
 
 
 ########
@@ -8278,7 +8163,7 @@ FreesearchR_colors <- function(choose = NULL) {
     secondary = "#FF6F61",
     success = "#00C896",
     warning = "#FFB100",
-    danger = "#FF3A2F",
+    danger = "#CC2E25",
     extra = "#8A4FFF",
     info = "#11A0EC",
     bg = "#FFFFFF",
@@ -8292,7 +8177,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)
+}
 
 
 
@@ -9443,6 +9339,303 @@ clean_date <- function(data) {
 }
 
 
+########
+#### Current file: /Users/au301842/FreesearchR/R//visual_summary.R 
+########
+
+#' 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()
+}
+
+
 ########
 #### Current file: /Users/au301842/FreesearchR/R//wide2long.R 
 ########
@@ -9796,7 +9989,7 @@ ui_elements <- list(
             shiny::column(
               width = 3,
               shiny::actionButton(
-                inputId = "modal_missings",
+                inputId = "modal_visual_overview",
                 label = "Visual overview",
                 width = "100%",
                 disabled = TRUE
@@ -10323,6 +10516,7 @@ server <- function(input, output, session) {
   rv <- shiny::reactiveValues(
     list = list(),
     regression = NULL,
+    missings = NULL,
     ds = NULL,
     local_temp = NULL,
     ready = NULL,
@@ -10342,28 +10536,6 @@ server <- function(input, output, session) {
   #########
   ##############################################################################
 
-  ## This does not render correctly apparently due to css and load order
-  # output$source <- shiny::renderUI({
-  #
-  #   choices <- c(
-  #     "File upload" = "file",
-  #     "REDCap server export" = "redcap",
-  #     "Local or sample data" = "env"
-  #   )
-  #
-  #   if (isTRUE(is_local)){
-  #     choices <- choices[c(1,3)]
-  #   }
-  #
-  #   shinyWidgets::radioGroupButtons(
-  #     inputId = "source",
-  #     selected = "file",
-  #     choices = choices,
-  #     size = "lg"
-  #   )
-  # })
-
-
   data_file <- import_file_server(
     id = "file_import",
     show_data_in = "popup",
@@ -10386,16 +10558,6 @@ server <- function(input, output, session) {
     rv$code <- modifyList(x = rv$code, list(import = from_redcap$code()))
   })
 
-  ## This is used to ensure the reactive data is retrieved
-  # output$redcap_prev <- DT::renderDT(
-  #   {
-  #     DT::datatable(head(from_redcap$data(), 5),
-  #       caption = "First 5 observations"
-  #     )
-  #   },
-  #   server = TRUE
-  # )
-
   from_env <- datamods::import_globalenv_server(
     id = "env",
     trigger_return = "change",
@@ -10410,11 +10572,20 @@ server <- function(input, output, session) {
     rv$code <- modifyList(x = rv$code, list(import = from_env$name()))
   })
 
+  visual_summary_server(
+    id = "initial_summary",
+    data_r = shiny::reactive({
+      shiny::req(rv$data_temp)
+      default_parsing(rv$data_temp)
+    }),
+    palette.fun = FreesearchR_palette
+  )
+
   observeEvent(input$modal_initial_view, {
     tryCatch(
       {
-        modal_visual_missings(
-          data = default_parsing(rv$data_temp),
+        modal_visual_summary(
+          id = "initial_summary",
           footer = NULL,
           size = "xl"
         )
@@ -10497,12 +10668,12 @@ server <- function(input, output, session) {
     if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
       shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
       shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE)
-      shiny::updateActionButton(inputId = "modal_missings", disabled = TRUE)
+      shiny::updateActionButton(inputId = "modal_visual_overview", disabled = TRUE)
       shiny::updateActionButton(inputId = "act_eval", disabled = TRUE)
     } else {
       shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
       shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE)
-      shiny::updateActionButton(inputId = "modal_missings", disabled = FALSE)
+      shiny::updateActionButton(inputId = "modal_visual_overview", disabled = FALSE)
       shiny::updateActionButton(inputId = "act_eval", disabled = FALSE)
     }
   })
@@ -10548,7 +10719,6 @@ server <- function(input, output, session) {
     )
   })
 
-
   #########
   #########  Modifications
   #########
@@ -10741,11 +10911,20 @@ server <- function(input, output, session) {
     )
   })
 
-  observeEvent(input$modal_missings, {
+  visual_summary_server(
+    id = "visual_overview",
+    data_r = shiny::reactive({
+      shiny::req(rv$data_filtered)
+      REDCapCAST::fct_drop(rv$data_filtered)
+    }),
+    palette.fun = FreesearchR_palette
+  )
+
+  observeEvent(input$modal_visual_overview, {
     tryCatch(
       {
-        modal_visual_missings(
-          data = REDCapCAST::fct_drop(rv$data_filtered),
+        modal_visual_summary(
+          id = "visual_overview",
           footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.",
           size = "xl"
         )
@@ -10756,7 +10935,6 @@ server <- function(input, output, session) {
     )
   })
 
-
   output$original_str <- renderPrint({
     str(rv$data_original)
   })
@@ -10779,7 +10957,6 @@ server <- function(input, output, session) {
       shiny::req(rv$data_filtered)
 
       rv$list$table1 <- NULL
-      # rv$regression <- NULL
     }
   )
 
@@ -10904,7 +11081,7 @@ server <- function(input, output, session) {
         rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data"))
       })
 
-      rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})")
+      rv$code$table1 <- glue::glue("FreesearchR::create_baseline(df,{list2str(parameters)})")
     }
   )
 
@@ -10951,12 +11128,12 @@ server <- function(input, output, session) {
       label = "Select variable to stratify analysis",
       data = shiny::reactive({
         shiny::req(rv$data_filtered)
-        rv$data_filtered[apply(rv$data_filtered,2,anyNA)]
+        rv$data_filtered[apply(rv$data_filtered, 2, anyNA)]
       })()
     )
   })
 
-  data_missings_server(
+  rv$missings <- data_missings_server(
     id = "missingness",
     data = shiny::reactive(rv$data_filtered),
     variable = shiny::reactive(input$missings_var)
@@ -10979,22 +11156,6 @@ server <- function(input, output, session) {
 
   rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data))
 
-  # shiny::observeEvent(rv$regression, {
-  #   browser()
-  #   if (shiny::is.reactive(rv$regression)) {
-  #     rv$list$regression <- rv$regression()
-  #   } else {
-  #     rv$list$regression <- rv$regression
-  #   }
-  #   # rv$list$regression <- rv$regression()
-  # })
-
-  # output$regression_models <- renderText({
-  #   req(rv$list$regression)
-  #   browser()
-  #   names(rv$list$regression)
-  # })
-
   ##############################################################################
   #########
   #########  Page navigation
@@ -11051,6 +11212,7 @@ server <- function(input, output, session) {
       format <- ifelse(type == "docx", "word_document", "odt_document")
 
       rv$list$regression <- rv$regression()
+      rv$list$missings <- rv$missings()
 
       shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
         tryCatch(

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/data-missings.Rd

@@ -1,14 +1,17 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/missings-module.R
+% 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}
@@ -21,7 +24,11 @@ data_missings_server(id, data, variable, ...)
 Shiny ui module
 
 shiny server module
+
+Shiny ui module
 }
 \description{
+Data correlations evaluation module
+
 Data correlations evaluation module
 }

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/missings_apex_plot.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/missings-module.R
+% Please edit documentation in R/visual_summary.R
 \name{missings_apex_plot}
 \alias{missings_apex_plot}
 \title{Plot missings and class with apexcharter}

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/visual_summary.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/visual_summary.R
+\name{visual_summary}
+\alias{visual_summary}
+\title{Ggplot2 data summary visualisation based on visdat::vis_dat.}
+\usage{
+visual_summary(data, legend.title = "Data class", ...)
+}
+\arguments{
+\item{data}{data}
+
+\item{...}{optional arguments passed to data_summary_gather()}
+}
+\value{
+ggplot2 object
+}
+\description{
+Ggplot2 data summary visualisation based on visdat::vis_dat.
+}
+\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)
+}

renv.lock

@@ -8917,54 +8917,6 @@
       "Author": "Simon Garnier [aut, cre], Noam Ross [ctb, cph], Bob Rudis [ctb, cph], Marco Sciaini [ctb, cph], Antônio Pedro Camargo [ctb, cph], Cédric Scherer [ctb, cph]",
       "Repository": "CRAN"
     },
-    "visdat": {
-      "Package": "visdat",
-      "Version": "0.6.0",
-      "Source": "Repository",
-      "Title": "Preliminary Visualisation of Data",
-      "Authors@R": "c( person(\"Nicholas\", \"Tierney\", role = c(\"aut\", \"cre\"), email = \"nicholas.tierney@gmail.com\",  comment = c(ORCID = \"https://orcid.org/0000-0003-1460-8722\")), person(\"Sean\", \"Hughes\", role = \"rev\",  comment =c(ORCID = \"https://orcid.org/0000-0002-9409-9405\", \"Sean Hughes reviewed the package for rOpenSci,  see https://github.com/ropensci/onboarding/issues/87\")), person(\"Mara\", \"Averick\", role = \"rev\",  comment = \"Mara Averick reviewed the package for rOpenSci, see  https://github.com/ropensci/onboarding/issues/87\"), person(\"Stuart\", \"Lee\", role = c(\"ctb\")), person(\"Earo\", \"Wang\", role = c(\"ctb\")), person(\"Nic\", \"Crane\", role = c(\"ctb\")), person(\"Christophe\", \"Regouby\", role=c(\"ctb\")) )",
-      "Description": "Create preliminary exploratory data visualisations of an entire  dataset to identify problems or unexpected features using 'ggplot2'.",
-      "Depends": [
-        "R (>= 3.2.2)"
-      ],
-      "License": "MIT + file LICENSE",
-      "LazyData": "true",
-      "RoxygenNote": "7.2.3",
-      "Imports": [
-        "ggplot2",
-        "tidyr",
-        "dplyr",
-        "purrr",
-        "readr",
-        "magrittr",
-        "stats",
-        "tibble",
-        "glue",
-        "forcats",
-        "cli",
-        "scales"
-      ],
-      "URL": "https://docs.ropensci.org/visdat/, https://github.com/ropensci/visdat",
-      "BugReports": "https://github.com/ropensci/visdat/issues",
-      "Suggests": [
-        "testthat (>= 3.0.0)",
-        "plotly (>= 4.5.6)",
-        "knitr",
-        "rmarkdown",
-        "vdiffr",
-        "spelling",
-        "covr",
-        "stringr"
-      ],
-      "VignetteBuilder": "knitr",
-      "Encoding": "UTF-8",
-      "Language": "en-US",
-      "Config/testthat/edition": "3",
-      "NeedsCompilation": "no",
-      "Author": "Nicholas Tierney [aut, cre] (<https://orcid.org/0000-0003-1460-8722>), Sean Hughes [rev] (<https://orcid.org/0000-0002-9409-9405>, Sean Hughes reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87), Mara Averick [rev] (Mara Averick reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87), Stuart Lee [ctb], Earo Wang [ctb], Nic Crane [ctb], Christophe Regouby [ctb]",
-      "Maintainer": "Nicholas Tierney <nicholas.tierney@gmail.com>",
-      "Repository": "CRAN"
-    },
     "vroom": {
       "Package": "vroom",
       "Version": "1.6.5",