new version ready for release

.Rbuildignore

@@ -17,3 +17,5 @@
 ^app*$
 ^page$
 ^demo$
+^\.positai$
+^\.claude$

.gitignore

@@ -16,3 +16,4 @@ app
 page
 demo
 visuals
+.positai

CITATION.cff

@@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:'
 type: software
 license: AGPL-3.0-or-later
 title: 'FreesearchR: Easy data analysis for clinicians'
-version: 26.3.5
+version: 26.6.1
 doi: 10.5281/zenodo.14527429
 identifiers:
 - type: url

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FreesearchR
 Title: Easy data analysis for clinicians
-Version: 26.3.5
+Version: 26.6.1
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154")),
@@ -118,6 +118,7 @@ Collate:
     'launch_FreesearchR.R'
     'missings-module.R'
     'plot-download-module.R'
+    'plot-helpers.R'
     'plot_bar.R'
     'plot_box.R'
     'plot_euler.R'

NAMESPACE

@@ -16,6 +16,7 @@ export(append_column)
 export(append_list)
 export(apply_labels)
 export(argsstring2list)
+export(available_plots)
 export(baseline_table)
 export(class_icons)
 export(clean_common_axis)
@@ -64,6 +65,7 @@ export(format_writer)
 export(generate_colors)
 export(get_data_packages)
 export(get_fun_options)
+export(get_input_params)
 export(get_label)
 export(get_list_elements)
 export(get_plot_options)
@@ -116,6 +118,7 @@ export(modify_qmd)
 export(names2val)
 export(overview_vars)
 export(pipe_string)
+export(plot_bar)
 export(plot_bar_single)
 export(plot_box)
 export(plot_box_single)

NEWS.md

@@ -1,3 +1,21 @@
+# FreesearchR 26.6.1
+
+*NEW* The visuals module has been restructured to allow for more advanced inputs, which will be added in the future. Basically a more future proof design allowing for more adjustments, while striving to keep the simplicity. Have fun!
+
+# FreesearchR 26.4.2
+
+Bug fixes and revised color choices.
+
+# FreesearchR 26.4.1
+
+Minor adjustments and bug fixes including streamlining icon use to only use phosphoricons across the app.
+
+# FreesearchR 26.3.6
+
+*FIX* Plot single variable in Likert plot.
+
+*FIX* Horizontal stacked plot crashed. Fixed!
+
 # FreesearchR 26.3.5
 
 *FIX* Labelled categorical variables were not handled correctly importing from REDCap resulting in lost labels. Fixed!

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'26.3.5'
+app_version <- function()'26.6.1'

R/create-column-mod.R

@@ -76,7 +76,7 @@ create_column_ui <- function(id) {
       actionButton(
         inputId = ns("compute"),
         label = tagList(
-          phosphoricons::ph("pencil"), i18n$t("Create column")
+          phosphoricons::ph("pencil",weight = "bold"), i18n$t("Create column")
         ),
         class = "btn-outline-primary",
         width = "100%"
@@ -84,7 +84,7 @@ create_column_ui <- function(id) {
       actionButton(
         inputId = ns("remove"),
         label = tagList(
-          phosphoricons::ph("x-circle"),
+          phosphoricons::ph("x-circle",weight = "bold"),
           i18n$t("Cancel")
         ),
         class = "btn-outline-danger",

R/cut-variable-ext.R

@@ -64,7 +64,7 @@ cut_variable_ui <- function(id) {
     toastui::datagridOutput2(outputId = ns("count")),
     actionButton(
       inputId = ns("create"),
-      label = tagList(phosphoricons::ph("scissors"), i18n$t("Create factor variable")),
+      label = tagList(phosphoricons::ph("scissors",weight = "bold"), i18n$t("Create factor variable")),
       class = "btn-outline-primary float-end"
     ),
     tags$div(class = "clearfix")

R/data-summary.R

@@ -309,21 +309,29 @@ class_icons <- function(x) {
     lapply(x,class_icons)
   } else {
   if (identical(x, "numeric")) {
-    shiny::icon("calculator")
+    phosphoricons::ph("calculator")
+    # shiny::icon("calculator")
   } else if (identical(x, "factor")) {
-    shiny::icon("chart-simple")
+    phosphoricons::ph("chart-bar")
+    # shiny::icon("chart-simple")
   } else if (identical(x, "integer")) {
-    shiny::icon("arrow-down-1-9")
+    phosphoricons::ph("list-numbers")
+    # shiny::icon("arrow-down-1-9")
   } else if (identical(x, "character")) {
-    shiny::icon("arrow-down-a-z")
+    phosphoricons::ph("text-aa")
+    # shiny::icon("arrow-down-a-z")
   } else if (identical(x, "logical")) {
-    shiny::icon("toggle-off")
+    phosphoricons::ph("toggle-left")
+    # shiny::icon("toggle-off")
   } else if (any(c("Date", "POSIXt") %in% x)) {
-    shiny::icon("calendar-days")
+    phosphoricons::ph("calendar")
+    # shiny::icon("calendar-days")
   } else if (any("POSIXct", "hms") %in% x) {
-    shiny::icon("clock")
+    phosphoricons::ph("clock")
+    # shiny::icon("clock")
   } else {
-    shiny::icon("table")
+    phosphoricons::ph("calendar")
+    # shiny::icon("table")
   }}
 }
 
@@ -342,21 +350,29 @@ type_icons <- function(x) {
     lapply(x,class_icons)
   } else {
     if (identical(x, "continuous")) {
-      shiny::icon("calculator")
+      phosphoricons::ph("calculator")
+      # shiny::icon("calculator")
     } else if (identical(x, "categorical")) {
-      shiny::icon("chart-simple")
+      phosphoricons::ph("chart-bar")
+      # shiny::icon("chart-simple")
     } else if (identical(x, "ordinal")) {
-      shiny::icon("arrow-down-1-9")
+      phosphoricons::ph("list-numbers")
+      # shiny::icon("arrow-down-1-9")
     } else if (identical(x, "text")) {
-      shiny::icon("arrow-down-a-z")
+      phosphoricons::ph("text-aa")
+      # shiny::icon("arrow-down-a-z")
     } else if (identical(x, "dichotomous")) {
-      shiny::icon("toggle-off")
+      phosphoricons::ph("toggle-left")
+      # shiny::icon("toggle-off")
     } else if (identical(x,"datetime")) {
-      shiny::icon("calendar-days")
+      phosphoricons::ph("calendar")
+      # shiny::icon("calendar-days")
     } else if (identical(x,"id")) {
-      shiny::icon("id-card")
+      phosphoricons::ph("identification-badge")
+      # shiny::icon("id-card")
     } else {
-      shiny::icon("table")
+      phosphoricons::ph("table")
+      # shiny::icon("table")
     }
     }
 }

R/data_plots.R

@@ -14,13 +14,25 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
   list(
     bslib::layout_sidebar(
       sidebar = bslib::sidebar(
+        shiny::actionButton(
+          inputId = ns("act_plot"),
+          label = i18n$t("Plot"),
+          width = "100%",
+          icon = phosphoricons::ph("paint-brush", weight = "bold"),
+          # icon = shiny::icon("palette"),
+          disabled = FALSE
+        ),
+        shiny::helpText(
+          i18n$t('Adjust plot input and settings below, then press "Plot".')
+        ),
         bslib::accordion(
           id = "acc_plot",
           multiple = FALSE,
           bslib::accordion_panel(
             value = "acc_pan_plot",
-            title = "Create plot",
+            title = i18n$t("Define plot"),
-            icon = bsicons::bs_icon("graph-up"),
+            icon = phosphoricons::ph("chart-line"),
+            # icon = bsicons::bs_icon("graph-up"),
             shiny::uiOutput(outputId = ns("primary")),
             shiny::helpText(
               i18n$t(
@@ -29,23 +41,22 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             ),
             shiny::tags$br(),
             shiny::uiOutput(outputId = ns("type")),
+            shiny::h5(i18n$t("Other variables")),
             shiny::uiOutput(outputId = ns("secondary")),
-            shiny::uiOutput(outputId = ns("tertiary")),
+            shiny::uiOutput(outputId = ns("tertiary"))
-            shiny::uiOutput(outputId = ns("color_palette")),
-            shiny::br(),
-            shiny::actionButton(
-              inputId = ns("act_plot"),
-              label = i18n$t("Plot"),
-              width = "100%",
-              icon = shiny::icon("palette"),
-              disabled = FALSE
           ),
-            shiny::helpText(i18n$t('Adjust settings, then press "Plot".'))
+          bslib::accordion_panel(
+            value = "acc_pan_params",
+            title = i18n$t("Settings"),
+            icon = phosphoricons::ph("gear"),
+            shiny::uiOutput(outputId = ns("color_palette")),
+            shiny::uiOutput(outputId = ns("basic_parameters")),
           ),
           bslib::accordion_panel(
             value = "acc_pan_download",
             title = "Download",
-            icon = bsicons::bs_icon("download"),
+            icon = phosphoricons::ph("download-simple"),
+            # icon = bsicons::bs_icon("download"),
             shinyWidgets::noUiSliderInput(
               inputId = ns("height_slide"),
               label = i18n$t("Plot height (mm)"),
@@ -84,21 +95,22 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
             shiny::downloadButton(
               outputId = ns("download_plot"),
               label = i18n$t("Download plot"),
-              icon = shiny::icon("download")
+              icon = phosphoricons::ph("arrow-fat-down")
+              # icon = shiny::icon("download")
             )
           )
         ),
         shiny::p(
           "We have collected a few notes on visualising data and details on the options included in FreesearchR:",
           shiny::tags$a(
-            href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
+            href = "https://freesearchr.github.io/FreesearchR-knowledge/app/visuals.html",
             "View notes in new tab",
             target = "_blank",
             rel = "noopener noreferrer"
           )
         )
       ),
-      shiny::plotOutput(ns("plot"), height = "70vh"),
+      shiny::plotOutput(ns("plot"), height = "65vh"),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::htmlOutput(outputId = ns("code_plot"))
@@ -115,21 +127,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
 #' @name data-plots
 #' @returns shiny server module
 #' @export
-data_visuals_server <- function(id,
+data_visuals_server <- function(id, data, palettes = color_choices(), ...) {
-                                data,
-                                palettes = c(
-                                  "Perceptual (blue-yellow)"   = "viridis",
-                                  "Perceptual (fire)"          = "plasma",
-                                  "Colour-blind friendly"      = "Okabe-Ito",
-                                  "Qualitative (bold)"         = "Dark 2",
-                                  "Qualitative (paired)"       = "Paired",
-                                  "Sequential (blues)"         = "Blues",
-                                  "Diverging (red-blue)"       = "RdBu",
-                                  "Tableau style"              = "Tableau 10",
-                                  "Pastel"                     = "Pastel 1",
-                                  "Rainbow"                    = "rainbow"
-                                ),
-                                ...) {
   shiny::moduleServer(
     id = id,
     module = function(input, output, session) {
@@ -150,100 +148,6 @@ data_visuals_server <- function(id,
                                       title = i18n$t("Download"))
       })
 
-      # ## --- New attempt
-      #
-      # rv$plot.params <- shiny::reactive({
-      #   get_plot_options(input$type) |> purrr::pluck(1)
-      # })
-      #
-      # c(output,
-      #            list(shiny::renderUI({
-      #   columnSelectInput(
-      #     inputId = ns("primary"),
-      #     data = data,
-      #     placeholder = "Select variable",
-      #     label = "Response variable",
-      #     multiple = FALSE
-      #   )
-      # }),
-      # shiny::renderUI({
-      #   shiny::req(input$primary)
-      #   # browser()
-      #
-      #   if (!input$primary %in% names(data())) {
-      #     plot_data <- data()[1]
-      #   } else {
-      #     plot_data <- data()[input$primary]
-      #   }
-      #
-      #   plots <- possible_plots(
-      #     data = plot_data
-      #   )
-      #
-      #   plots_named <- get_plot_options(plots) |>
-      #     lapply(\(.x){
-      #       stats::setNames(.x$descr, .x$note)
-      #     })
-      #
-      #   vectorSelectInput(
-      #     inputId = ns("type"),
-      #     selected = NULL,
-      #     label = shiny::h4("Plot type"),
-      #     choices = Reduce(c, plots_named),
-      #     multiple = FALSE
-      #   )
-      # }),
-      # shiny::renderUI({
-      #   shiny::req(input$type)
-      #
-      #   cols <- c(
-      #     rv$plot.params()[["secondary.extra"]],
-      #     all_but(
-      #       colnames(subset_types(
-      #         data(),
-      #         rv$plot.params()[["secondary.type"]]
-      #       )),
-      #       input$primary
-      #     )
-      #   )
-      #
-      #   columnSelectInput(
-      #     inputId = ns("secondary"),
-      #     data = data,
-      #     selected = cols[1],
-      #     placeholder = "Please select",
-      #     label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
-      #     multiple = rv$plot.params()[["secondary.multi"]],
-      #     maxItems = rv$plot.params()[["secondary.max"]],
-      #     col_subset = cols,
-      #     none_label = "No variable"
-      #   )
-      # }),
-      # shiny::renderUI({
-      #   shiny::req(input$type)
-      #   columnSelectInput(
-      #     inputId = ns("tertiary"),
-      #     data = data,
-      #     placeholder = "Please select",
-      #     label = "Grouping variable",
-      #     multiple = FALSE,
-      #     col_subset = c(
-      #       "none",
-      #       all_but(
-      #         colnames(subset_types(
-      #           data(),
-      #           rv$plot.params()[["tertiary.type"]]
-      #         )),
-      #         input$primary,
-      #         input$secondary
-      #       )
-      #     ),
-      #     none_label = "No stratification"
-      #   )
-      # })
-      # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE)
-
-
       output$primary <- shiny::renderUI({
         shiny::req(data())
         columnSelectInput(
@@ -258,13 +162,12 @@ data_visuals_server <- function(id,
 
       # shiny::observeEvent(data, {
       #   if (is.null(data()) | NROW(data()) == 0) {
-      #     shiny::updateActionButton(inputId = ns("act_plot"), disabled = TRUE)
+      #     shiny::updateActionButton(inputId = "act_plot", disabled = TRUE)
       #   } else {
-      #     shiny::updateActionButton(inputId = ns("act_plot"), disabled = FALSE)
+      #     shiny::updateActionButton(inputId = "act_plot", disabled = FALSE)
       #   }
       # })
 
-
       output$type <- shiny::renderUI({
         shiny::req(input$primary)
         shiny::req(data())
@@ -276,94 +179,155 @@ data_visuals_server <- function(id,
           plot_data <- data()[input$primary]
         }
 
-        plots <- possible_plots(data = plot_data)
+        plots <- possible_plots(data = plot_data, source_list = available_plots())
 
-        plots_named <- get_plot_options(plots) |>
+        plots_named <- get_input_params(plots) |>
           lapply(\(.x) {
             stats::setNames(.x$descr, .x$note)
           })
 
+        # plots_named <- get_plot_options(plots) |>
+        #   lapply(\(.x) {
+        #     stats::setNames(.x$descr, .x$note)
+        #   })
+
         vectorSelectInput(
           inputId = ns("type"),
           selected = NULL,
-          label = shiny::h4(i18n$t("Plot type")),
+          label = shiny::h5(i18n$t("Plot type")),
           choices = Reduce(c, plots_named),
           multiple = FALSE
         )
       })
 
       rv$plot.params <- shiny::reactive({
-        get_plot_options(input$type) |> purrr::pluck(1)
+        get_input_params(input$type) |> purrr::pluck(1)
+        # get_plot_options(input$type) |> purrr::pluck(1)
       })
 
+
+      ### Include two additional variable inputs
       output$secondary <- shiny::renderUI({
         shiny::req(input$type)
 
-        cols <- c(rv$plot.params()[["secondary.extra"]], all_but(colnames(
+        # Get the plot function name
-          subset_types(data(), rv$plot.params()[["secondary.type"]])
+        base_params <- rv$plot.params()[["base"]]
-        ), input$primary))
 
-        columnSelectInput(
+        filtered_params <- base_params[sapply(base_params, function(params) {
-          inputId = ns("secondary"),
+          params$id %in% "secondary"
-          data = data,
+        })][[1]]
-          selected = cols[1],
+
-          placeholder = i18n$t("Please select"),
+        filtered_params$exclude <- input$primary
-          label = if (isTRUE(rv$plot.params()[["secondary.multi"]]))
+
-            i18n$t("Additional variables")
+        create_input_element(
-          else
+          input_id = "secondary",
-            i18n$t("Secondary variable"),
+          ns = ns,
-          multiple = rv$plot.params()[["secondary.multi"]],
+          params = append_list(data(), filtered_params, "data")
-          maxItems = rv$plot.params()[["secondary.max"]],
-          col_subset = cols,
-          none_label = i18n$t("No variable")
         )
+
       })
 
       output$tertiary <- shiny::renderUI({
         shiny::req(input$type)
-        columnSelectInput(
+        # Get the plot function name
-          inputId = ns("tertiary"),
+        base_params <- rv$plot.params()[["base"]]
-          data = data,
+
-          placeholder = i18n$t("Please select"),
+        filtered_params <- base_params[sapply(base_params, function(params) {
-          label = i18n$t("Grouping variable"),
+          params$id %in% "tertiary"
-          multiple = FALSE,
+        })][[1]]
-          col_subset = c(
+
-            "none",
+        filtered_params$exclude <- c(input$primary, input$secondary)
-            all_but(
+
-              colnames(subset_types(data(), rv$plot.params()[["tertiary.type"]])),
+        create_input_element(
-              input$primary,
+          input_id = "tertiary",
-              input$secondary
+          ns = ns,
-            )
+          params = append_list(data(), filtered_params, "data")
-          ),
-          none_label = i18n$t("No stratification")
         )
       })
 
+
+      ### Generating additional parameter inputs if any specified
+      output$basic_parameters <- renderUI({
+        req(input$type, rv$plot.params)
+
+        # Get the plot function name
+        base_params <- rv$plot.params()[["base"]]
+
+        filtered_params <- base_params[sapply(base_params, function(params) {
+          !params$id %in% c("secondary", "tertiary")
+        })]
+
+
+        # Create UI elements for base parameters
+        base_inputs <- lapply(filtered_params, function(params) {
+          input_id <- paste0("base_", params$id)
+          params$id <- NULL
+          if (params$type %in% "select_variables") {
+            params$data <- data()
+          }
+
+          create_input_element(params, ns, input_id)
+        })
+        tagList(base_inputs)
+
+      })
+
       ### Color option
       output$color_palette <- shiny::renderUI({
         # shiny::req(input$type)
         colorSelectInput(
           inputId = ns("color_palette"),
           label = i18n$t("Choose color palette"),
-          choices = palettes
+          choices = palettes,
+          previews = 5
         )
       })
 
       shiny::observeEvent(input$act_plot, {
         if (NROW(data()) > 0) {
           tryCatch({
+            # Get all input values with prefixes
+            base_inputs <- reactiveValuesToList(input)[grep("^base_", names(reactiveValuesToList(input)))]
+            # advanced_inputs <- reactiveValuesToList(input)[grep("^advanced_", names(reactiveValuesToList(input)))]
+
+            # Remove the prefix from names
+            names(base_inputs) <- gsub("^base_", "", names(base_inputs))
+            # names(advanced_inputs) <- gsub("^advanced_", "", names(advanced_inputs))
+
+            base_inputs <- c(base_inputs,
+                             list(color.palette = input$color_palette))
+
+            # If any of the specified parameters are NULL/missing, the settings
+            # accordion/panel was never opened, and they can be ignored, as
+            # default settings will the be used.
+            if (any(sapply(base_inputs, is.null))) {
+              dynamic_params <- list()
+            } else {
+              dynamic_params <- base_inputs
+            }
+
+            # Build parameters for plotting function
             parameters <- list(
               type = rv$plot.params()[["fun"]],
               pri = input$primary,
               sec = input$secondary,
-              ter = input$tertiary,
+              ter = input$tertiary
-              color.palette = input$color_palette
             )
 
+            parameters <- modifyList(parameters, dynamic_params)
+
             ## If the dictionary holds additional arguments to pass to the
             ## plotting function, these are included
             if (!is.null(rv$plot.params()[["fun.args"]])) {
-              parameters <- modifyList(parameters, rv$plot.params()[["fun.args"]])
+              default_params <- rv$plot.params()[["fun.args"]]
+
+              ## Ensure not to overwrite user defined parameters are overwritten
+              ## This allows to define default parameters.
+              ##
+              ## This will create a strange edge case, where the plot looks in
+              ## one way, when plotted initially, but may change, when the settings
+              ## accordion is opened. Problem for future me. Really mostly an edge case.
+              parameters <- modifyList(parameters, default_params[!names(default_params) %in% names(parameters)])
             }
 
             shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."),
@@ -399,7 +363,25 @@ data_visuals_server <- function(id,
         if (!is.null(rv$plot)) {
           rv$plot
         } else {
-          return(NULL)
+          # Create a placeholder plot with instructions using ggplot2
+          ggplot2::ggplot() +
+            ggplot2::annotate(
+              "text",
+              x = 0.5,
+              y = 0.5,
+              label = i18n$t("Select variables and plot type,\nthen click 'Plot' to generate visualization"),
+              size = 5,
+              color = "gray50",
+              lineheight = 0.8
+            ) +
+            ggplot2::xlim(0, 1) +
+            ggplot2::ylim(0, 1) +
+            ggplot2::theme_void() +
+            ggplot2::theme(
+              panel.background = ggplot2::element_rect(fill = "white"),
+              plot.background = ggplot2::element_rect(fill = "white")
+            )
+          # return(NULL)
         }
       })
 
@@ -443,491 +425,3 @@ data_visuals_server <- function(id,
     }
   )
 }
-
-#' Select all from vector but
-#'
-#' @param data vector
-#' @param ... exclude
-#'
-#' @returns vector
-#' @export
-#'
-#' @examples
-#' all_but(1:10, c(2, 3), 11, 5)
-all_but <- function(data, ...) {
-  data[!data %in% c(...)]
-}
-
-#' Easily subset by data type function
-#'
-#' @param data data
-#' @param types desired types
-#' @param type.fun function to get type. Default is outcome_type
-#'
-#' @returns vector
-#' @export
-#'
-#' @examples
-#' default_parsing(mtcars) |> subset_types("ordinal")
-#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
-#' #' default_parsing(mtcars) |> subset_types("factor",class)
-subset_types <- function(data, types, type.fun = data_type) {
-  data[sapply(data, type.fun) %in% types]
-}
-
-
-#' Implemented functions
-#'
-#' @description
-#' Library of supported functions. The list name and "descr" element should be
-#' unique for each element on list.
-#'
-#' -   descr: Plot description
-#'
-#' -   primary.type: Primary variable data type (continuous, dichotomous or ordinal)
-#'
-#' -   secondary.type: Secondary variable data type (continuous, dichotomous or ordinal)
-#'
-#' -   secondary.extra: "none" or NULL to have option to choose none.
-#'
-#' -   tertiary.type: Tertiary variable data type (continuous, dichotomous or ordinal)
-#'
-#'
-#' @returns list
-#' @export
-#'
-#' @examples
-#' supported_plots() |> str()
-supported_plots <- function() {
-  list(
-    plot_bar_rel = list(
-      fun = "plot_bar",
-      fun.args = list(style = "fill"),
-      descr = i18n$t("Stacked relative barplot"),
-      note = i18n$t(
-        "Create relative stacked barplots to show the distribution of categorical levels"
-      ),
-      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = NULL
-    ),
-    plot_bar_abs = list(
-      fun = "plot_bar",
-      fun.args = list(style = "dodge"),
-      descr = i18n$t("Side-by-side barplot"),
-      note = i18n$t(
-        "Create side-by-side barplot to show the distribution of categorical levels"
-      ),
-      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = "none"
-    ),
-    plot_hbars = list(
-      fun = "plot_hbars",
-      descr = i18n$t("Stacked horizontal 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,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = "none"
-    ),
-    plot_violin = list(
-      fun = "plot_violin",
-      descr = i18n$t("Violin plot"),
-      note = i18n$t(
-        "A modern alternative to the classic boxplot to visualise data distribution"
-      ),
-      primary.type = c("datatime", "continuous"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = FALSE,
-      secondary.extra = "none",
-      tertiary.type = c("dichotomous", "categorical")
-    ),
-    # plot_ridge = list(
-    #   descr = "Ridge plot",
-    #   note = "An alternative option to visualise data distribution",
-    #   primary.type = "continuous",
-    #   secondary.type = c("dichotomous" ,"categorical"),
-    #   tertiary.type = c("dichotomous" ,"categorical"),
-    #   secondary.extra = NULL
-    # ),
-    plot_sankey = list(
-      fun = "plot_sankey",
-      descr = i18n$t("Sankey plot"),
-      note = i18n$t("A way of visualising change between groups"),
-      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = FALSE,
-      secondary.extra = NULL,
-      tertiary.type = c("dichotomous", "categorical")
-    ),
-    plot_scatter = list(
-      fun = "plot_scatter",
-      descr = i18n$t("Scatter plot"),
-      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,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = NULL
-    ),
-    plot_box = list(
-      fun = "plot_box",
-      descr = i18n$t("Box plot"),
-      note = i18n$t("A classic way to plot data distribution by groups"),
-      primary.type = c("datatime", "continuous"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = "none"
-    ),
-    plot_euler = list(
-      fun = "plot_euler",
-      descr = i18n$t("Euler diagram"),
-      note = i18n$t(
-        "Generate area-proportional Euler diagrams to display set relationships"
-      ),
-      primary.type = c("dichotomous"),
-      secondary.type = c("dichotomous"),
-      secondary.multi = TRUE,
-      secondary.max = 4,
-      tertiary.type = c("dichotomous"),
-      secondary.extra = NULL
-    ),
-    plot_euler = list(
-      fun = "plot_likert",
-      descr = i18n$t("Likert diagram"),
-      note = i18n$t(
-        "Plot survey results"
-      ),
-      primary.type = c("dichotomous", "categorical"),
-      secondary.type = c("dichotomous", "categorical"),
-      secondary.multi = TRUE,
-      tertiary.type = c("dichotomous", "categorical"),
-      secondary.extra = NULL
-    )
-  )
-}
-
-#' Get possible regression models
-#'
-#' @param data data
-#'
-#' @returns character vector
-#' @export
-#'
-#' @examples
-#' mtcars |>
-#'   default_parsing() |>
-#'   dplyr::pull("cyl") |>
-#'   possible_plots()
-#'
-#' mtcars |>
-#'   default_parsing() |>
-#'   dplyr::select("mpg") |>
-#'   possible_plots()
-possible_plots <- function(data) {
-  # browser()
-  # data <- if (is.reactive(data)) data() else data
-  if (is.data.frame(data)) {
-    data <- data[[1]]
-  }
-
-  type <- data_type(data)
-
-  if (type == "unknown") {
-    out <- type
-  } else {
-    out <- supported_plots() |>
-      lapply(\(.x) {
-        if (type %in% .x$primary.type) {
-          .x$descr
-        }
-      }) |>
-      unlist()
-  }
-  unname(out)
-}
-
-#' Get the function options based on the selected function description
-#'
-#' @param data vector
-#'
-#' @returns list
-#' @export
-#'
-#' @examples
-#' ls <- mtcars |>
-#'   default_parsing() |>
-#'   dplyr::pull(mpg) |>
-#'   possible_plots() |>
-#'   (\(.x){
-#'     .x[[1]]
-#'   })() |>
-#'   get_plot_options()
-get_plot_options <- function(data) {
-  descrs <- supported_plots() |>
-    lapply(\(.x) {
-      .x$descr
-    }) |>
-    unlist()
-  supported_plots() |>
-    (\(.x) {
-      .x[match(data, descrs)]
-    })()
-}
-
-
-
-#' Wrapper to create plot based on provided type
-#'
-#' @param data data.frame
-#' @param pri primary variable
-#' @param sec secondary variable
-#' @param ter tertiary variable
-#' @param type plot type (derived from possible_plots() and matches custom function)
-#' @param color.palette choose color palette. See \code{\link{plot_colors}} for support.
-#' @param ... ignored for now
-#'
-#' @name data-plots
-#'
-#' @returns ggplot2 object
-#' @export
-#'
-#' @examples
-#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
-create_plot <- function(data,
-                        type,
-                        pri,
-                        sec,
-                        ter = NULL,
-                        color.palette = "viridis",
-                        ...) {
-  if (!is.null(sec)) {
-    if (!any(sec %in% names(data))) {
-      sec <- NULL
-    }
-  }
-
-  if (!is.null(ter)) {
-    if (!ter %in% names(data)) {
-      ter <- NULL
-    }
-  }
-
-  parameters <- list(
-    pri = pri,
-    sec = sec,
-    ter = ter,
-    color.palette = color.palette,
-    ...
-  )
-
-  out <- do.call(type, modifyList(parameters, list(data = data)))
-
-  code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
-
-  attr(out, "code") <- code
-  out
-}
-
-#' Print label, and if missing print variable name for plots
-#'
-#' @param data vector or data frame
-#' @param var variable name. Optional.
-#'
-#' @returns character string
-#' @export
-#'
-#' @examples
-#' mtcars |> get_label(var = "mpg")
-#' mtcars |> get_label()
-#' mtcars$mpg |> get_label()
-#' gtsummary::trial |> get_label(var = "trt")
-#' gtsummary::trial$trt |> get_label()
-#' 1:10 |> get_label()
-get_label <- function(data, var = NULL) {
-  # data <- if (is.reactive(data)) data() else data
-  if (!is.null(var) & is.data.frame(data)) {
-    data <- data[[var]]
-  }
-  out <- REDCapCAST::get_attr(data = data, attr = "label")
-  if (is.na(out)) {
-    if (is.null(var)) {
-      out <- deparse(substitute(data))
-    } else {
-      if (is.symbol(var)) {
-        out <- gsub('\"', "", deparse(substitute(var)))
-      } else {
-        out <- var
-      }
-    }
-  }
-  out
-}
-
-
-#' Line breaking at given number of characters for nicely plotting labels
-#'
-#' @param data string
-#' @param lineLength maximum line length
-#' @param fixed flag to force split at exactly the value given in lineLength.
-#' Default is FALSE, only splitting at spaces.
-#'
-#' @returns character string
-#' @export
-#'
-#' @examples
-#' "Lorem ipsum... you know the routine" |> line_break()
-#' 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")
-  }
-  ## https://stackoverflow.com/a/29847221
-}
-
-
-#' Wrapping
-#'
-#' @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,
-                           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 |>
-        (\(.x) {
-          if (rlang::is_named(.x)) {
-            purrr::imap(.x, \(.y, .i) {
-              .y + ggplot2::ggtitle(.i)
-            })
-          } else {
-            .x
-          }
-        })() |>
-        align_axes() |>
-        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[[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
-}
-
-
-#' Aligns axes between plots
-#'
-#' @param ... ggplot2 objects or list of ggplot2 objects
-#'
-#' @returns list of ggplot2 objects
-#' @export
-#'
-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)) {
-    ## Assumes list of ggplots
-    p <- list(...)
-  } else if (is.list(..1)) {
-    ## Assumes list with list of ggplots
-    p <- ..1
-  } else {
-    cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
-  }
-
-  yr <- clean_common_axis(p, "y")
-
-  xr <- clean_common_axis(p, "x")
-
-  suppressWarnings({
-    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
-    })
-  })
-}
-
-#' Extract and clean axis ranges
-#'
-#' @param p plot
-#' @param axis axis. x or y.
-#'
-#' @returns vector
-#' @export
-#'
-clean_common_axis <- function(p, axis) {
-  purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
-    unlist() |>
-    (\(.x) {
-      if (is.numeric(.x)) {
-        range(.x)
-      } else {
-        as.character(.x)
-      }
-    })() |>
-    unique()
-}

R/generate_colors.R

@@ -56,32 +56,25 @@
 #'
 #' @export
 generate_colors <- function(n, palette = "viridis", ...) {
-  if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) {
+
+  # --- Input validation -------------------------------------------------------
+  if (!is.numeric(n) || length(n) != 1 || n < 1 || n %% 1 != 0) {
     stop("`n` must be a single positive integer.")
   }
+  if (!is.function(palette) && (!is.character(palette) || length(palette) != 1)) {
+    stop("`palette` must be a single character string or a function.")
+  }
 
-  # Function passthrough — call directly with n and ...
+  # --- Function passthrough ---------------------------------------------------
   if (is.function(palette)) {
     return(palette(n, ...))
   }
 
-  if (!is.character(palette) || length(palette) != 1) {
+  # --- Named palette dispatch -------------------------------------------------
-    stop("`palette` must be a single character string or a function.")
-  }
-
-  if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) {
-    stop("`n` must be a single positive integer.")
-  }
-  if (!is.character(palette) || length(palette) != 1) {
-    stop("`palette` must be a single character string.")
-  }
-
   palette_lower <- tolower(palette)
 
-  viridis_palettes <- c(
+  viridis_palettes <- c("viridis", "magma", "plasma", "inferno",
-    "viridis", "magma", "plasma", "inferno",
+                        "cividis", "mako", "rocket", "turbo")
-    "cividis", "mako", "rocket", "turbo"
-  )
 
   if (palette_lower %in% viridis_palettes) {
     viridisLite::viridis(n = n, option = palette_lower, ...)
@@ -101,31 +94,42 @@ generate_colors <- function(n, palette = "viridis", ...) {
   } else if (palette_lower == "topo") {
     grDevices::topo.colors(n = n, ...)
 
-  } else if (palette %in% rownames(RColorBrewer::brewer.pal.info)) {
+  } else {
-    max_n       <- RColorBrewer::brewer.pal.info[palette, "maxcolors"]
+    # Case-insensitive RColorBrewer lookup
-    fetch_n     <- max(min(n, max_n), 3L)          # clamp to [3, max_n] for brewer.pal()
+    brewer_names <- rownames(RColorBrewer::brewer.pal.info)
-    base_colors <- RColorBrewer::brewer.pal(n = fetch_n, name = palette)
+    brewer_match <- brewer_names[match(palette_lower, tolower(brewer_names))]
+
+    if (!is.na(brewer_match)) {
+      max_n       <- RColorBrewer::brewer.pal.info[brewer_match, "maxcolors"]
+      fetch_n     <- max(min(n, max_n), 3L)
+      base_colors <- RColorBrewer::brewer.pal(n = fetch_n, name = brewer_match)
       grDevices::colorRampPalette(base_colors)(n)
 
-  } else if (palette %in% grDevices::palette.pals()) {
+    } else {
-    grDevices::colorRampPalette(palette.colors(palette = palette))(n)
+      # Case-insensitive grDevices palette.pals() lookup
+      pal_names <- grDevices::palette.pals()
+      pal_match <- pal_names[match(palette_lower, tolower(pal_names))]
+
+      if (!is.na(pal_match)) {
+        grDevices::colorRampPalette(grDevices::palette.colors(palette = pal_match))(n)
 
       } else if (palette %in% grDevices::hcl.pals()) {
+        # Named HCL palettes (e.g. "Rocket", "Plasma") — distinct from viridisLite
         grDevices::hcl.colors(n = n, palette = palette, ...)
 
       } else {
-    message(paste0(
+        warning(
-      "Unknown palette: '", palette, "'. ",
+          "Unknown palette: '", palette, "'. Falling back to viridis.\n",
-      "Falling back to default R colors.\n",
           "Available options:\n",
           "  viridisLite  : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n",
           "  grDevices    : hcl, rainbow, heat, terrain, topo\n",
           "  grDevices HCL: use grDevices::hcl.pals() to see all options\n",
           "  grDevices    : use grDevices::palette.pals() to see all options\n",
           "  RColorBrewer : use RColorBrewer::brewer.pal.info to see all options"
-    ))
+        )
         viridisLite::viridis(n = n, option = "viridis")
-    # grDevices::hcl.colors(n = n)
+      }
+    }
   }
 }
 
@@ -166,7 +170,9 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) {
   ramp   <- grDevices::colorRamp(colors)
 
   function(x) {
-    if (any(x < 0 | x > 1, na.rm = TRUE)) stop("Values must be in [0, 1].")
+    if (any(x < 0 |
+            x > 1, na.rm = TRUE))
+      stop("Values must be in [0, 1].")
     rgb_vals <- ramp(x)
     grDevices::rgb(rgb_vals[, 1], rgb_vals[, 2], rgb_vals[, 3], maxColorValue = 255)
   }
@@ -200,18 +206,18 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) {
 #'
 #' @seealso [scale_color_generate()], [generate_colors()], [continuous_colors()]
 #' @export
-scale_fill_generate <- function(palette = "viridis", discrete = TRUE, ...) {
+scale_fill_generate <- function(palette = "viridis",
+                                discrete = TRUE,
+                                ...) {
   if (discrete) {
     ggplot2::discrete_scale(
       aesthetics = "fill",
-      palette    = function(n) generate_colors(n, palette),
+      palette    = function(n)
+        generate_colors(n, palette),
       ...
     )
   } else {
-    ggplot2::scale_fill_gradientn(
+    ggplot2::scale_fill_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...)
-      colors = continuous_colors(palette)(seq(0, 1, length.out = 256)),
-      ...
-    )
   }
 }
 
@@ -221,17 +227,33 @@ scale_fill_generate <- function(palette = "viridis", discrete = TRUE, ...) {
 #'   geom_point() +
 #'   scale_color_generate(palette = "Set1")
 #' @export
-scale_color_generate <- function(palette = "viridis", discrete = TRUE, ...) {
+scale_color_generate <- function(palette = "viridis",
+                                 discrete = TRUE,
+                                 ...) {
   if (discrete) {
     ggplot2::discrete_scale(
       aesthetics = "colour",
-      palette    = function(n) generate_colors(n, palette),
+      palette    = function(n)
+        generate_colors(n, palette),
       ...
     )
   } else {
-    ggplot2::scale_color_gradientn(
+    ggplot2::scale_color_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...)
-      colors = continuous_colors(palette)(seq(0, 1, length.out = 256)),
+  }
-      ...
+}
+
+
+color_choices <- function() {
+  c(
+    "Perceptual (blue-yellow)"   = "viridis",
+    "Perceptual (fire)"          = "plasma",
+    "Colour-blind friendly"      = "Okabe-Ito",
+    "Diverging (red-yellow-green)"= "RdYlGn",
+    "Diverging (red-blue)"       = "RdBu",
+    "Sequential (blues)"         = "Blues",
+    "Qualitative (paired)"       = "Paired",
+    "Qualitative (bold)"         = "Dark 2",
+    "Rainbow"                    = "Spectral",
+    "Generic"                     = "Set1"
   )
 }
-}

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v26.3.5-260330'
+hosted_version <- function()'v26.6.1'

R/import-file-ext.R

@@ -714,7 +714,7 @@ make_success_alert <- function(data,
       i18n$t("Data ready to be imported!")
     ),
     sprintf(
-      i18n$t("Data has %s obs. of %s variables."),
+      i18n$t("The data set has %s obs. in %s variables."),
       nrow(data),
       ncol(data)
     ),
@@ -725,7 +725,7 @@ make_success_alert <- function(data,
       i18n$t("Data successfully imported!")
     ),
     sprintf(
-      i18n$t("Data has %s obs. of %s variables."),
+      i18n$t("The data set has %s obs. in %s variables."),
       nrow(data),
       ncol(data)
     ),

R/landing_page_ui.R

@@ -37,20 +37,6 @@ landing_page_ui <- function(i18n) {
     div(
       class = "container my-5",
 
-      # Introduction text
-      # div(
-      #   class = "row mb-5",
-      #   div(
-      #     class = "col-12 text-center",
-      #     p(
-      #       class = "lead",
-      #       i18n$t("Start with FreesearchR for basic data evaluation and analysis."),
-      #       i18n$t("When you need more advanced tools, you'll be better prepared to use R directly."),
-      #       style = "font-size: 1.2rem; color: #555;"
-      #     )
-      #   )
-      # ),
-
       # Core Features Section
       h2(i18n$t("Core Features"), class = "text-center mb-4",
          style = "color: #1E4A8F; font-weight: 600;"),
@@ -68,7 +54,8 @@ landing_page_ui <- function(i18n) {
               class = "card-body text-center p-4",
               div(
                 style = "font-size: 3rem; color: #1E4A8F; margin-bottom: 15px;",
-                fa("file-import")
+                phosphoricons::ph("folder-simple-plus", weight = "bold")
+                # fa("file-import")
               ),
               h4(i18n$t("Import Data"), class = "card-title", style = "color: #2D2D42; font-weight: 600;"),
               p(
@@ -89,7 +76,8 @@ landing_page_ui <- function(i18n) {
               class = "card-body text-center p-4",
               div(
                 style = "font-size: 3rem; color: #1E4A8F; margin-bottom: 15px;",
-                fa("pen-to-square")
+                phosphoricons::ph("note-pencil", weight = "bold")
+                # fa("pen-to-square")
               ),
               h4(i18n$t("Data Management"), class = "card-title", style = "color: #2D2D42; font-weight: 600;"),
               p(
@@ -110,7 +98,8 @@ landing_page_ui <- function(i18n) {
               class = "card-body text-center p-4",
               div(
                 style = "font-size: 3rem; color: #1E4A8F; margin-bottom: 15px;",
-                fa("magnifying-glass-chart")
+                phosphoricons::ph("magnifying-glass", weight = "bold")
+                # fa("magnifying-glass-chart")
               ),
               h4(i18n$t("Descriptive Statistics"), class = "card-title", style = "color: #2D2D42; font-weight: 600;"),
               p(
@@ -135,7 +124,7 @@ landing_page_ui <- function(i18n) {
             style = "border-left: 4px solid #8A4FFF;",
             div(
               class = "card-body",
-              h5(fa("chart-line"), " ", i18n$t("Data Visualization"), class = "card-title", style = "color: #2D2D42;"),
+              h5(phosphoricons::ph("chart-line", weight = "bold"), " ", i18n$t("Data Visualization"), class = "card-title", style = "color: #2D2D42;"),
               p(class = "card-text small", i18n$t("Create simple, clean plots for quick insights and overview"))
             )
           )
@@ -147,7 +136,7 @@ landing_page_ui <- function(i18n) {
             style = "border-left: 4px solid #8A4FFF;",
             div(
               class = "card-body",
-              h5(fa("calculator"), " ", i18n$t("Regression Models"), class = "card-title", style = "color: #2D2D42;"),
+              h5(phosphoricons::ph("calculator", weight = "bold"), " ", i18n$t("Regression Models"), class = "card-title", style = "color: #2D2D42;"),
               p(class = "card-text small", i18n$t("Build simple regression models for advanced analysis"))
             )
           )
@@ -164,7 +153,7 @@ landing_page_ui <- function(i18n) {
             style = "background: linear-gradient(135deg, #f5f7fa 0%, #c3cfe2 100%); border: none;",
             div(
               class = "card-body p-4",
-              h4(fa("download"), " ", i18n$t("Export & Learn"), class = "text-center mb-3", style = "color: #1E4A8F;"),
+              h4(phosphoricons::ph("book-bookmark", weight = "bold"), " ", i18n$t("Export & Learn"), class = "text-center mb-3", style = "color: #1E4A8F;"),
               div(
                 class = "row text-center",
                 div(

R/missings-module.R

@@ -19,7 +19,8 @@ data_missings_ui <- function(id, ...) {
         bslib::accordion_panel(
           value = "acc_pan_mis",
           title = "Settings",
-          icon = bsicons::bs_icon("gear"),
+          icon = phosphoricons::ph("gear"),
+          # icon = bsicons::bs_icon("gear"),
           shiny::conditionalPanel(
             condition = "output.missings == true",
             shiny::uiOutput(ns("missings_method")),
@@ -36,14 +37,16 @@ data_missings_ui <- function(id, ...) {
             inputId = ns("act_miss"),
             label = i18n$t("Evaluate"),
             width = "100%",
-            icon = shiny::icon("calculator"),
+            icon = phosphoricons::ph("calculator",weight = "bold"),
+            # icon = shiny::icon("calculator"),
             disabled = TRUE
           )
         ),
         do.call(bslib::accordion_panel, c(
           list(
             title = "Download",
-            icon = bsicons::bs_icon("file-earmark-arrow-down")
+            icon = phosphoricons::ph("download-simple")
+            # icon = bsicons::bs_icon("file-earmark-arrow-down")
           ),
           table_download_ui(id = ns("tbl_dwn"), title = NULL)
         ))

R/plot-download-module.R

@@ -39,7 +39,8 @@ plot_download_ui <- regression_ui <- function(id, ...) {
     shiny::downloadButton(
       outputId = ns("download_plot"),
       label = "Download plot",
-      icon = shiny::icon("download")
+      icon = phosphoricons::ph("arrow-fat-down")
+      # icon = shiny::icon("download")
     )
   )
 }

R/plot-helpers.R

@@ -0,0 +1,878 @@
+#' Implemented functions
+#'
+#' @description
+#' Library of supported functions. The list name and "descr" element should be
+#' unique for each element on list.
+#'
+#' -   fun: the plotting function
+#'
+#' -   fun.args: default parameters for the plotting function
+#'
+#' -   descr: Plot description
+#'
+#' -   note: Short note/description of the function for displaying in ui and docs
+#'
+#' -   primary.type: Primary variable data type (see [data_type])
+#'
+#' -   base: holds a list of parameters for plot input fields generation
+#'     Secondary and tertiary variable input fields are mandatory.
+#'
+#'
+#' @returns list
+#' @export
+#'
+#' @examples
+#' available_plots() |> str()
+available_plots <- function() {
+  list(
+    plot_bar_rel = list(
+      fun = "plot_bar",
+      fun.args = list(style = "fill"),
+      descr = i18n$t("Stacked relative barplot"),
+      note = i18n$t(
+        "Create relative stacked barplots to show the distribution of categorical levels"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = FALSE,
+          # inputId = "sec",
+          label = i18n$t("Additional variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_bar_abs = list(
+      fun = "plot_bar",
+      fun.args = list(style = "dodge"),
+      descr = i18n$t("Side-by-side barplot"),
+      note = i18n$t(
+        "Create side-by-side barplot to show the distribution of categorical levels"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = TRUE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_hbars = list(
+      fun = "plot_hbars",
+      descr = i18n$t("Stacked horizontal 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"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = TRUE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "reverse",
+          type = "select_input",
+          label = i18n$t("Reverse colors"),
+          choices = c(yes = TRUE, no = FALSE)
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_violin = list(
+      fun = "plot_violin",
+      descr = i18n$t("Violin plot"),
+      note = i18n$t(
+        "A modern alternative to the classic boxplot to visualise data distribution"
+      ),
+      primary.type = c("datatime", "continuous"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = TRUE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_sankey = list(
+      fun = "plot_sankey",
+      descr = i18n$t("Sankey plot"),
+      note = i18n$t("A way of visualising change between groups"),
+      primary.type = c("dichotomous", "categorical"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = FALSE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_scatter = list(
+      fun = "plot_scatter",
+      descr = i18n$t("Scatter plot"),
+      note = i18n$t("A classic way of showing the association between to variables"),
+      primary.type = c("datatime", "continuous"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("datatime", "continuous", "categorical"),
+          allow_none = FALSE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_box = list(
+      fun = "plot_box",
+      descr = i18n$t("Box plot"),
+      note = i18n$t("A classic way to plot data distribution by groups"),
+      primary.type = c("datatime", "continuous"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = TRUE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = FALSE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_euler = list(
+      fun = "plot_euler",
+      descr = i18n$t("Euler diagram"),
+      note = i18n$t(
+        "Generate area-proportional Euler diagrams to display set relationships"
+      ),
+      primary.type = c("dichotomous"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous"),
+          allow_none = FALSE,
+          # inputId = "sec",
+          label = i18n$t("Secondary variable"),
+          multiple = TRUE,
+          maxItems = 4
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    ),
+    plot_likert = list(
+      fun = "plot_likert",
+      descr = i18n$t("Likert diagram"),
+      note = i18n$t("Plot survey results"),
+      primary.type = c("dichotomous", "categorical"),
+      ### Input definitions ###
+      base = list(
+        list(
+          id = "secondary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          allow_none = TRUE,
+          # inputId = "sec",
+          label = i18n$t("Additional variables"),
+          multiple = TRUE
+        ),
+        list(
+          id = "tertiary",
+          type = "select_variables",
+          var_types = c("dichotomous", "categorical"),
+          # inputId = "sec",
+          label = i18n$t("Grouping variable"),
+          multiple = FALSE
+        )
+      ),
+      advanced = list()
+      #########
+    )
+  )
+}
+
+# Helper function to create input elements dynamically
+create_input_element <- function(params, ns, input_id) {
+  # Add the namespaced inputId to the arguments
+  params$inputId <- ns(input_id)
+
+  # Map input types to Shiny functions
+  input_function <- switch(
+    params$type,
+    "numeric_input" = shiny::numericInput,
+    "select_input" = shiny::selectInput,
+    "checkbox_input" = shiny::checkboxInput,
+    "slider_input" = shiny::sliderInput,
+    "text_input" = shiny::textInput,
+    "select_variables" = selectPlotVariables
+  )
+
+  params$type <- NULL
+  params$id <- NULL
+
+
+  # Call the function with all arguments
+  do.call(input_function, params)
+}
+
+#' Wrapper for columnSelectInput
+#'
+selectPlotVariables <- function(data,
+                                exclude = NULL,
+                                allow_none = TRUE,
+                                var_types,
+                                ...) {
+  datar <- if (is.reactive(data)) {
+    data
+  } else {
+    reactive(data)
+  }
+
+  cols <- all_but(colnames(subset_types(datar(), var_types)), exclude)
+
+  if (isTRUE(allow_none)) {
+    cols <- c("none", cols)
+  }
+
+  params <- list(...)
+
+  params$none_label <- i18n$t("No variable")
+  params$col_subset <- cols
+
+  rlang::exec(columnSelectInput, !!!append_list(datar(), params, "data"))
+}
+
+
+
+#' Select all from vector but
+#'
+#' @param data vector
+#' @param ... exclude
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' all_but(1:10, c(2, 3), 11, 5)
+all_but <- function(data, ...) {
+  data[!data %in% c(...)]
+}
+
+#' Easily subset by data type function
+#'
+#' @param data data
+#' @param types desired types
+#' @param type.fun function to get type. Default is outcome_type
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' default_parsing(mtcars) |> subset_types("ordinal")
+#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
+#' #' default_parsing(mtcars) |> subset_types("factor",class)
+subset_types <- function(data, types, type.fun = data_type) {
+  data[sapply(data, type.fun) %in% types]
+}
+
+
+#' Implemented functions
+#'
+#' @description
+#' Library of supported functions. The list name and "descr" element should be
+#' unique for each element on list.
+#'
+#' -   descr: Plot description
+#'
+#' -   primary.type: Primary variable data type (continuous, dichotomous or ordinal)
+#'
+#' -   secondary.type: Secondary variable data type (continuous, dichotomous or ordinal)
+#'
+#' -   secondary.extra: "none" or NULL to have option to choose none.
+#'
+#' -   tertiary.type: Tertiary variable data type (continuous, dichotomous or ordinal)
+#'
+#'
+#' @returns list
+#' @export
+#'
+#' @examples
+#' supported_plots() |> str()
+supported_plots <- function() {
+  list(
+    plot_bar_rel = list(
+      fun = "plot_bar",
+      fun.args = list(style = "fill"),
+      descr = i18n$t("Stacked relative barplot"),
+      note = i18n$t(
+        "Create relative stacked barplots to show the distribution of categorical levels"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = FALSE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
+    ),
+    plot_bar_abs = list(
+      fun = "plot_bar",
+      fun.args = list(style = "dodge"),
+      descr = i18n$t("Side-by-side barplot"),
+      note = i18n$t(
+        "Create side-by-side barplot to show the distribution of categorical levels"
+      ),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = FALSE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = "none"
+    ),
+    plot_hbars = list(
+      fun = "plot_hbars",
+      descr = i18n$t("Stacked horizontal 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,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = "none"
+    ),
+    plot_violin = list(
+      fun = "plot_violin",
+      descr = i18n$t("Violin plot"),
+      note = i18n$t(
+        "A modern alternative to the classic boxplot to visualise data distribution"
+      ),
+      primary.type = c("datatime", "continuous"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = FALSE,
+      secondary.extra = "none",
+      tertiary.type = c("dichotomous", "categorical")
+    ),
+    # plot_ridge = list(
+    #   descr = "Ridge plot",
+    #   note = "An alternative option to visualise data distribution",
+    #   primary.type = "continuous",
+    #   secondary.type = c("dichotomous" ,"categorical"),
+    #   tertiary.type = c("dichotomous" ,"categorical"),
+    #   secondary.extra = NULL
+    # ),
+    plot_sankey = list(
+      fun = "plot_sankey",
+      descr = i18n$t("Sankey plot"),
+      note = i18n$t("A way of visualising change between groups"),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = FALSE,
+      secondary.extra = NULL,
+      tertiary.type = c("dichotomous", "categorical")
+    ),
+    plot_scatter = list(
+      fun = "plot_scatter",
+      descr = i18n$t("Scatter plot"),
+      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,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
+    ),
+    plot_box = list(
+      fun = "plot_box",
+      descr = i18n$t("Box plot"),
+      note = i18n$t("A classic way to plot data distribution by groups"),
+      primary.type = c("datatime", "continuous"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = FALSE,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = "none"
+    ),
+    plot_euler = list(
+      fun = "plot_euler",
+      descr = i18n$t("Euler diagram"),
+      note = i18n$t(
+        "Generate area-proportional Euler diagrams to display set relationships"
+      ),
+      primary.type = c("dichotomous"),
+      secondary.type = c("dichotomous"),
+      secondary.multi = TRUE,
+      secondary.max = 4,
+      tertiary.type = c("dichotomous"),
+      secondary.extra = NULL
+    ),
+    plot_likert = list(
+      fun = "plot_likert",
+      descr = i18n$t("Likert diagram"),
+      note = i18n$t("Plot survey results"),
+      primary.type = c("dichotomous", "categorical"),
+      secondary.type = c("dichotomous", "categorical"),
+      secondary.multi = TRUE,
+      secondary.extra = NULL,
+      tertiary.type = c("dichotomous", "categorical"),
+      secondary.extra = NULL
+    )
+  )
+}
+
+#' Get possible regression models
+#'
+#' @param data data
+#'
+#' @returns character vector
+#' @export
+#'
+#' @examples
+#' mtcars |>
+#'   default_parsing() |>
+#'   dplyr::pull("cyl") |>
+#'   possible_plots()
+#'
+#' mtcars |>
+#'   default_parsing() |>
+#'   dplyr::select("mpg") |>
+#'   possible_plots()
+possible_plots <- function(data, source_list = supported_plots()) {
+  # browser()
+  # data <- if (is.reactive(data)) data() else data
+  if (is.data.frame(data)) {
+    data <- data[[1]]
+  }
+
+  type <- data_type(data)
+
+  if (type == "unknown") {
+    out <- type
+  } else {
+    out <- source_list |>
+      lapply(\(.x) {
+        if (type %in% .x$primary.type) {
+          .x$descr
+        }
+      }) |>
+      unlist()
+  }
+  unname(out)
+}
+
+#' Get the function options based on the selected function description
+#'
+#' @param data vector
+#'
+#' @returns list
+#' @export
+#'
+#' @examples
+#' ls <- mtcars |>
+#'   default_parsing() |>
+#'   dplyr::pull(mpg) |>
+#'   possible_plots() |>
+#'   (\(.x){
+#'     .x[[1]]
+#'   })() |>
+#'   get_plot_options()
+get_plot_options <- function(data) {
+  descrs <- supported_plots() |>
+    lapply(\(.x) {
+      .x$descr
+    }) |>
+    unlist()
+  supported_plots() |>
+    (\(.x) {
+      .x[match(data, descrs)]
+    })()
+}
+
+#' Get the function parameters based on the selected function description
+#'
+#' @param data vector
+#'
+#' @returns list
+#' @export
+#'
+#' @examples
+#' ls <- mtcars |>
+#'   default_parsing() |>
+#'   dplyr::pull(mpg) |>
+#'   possible_plots() |>
+#'   (\(.x){
+#'     .x[[1]]
+#'   })() |>
+#'   get_input_params()
+get_input_params <- function(data) {
+  descr <- available_plots() |>
+    lapply(\(.x) {
+      .x$descr
+    }) |>
+    unlist()
+  available_plots() |>
+    (\(.x) {
+      .x[match(data, descr)]
+    })()
+}
+
+
+#' Wrapper to create plot based on provided type
+#'
+#' @param data data.frame
+#' @param pri primary variable
+#' @param sec secondary variable
+#' @param ter tertiary variable
+#' @param type plot type (derived from possible_plots() and matches custom function)
+#' @param color.palette choose color palette. See \code{\link{plot_colors}} for support.
+#' @param ... ignored for now
+#'
+#' @name data-plots
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @examples
+#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
+create_plot <- function(data,
+                        type,
+                        pri,
+                        sec,
+                        ter = NULL,
+                        color.palette = "viridis",
+                        ...) {
+  if (!is.null(sec)) {
+    if (!any(sec %in% names(data))) {
+      sec <- NULL
+    }
+  }
+
+  if (!is.null(ter)) {
+    if (!ter %in% names(data)) {
+      ter <- NULL
+    }
+  }
+
+  parameters <- list(
+    pri = pri,
+    sec = sec,
+    ter = ter,
+    color.palette = color.palette,
+    ...
+  )
+
+  out <- do.call(type, modifyList(parameters, list(data = data)))
+
+  code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
+
+  attr(out, "code") <- code
+  out
+}
+
+#' Print label, and if missing print variable name for plots
+#'
+#' @param data vector or data frame
+#' @param var variable name. Optional.
+#'
+#' @returns character string
+#' @export
+#'
+#' @examples
+#' mtcars |> get_label(var = "mpg")
+#' mtcars |> get_label()
+#' mtcars$mpg |> get_label()
+#' gtsummary::trial |> get_label(var = "trt")
+#' gtsummary::trial$trt |> get_label()
+#' 1:10 |> get_label()
+get_label <- function(data, var = NULL) {
+  # data <- if (is.reactive(data)) data() else data
+  if (!is.null(var) & is.data.frame(data)) {
+    data <- data[[var]]
+  }
+  out <- REDCapCAST::get_attr(data = data, attr = "label")
+  if (is.na(out)) {
+    if (is.null(var)) {
+      out <- deparse(substitute(data))
+    } else {
+      if (is.symbol(var)) {
+        out <- gsub('\"', "", deparse(substitute(var)))
+      } else {
+        out <- var
+      }
+    }
+  }
+  out
+}
+
+
+#' Line breaking at given number of characters for nicely plotting labels
+#'
+#' @param data string
+#' @param lineLength maximum line length
+#' @param fixed flag to force split at exactly the value given in lineLength.
+#' Default is FALSE, only splitting at spaces.
+#'
+#' @returns character string
+#' @export
+#'
+#' @examples
+#' "Lorem ipsum... you know the routine" |> line_break()
+#' 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")
+  }
+  ## https://stackoverflow.com/a/29847221
+}
+
+
+#' Wrapping
+#'
+#' @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,
+                           title = NULL,
+                           axis.font.family = NULL,
+                           guides = "collect",
+                           axes = "collect",
+                           axis_titles = "collect",
+                           y.axis.percentage = FALSE,
+                           ...) {
+  if (ggplot2::is_ggplot(data[[1]])) {
+    if (length(data) > 1) {
+      out <- data |>
+        (\(.x) {
+          if (rlang::is_named(.x)) {
+            purrr::imap(.x, \(.y, .i) {
+              .y + ggplot2::ggtitle(.i)
+            })
+          } else {
+            .x
+          }
+        })() |>
+        align_axes(percentage = y.axis.percentage) |>
+        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[[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
+}
+
+
+#' Aligns axes between plots
+#'
+#' @param ... ggplot2 objects or list of ggplot2 objects
+#'
+#' @returns list of ggplot2 objects
+#' @export
+#'
+align_axes <- function(...,
+                       x.axis = TRUE,
+                       y.axis = TRUE,
+                       percentage = FALSE) {
+  # 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)) {
+    ## Assumes list of ggplots
+    p <- list(...)
+  } else if (is.list(..1)) {
+    ## Assumes list with list of ggplots
+    p <- ..1
+  } else {
+    cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
+  }
+
+  yr <- clean_common_axis(p, "y")
+
+  xr <- clean_common_axis(p, "x")
+
+  suppressWarnings({
+    p_out <- 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
+    })
+  })
+
+  if (isTRUE(percentage)) {
+    lapply(p_out, \(.x) {
+      .x +
+        ggplot2::scale_y_continuous(labels = scales::percent)
+    })
+  } else {
+    p_out
+  }
+}
+
+#' Extract and clean axis ranges
+#'
+#' @param p plot
+#' @param axis axis. x or y.
+#'
+#' @returns vector
+#' @export
+#'
+clean_common_axis <- function(p, axis) {
+  purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
+    unlist() |>
+    (\(.x) {
+      if (is.numeric(.x)) {
+        range(.x)
+      } else {
+        as.character(.x)
+      }
+    })() |>
+    unique()
+}

R/plot_bar.R

@@ -1,5 +1,29 @@
-plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"),
+#' Title
-                     color.palette = "viridis", max_level = 30, ...) {
+#'
+#' @name data-plots
+#'
+#' @param style barplot style passed to geom_bar position argument.
+#' One of c("stack", "dodge", "fill")
+#'
+#' @returns ggplot list object
+#' @export
+#'
+#' @examples
+#' mtcars |>
+#'   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
+#'   plot_bar(pri = "cyl", sec = "am", style = "fill")
+#'
+#' mtcars |>
+#'   dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
+#'   plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
+plot_bar <- function(data,
+                     pri,
+                     sec = NULL,
+                     ter = NULL,
+                     style = c("stack", "dodge", "fill"),
+                     color.palette = "viridis",
+                     max_level = 30,
+                     ...) {
   style <- match.arg(style)
 
   if (!is.null(ter)) {
@@ -15,11 +39,14 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
       sec = sec,
       style = style,
       max_level = max_level,
-      color.palette = color.palette
+      color.palette = color.palette,
+      ...
     )
   })
 
-  wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...)
+  wrap_plot_list(out,
+                 title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
+                 y.axis.percentage = TRUE)
 }
 
 
@@ -41,7 +68,11 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
 #' mtcars |>
 #'   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
 #'   plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
-plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30,
+plot_bar_single <- function(data,
+                            pri,
+                            sec = NULL,
+                            style = c("stack", "dodge", "fill"),
+                            max_level = 30,
                             color.palette = "viridis") {
   style <- match.arg(style)
 
@@ -51,35 +82,12 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
 
   p_data <- as.data.frame(table(data[c(pri, sec)])) |>
     dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
-      p = Freq / NROW(data)
+                  p = Freq / NROW(data))
-    )
 
 
   if (nrow(p_data) > max_level) {
-    # browser()
+    p_data <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |>
-    p_data <- sort_by(
-      p_data,
-      p_data[["Freq"]],
-      decreasing = TRUE
-    ) |>
       head(max_level)
-    # if (is.null(sec)){
-    #   p_data <- sort_by(
-    #     p_data,
-    #     p_data[["Freq"]],
-    #     decreasing=TRUE) |>
-    #     head(max_level)
-    # } else {
-    #   split(p_data,p_data[[sec]]) |>
-    #     lapply(\(.x){
-    #       # browser()
-    #     sort_by(
-    #       .x,
-    #       .x[["Freq"]],
-    #       decreasing=TRUE) |>
-    #       head(max_level)
-    #   }) |> dplyr::bind_rows()
-    # }
   }
 
   ## Shortens long level names
@@ -91,39 +99,31 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
     fill <- pri
   }
 
-  p <- ggplot2::ggplot(
+  p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) +
-    p_data,
-    ggplot2::aes(
-      x = .data[[pri]],
-      y = p,
-      fill = .data[[fill]]
-    )
-  ) +
     ggplot2::geom_bar(position = style, stat = "identity") +
-    ggplot2::scale_y_continuous(labels = scales::percent) +
     scale_fill_generate(palette = color.palette)  +
-    ggplot2::ylab("Percentage") +
     ggplot2::xlab(get_label(data, pri)) +
     ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill)))
 
   ## To handle large number of levels and long level names
 
-  if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) {
+  if (nrow(p_data) > 10 |
+      any(nchar(as.character(p_data[[pri]])) > 6)) {
     p <- p +
       # ggplot2::guides(fill = "none") +
-      ggplot2::theme(
+      ggplot2::theme(axis.text.x = ggplot2::element_text(
-        axis.text.x = ggplot2::element_text(
         angle = 90,
-          vjust = 1, hjust = 1
+        vjust = 1,
+        hjust = 1
       )) +
-      ggplot2::theme(
+      ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 0.5))
-        axis.text.x = ggplot2::element_text(vjust = 0.5)
-      )
 
     if (is.null(sec)) {
       p <- p +
         ggplot2::guides(fill = "none")
     }
   }
-  p
+  p +
+    ggplot2::scale_y_continuous(labels = scales::percent) +
+    ggplot2::ylab("Percentage")
 }

R/plot_box.R

@@ -32,11 +32,11 @@ plot_box <- function(data, pri, sec, ter = NULL,color.palette="viridis",...) {
       data = .ds,
       pri = pri,
       sec = sec,
-      color.palette=color.palette
+      color.palette=color.palette, ...
     )
   })
 
-  wrap_plot_list(out,title=glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),...)
+  wrap_plot_list(out,title=glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
 }
 
 

R/plot_euler.R

@@ -131,7 +131,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103,color.palette="vi
 #'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 #' ) |> plot_euler_single()
 #' mtcars[c("vs", "am")] |> plot_euler_single("magma")
-plot_euler_single <- function(data,color.palette="viridis") {
+plot_euler_single <- function(data,color.palette="viridis", ...) {
 
   data |>
     ggeulerr(shape = "circle") +

R/plot_hbar.R

@@ -10,18 +10,20 @@
 #' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues")
 #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma")
-#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis")
+#' mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis")
 plot_hbars <- function(data,
                        pri,
                        sec,
                        ter = NULL,
-                       color.palette = "viridis") {
+                       color.palette = "viridis",
+                       ...) {
   vertical_stacked_bars(
     data = data,
     score = pri,
     group = sec,
     strata = ter,
-    color.palette = color.palette
+    color.palette = color.palette,
+    ...
   )
 }
 
@@ -41,7 +43,7 @@ vertical_stacked_bars <- function(data,
                                   score = "full_score",
                                   group = "pase_0_q",
                                   strata = NULL,
-                                  t.size = 10,
+                                  t.size = 8,
                                   l.color = "black",
                                   l.size = .5,
                                   draw.lines = TRUE,
@@ -74,15 +76,15 @@ vertical_stacked_bars <- function(data,
 
   colors <- generate_colors(n = nrow(df.table), palette = color.palette)
   ## Colors are reversed by default as that usually gives the best result
-  if (isTRUE(reverse)) {
+  if (isTRUE(reverse) | reverse=="TRUE") {
     colors <- rev(colors)
   }
-  contrast_cut <-
-    contrast_text(colors, threshold = .3) == "white"
 
   score_label <- data |> get_label(var = score)
   group_label <- data |> get_label(var = group)
 
+  # browser()
+
   p |>
     (\(.x) {
       .x$plot +
@@ -94,7 +96,7 @@ vertical_stacked_bars <- function(data,
           ggplot2::aes(
             x = group,
             y = p_prev + 0.49 * p,
-            color = contrast_cut,
+            color = contrast_text(colors[as.numeric(score)], threshold = .3),
             # label = paste0(sprintf("%2.0f", 100 * p),"%"),
             # label = sprintf("%2.0f", 100 * p)
             label = glue::glue(label.str)
@@ -103,8 +105,7 @@ vertical_stacked_bars <- function(data,
         ggplot2::labs(fill = score_label) +
         ggplot2::scale_fill_manual(values = colors) +
         ggplot2::theme(legend.position = "bottom",
-                       axis.title = ggplot2::element_text(),
+                       axis.title = ggplot2::element_text(),) +
-        ) +
         ggplot2::xlab(group_label) +
         ggplot2::ylab(NULL)
     })()

R/plot_likert.R

@@ -15,24 +15,31 @@ plot_likert <- function(data,
                         pri,
                         sec = NULL,
                         ter = NULL,
-                        color.palette = "viridis") {
+                        color.palette = "viridis",
+                        ...) {
   if (!is.null(ter)) {
     ds <- split(data, data[ter])
   } else {
     ds <- list(data)
   }
   out <- lapply(ds, \(.x) {
-    .x[c(pri, sec)] |>
+    plot_likert_single(
-      # na.omit() |>
+      data = .x,
-      plot_likert_single(color.palette = color.palette)
+      include = tidyselect::any_of(c(pri, sec)),
+      color.palette = color.palette
+    )
   })
 
   wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
 }
 
 
-plot_likert_single <- function(data, color.palette = "viridis") {
+plot_likert_single <- function(data,
-  ggstats::gglikert(data = data) +
+                               include = dplyr::everything(),
+                               color.palette = "viridis") {
+  data |>
+    dplyr::as_tibble() |>
+    ggstats::gglikert(include = include) +
     scale_fill_generate(palette = color.palette) +
     ggplot2::theme(
       # legend.position = "none",

R/plot_sankey.R

@@ -95,7 +95,8 @@ plot_sankey <- function(data,
                         default.color = "#2986cc",
                         box.color = "#1E4B66",
                         na.color = "grey80",
-                        missing.level = "Missing") {
+                        missing.level = "Missing",
+                        ...) {
   if (!is.null(ter)) {
     ds <- split(data, data[ter])
   } else {

R/plot_scatter.R

@@ -8,7 +8,7 @@
 #' @examples
 #' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
 #' mtcars |> plot_scatter(pri = "mpg", sec = "wt",ter="carb")
-plot_scatter <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
+plot_scatter <- function(data, pri, sec, ter = NULL, color.palette="viridis", ...) {
   if (is.null(ter)) {
     rempsyc::nice_scatter(
       data = data,

R/plot_violin.R

@@ -8,7 +8,7 @@
 #' @examples
 #' mtcars |> plot_violin(pri = "mpg", sec = "cyl")
 #' mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear", color.palette="Blues")
-plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
+plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis", ...) {
   if (!is.null(ter)) {
     ds <- split(data, data[ter])
   } else {
@@ -23,7 +23,8 @@ plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
         group = sec,
         response = pri,
         xtitle = get_label(data, var = sec),
-        ytitle = get_label(data, var = pri)
+        ytitle = get_label(data, var = pri),
+        ...
       )+
         scale_fill_generate(palette=color.palette)
     })

R/redcap_read_shiny_module.R

@@ -43,7 +43,8 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
     shiny::actionButton(
       inputId = ns("data_connect"),
       label = i18n$t("Connect"),
-      icon = shiny::icon("link", lib = "glyphicon"),
+      icon = phosphoricons::ph("link",weight = "bold"),
+      # icon = shiny::icon("link", lib = "glyphicon"),
       width = "100%",
       disabled = TRUE
     ),
@@ -99,7 +100,8 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
           shinyWidgets::dropMenu(
             shiny::actionButton(
               inputId = ns("dropdown_params"),
-              label = shiny::icon("filter"),
+              label = phosphoricons::ph("funnel",weight = "bold"),
+              # label = shiny::icon("filter"),
               width = "50px"
             ),
             filter_ui
@@ -118,7 +120,8 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
       shiny::actionButton(
         inputId = ns("data_import"),
         label = i18n$t("Import"),
-        icon = shiny::icon("download", lib = "glyphicon"),
+        icon = phosphoricons::ph("download-simple",weight = "bold"),
+        # icon = shiny::icon("download", lib = "glyphicon"),
         width = "100%",
         disabled = TRUE
       ),

R/regression-module.R

@@ -57,7 +57,8 @@ regression_ui <- function(id, ...) {
             bslib::accordion_panel(
               value = "acc_pan_reg",
               title = i18n$t("Regression"),
-              icon = bsicons::bs_icon("calculator"),
+              icon = phosphoricons::ph("calculator"),
+              # icon = bsicons::bs_icon("calculator"),
               shiny::uiOutput(outputId = ns("outcome_var")),
               # shiny::selectInput(
               #   inputId = "design",
@@ -91,7 +92,8 @@ regression_ui <- function(id, ...) {
               bslib::input_task_button(
                 id = ns("load"),
                 label = i18n$t("Analyse"),
-                icon = bsicons::bs_icon("pencil"),
+                icon = phosphoricons::ph("math-operations"),
+                # icon = bsicons::bs_icon("pencil"),
                 label_busy = i18n$t("Working..."),
                 icon_busy = fontawesome::fa_i("arrows-rotate",
                   class = "fa-spin",
@@ -136,7 +138,8 @@ regression_ui <- function(id, ...) {
                 list(
                   value = "acc_pan_coef_plot",
                   title = "Coefficients plot",
-                  icon = bsicons::bs_icon("bar-chart-steps"),
+                  icon = phosphoricons::ph("chart-bar-horizontal"),
+                  # icon = bsicons::bs_icon("bar-chart-steps"),
                   shiny::tags$br(),
                   shiny::uiOutput(outputId = ns("plot_model"))
                 ),
@@ -179,7 +182,8 @@ regression_ui <- function(id, ...) {
                   shiny::downloadButton(
                     outputId = ns("download_plot"),
                     label = i18n$t("Download plot"),
-                    icon = shiny::icon("download")
+                    icon = phosphoricons::ph("arrow-fat-down")
+                    # icon = shiny::icon("download")
                   )
                 )
               )
@@ -200,7 +204,8 @@ regression_ui <- function(id, ...) {
             bslib::accordion_panel(
               value = "acc_pan_checks",
               title = "Checks",
-              icon = bsicons::bs_icon("clipboard-check"),
+              icon = phosphoricons::ph("checks"),
+              # icon = bsicons::bs_icon("clipboard-check"),
               shiny::uiOutput(outputId = ns("plot_checks"))
             )
           )

R/separate_string.R

@@ -50,7 +50,7 @@ string_split_ui <- function(id) {
     ),
     actionButton(
       inputId = ns("create"),
-      label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")),
+      label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")),
       class = "btn-outline-primary float-end"
     ),
     tags$div(class = "clearfix")

R/table-download-module.R

@@ -37,7 +37,8 @@ table_download_server <- function(id, data, file_name = "table", ...) {
           shiny::downloadButton(
             outputId = ns("act_table"),
             label = i18n$t("Download table"),
-            icon = shiny::icon("download")
+            icon = phosphoricons::ph("arrow-fat-down")
+            # icon = shiny::icon("download")
           )
         } else {
           # Return NULL to show nothing

R/ui_elements.R

@@ -15,7 +15,8 @@ ui_elements <- function(selection) {
     "home" = bslib::nav_panel(
       title = "FreesearchR",
       # title = shiny::div(htmltools::img(src="FreesearchR-logo-white-nobg-h80.png")),
-      icon = shiny::icon("house"),
+      icon = phosphoricons::ph("house", weight = "bold"),
+      # icon = shiny::icon("house"),
       shiny::fluidRow(
         # "The browser language is",
         # textOutput("your_lang"),
@@ -45,7 +46,8 @@ ui_elements <- function(selection) {
     ##############################################################################
     "import" = bslib::nav_panel(
       title = i18n$t("Get started"),
-      icon = shiny::icon("play"),
+      icon = phosphoricons::ph("play", weight = "bold"),
+      # icon = shiny::icon("play"),
       value = "nav_import",
       shiny::fluidRow(
         shiny::column(width = 2),
@@ -122,7 +124,8 @@ ui_elements <- function(selection) {
               inputId = "modal_initial_view",
               label = i18n$t("Quick overview"),
               width = "100%",
-              icon = shiny::icon("binoculars"),
+              icon = phosphoricons::ph("binoculars",weight = "bold"),
+              # icon = shiny::icon("binoculars"),
               disabled = FALSE
             ),
             shiny::br(),
@@ -166,7 +169,8 @@ ui_elements <- function(selection) {
               inputId = "act_start",
               label = i18n$t("Let's begin!"),
               width = "100%",
-              icon = shiny::icon("play"),
+              icon = phosphoricons::ph("play",weight = "bold"),
+              # icon = shiny::icon("play"),
               disabled = TRUE
             ),
             shiny::br(),
@@ -185,11 +189,13 @@ ui_elements <- function(selection) {
     ##############################################################################
     "prepare" = bslib::nav_menu(
       title = i18n$t("Prepare"),
-      icon = shiny::icon("pen-to-square"),
+      icon = phosphoricons::ph("note-pencil", weight = "bold"),
+      # icon = shiny::icon("pen-to-square"),
       value = "nav_prepare",
       bslib::nav_panel(
         title = i18n$t("Overview and filter"),
-        icon = shiny::icon("eye"),
+        icon = phosphoricons::ph("eye"),
+        # icon = shiny::icon("eye"),
         value = "nav_prepare_overview",
         tags$h3(i18n$t("Overview and filtering")),
         fluidRow(
@@ -241,7 +247,7 @@ ui_elements <- function(selection) {
               "Read more on how ",
               tags$a(
                 "data types",
-                href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
+                href = "https://freesearchr.github.io/FreesearchR-knowledge/app/data_types.html",
                 target = "_blank",
                 rel = "noopener noreferrer"
               ),
@@ -264,7 +270,8 @@ ui_elements <- function(selection) {
       ),
       bslib::nav_panel(
         title = i18n$t("Edit and create data"),
-        icon = shiny::icon("file-pen"),
+        icon = phosphoricons::ph("pencil-line"),
+        # icon = shiny::icon("file-pen"),
         tags$h3(i18n$t("Subset, rename and convert variables")),
         fluidRow(shiny::column(
           width = 9, shiny::tags$p(
@@ -293,13 +300,13 @@ ui_elements <- function(selection) {
             width = 3,
             shiny::actionButton(
               inputId = "modal_update",
-              label = i18n$t("Modify factor levels"),
+              label = i18n$t("Modify factor"),
               width = "100%"
             ),
             shiny::tags$br(),
-            shiny::helpText(
+            shiny::helpText(i18n$t(
-              i18n$t("Reorder or rename the levels of factor/categorical variables.")
+              "Modify the levels of factor/categorical variables."
-            ),
+            )),
             shiny::tags$br(),
             shiny::tags$br()
           ),
@@ -312,9 +319,7 @@ ui_elements <- function(selection) {
             ),
             shiny::tags$br(),
             shiny::helpText(
-              i18n$t(
+              i18n$t("Create factor/categorical variable from other variables.")
-                "Create factor/categorical variable from a continous variable (number/date/time)."
-              )
             ),
             shiny::tags$br(),
             shiny::tags$br()
@@ -391,14 +396,16 @@ ui_elements <- function(selection) {
     "describe" =
       bslib::nav_menu(
         title = i18n$t("Evaluate"),
-        icon = shiny::icon("magnifying-glass-chart"),
+        icon = phosphoricons::ph("magnifying-glass", weight = "bold"),
+        # icon = shiny::icon("magnifying-glass-chart"),
         value = "nav_describe",
         # id = "navdescribe",
         # bslib::navset_bar(
         #   title = "",
         bslib::nav_panel(
           title = i18n$t("Characteristics"),
-          icon = bsicons::bs_icon("table"),
+          icon = phosphoricons::ph("table"),
+          # icon = bsicons::bs_icon("table"),
           bslib::layout_sidebar(
             sidebar = bslib::sidebar(
               shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
@@ -410,7 +417,8 @@ ui_elements <- function(selection) {
                   open = TRUE,
                   value = "acc_pan_chars",
                   title = "Settings",
-                  icon = bsicons::bs_icon("table"),
+                  icon = phosphoricons::ph("table"),
+                  # icon = bsicons::bs_icon("table"),
                   # vectorSelectInput(
                   #   inputId = "baseline_theme",
                   #   selected = "none",
@@ -452,7 +460,8 @@ ui_elements <- function(selection) {
                     inputId = "act_eval",
                     label = i18n$t("Evaluate"),
                     width = "100%",
-                    icon = shiny::icon("calculator"),
+                    icon = phosphoricons::ph("calculator",weight = "bold"),
+                    # icon = shiny::icon("calculator"),
                     disabled = TRUE
                   ),
                   shiny::helpText(i18n$t(
@@ -466,7 +475,8 @@ ui_elements <- function(selection) {
         ),
         bslib::nav_panel(
           title = i18n$t("Correlations"),
-          icon = bsicons::bs_icon("bounding-box"),
+          icon = phosphoricons::ph("graph"),
+          # icon = bsicons::bs_icon("bounding-box"),
           bslib::layout_sidebar(
             sidebar = bslib::sidebar(
               # shiny::uiOutput(outputId = "data_info_nochar", inline = TRUE),
@@ -507,7 +517,8 @@ ui_elements <- function(selection) {
         do.call(bslib::nav_panel, c(
           list(
             title = i18n$t("Missings"),
-            icon = bsicons::bs_icon("x-circle")
+            icon = phosphoricons::ph("placeholder")
+            # icon = bsicons::bs_icon("x-circle")
           ),
           data_missings_ui(id = "missingness", validation_ui("validation_mcar"))
         ))
@@ -522,7 +533,8 @@ ui_elements <- function(selection) {
       c(
         list(
           title = i18n$t("Visuals"),
-          icon = shiny::icon("chart-line"),
+          icon = phosphoricons::ph("chart-line", weight = "bold"),
+          # icon = shiny::icon("chart-line"),
           value = "nav_visuals"
         ),
         data_visuals_ui("visuals")
@@ -543,7 +555,8 @@ ui_elements <- function(selection) {
     "analyze" =
       bslib::nav_panel(
         title = i18n$t("Regression"),
-        icon = shiny::icon("calculator"),
+        icon = phosphoricons::ph("calculator", weight = "bold"),
+        # icon = shiny::icon("calculator"),
         value = "nav_analyses",
         do.call(bslib::navset_card_tab, regression_ui("regression"))
       ),
@@ -555,7 +568,8 @@ ui_elements <- function(selection) {
     "download" =
       bslib::nav_panel(
         title = i18n$t("Download"),
-        icon = shiny::icon("download"),
+        icon = phosphoricons::ph("download-simple", weight = "bold"),
+        # icon = shiny::icon("download"),
         value = "nav_download",
         shiny::fluidRow(
           shiny::column(width = 2),
@@ -591,7 +605,8 @@ ui_elements <- function(selection) {
                 shiny::downloadButton(
                   outputId = "report",
                   label = "Download report",
-                  icon = shiny::icon("download")
+                  icon = phosphoricons::ph("arrow-fat-down")
+                  # icon = shiny::icon("download")
                 ),
                 shiny::br()
                 # 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."),
@@ -621,7 +636,8 @@ ui_elements <- function(selection) {
                 shiny::downloadButton(
                   outputId = "data_modified",
                   label = "Download data",
-                  icon = shiny::icon("download")
+                  icon = phosphoricons::ph("arrow-fat-down")
+                  # icon = shiny::icon("download")
                 )
               )
             ),
@@ -678,7 +694,7 @@ ui_elements <- function(selection) {
     "docs" = bslib::nav_item(
       # shiny::img(shiny::icon("book")),
       shiny::tags$a(
-        href = "https://agdamsbo.github.io/FreesearchR/",
+        href = "https://freesearchr.github.io/FreesearchR-knowledge/",
         "Docs",
         shiny::icon("arrow-up-right-from-square"),
         target = "_blank",

R/update-factor-ext.R

@@ -44,7 +44,7 @@ update_factor_ui <- function(id) {
         actionButton(
           disabled = TRUE,
           inputId = ns("drop_levels"),
-          label = tagList(phosphoricons::ph("sort-ascending"), i18n$t("Drop empty")),
+          label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")),
           class = "btn-outline-primary mb-3",
           width = "100%"
         )
@@ -55,7 +55,7 @@ update_factor_ui <- function(id) {
         actionButton(
           inputId = ns("sort_levels"),
           label = tagList(
-            phosphoricons::ph("sort-ascending"),
+            phosphoricons::ph("sort-ascending",weight = "bold"),
             i18n$t("Sort by levels")
           ),
           class = "btn-outline-primary mb-3",
@@ -68,7 +68,7 @@ update_factor_ui <- function(id) {
         actionButton(
           inputId = ns("sort_occurrences"),
           label = tagList(
-            phosphoricons::ph("sort-ascending"),
+            phosphoricons::ph("sort-ascending",weight = "bold"),
             i18n$t("Sort by count")
           ),
           class = "btn-outline-primary mb-3",
@@ -92,7 +92,7 @@ update_factor_ui <- function(id) {
       actionButton(
         inputId = ns("create"),
         label = tagList(
-          phosphoricons::ph("arrow-clockwise"),
+          phosphoricons::ph("arrow-clockwise",weight = "bold"),
           i18n$t("Update factor variable")
         ),
         class = "btn-outline-primary"

R/update-variables-ext.R

@@ -30,7 +30,7 @@ update_variables_ui <- function(id, title = "") {
             placement = "bottom-end",
             shiny::actionButton(
               inputId = ns("settings"),
-              label = phosphoricons::ph("gear"),
+              label = phosphoricons::ph("gear",weight = "bold"),
               class = "pull-right float-right"
             ),
             shinyWidgets::textInputIcon(
@@ -75,7 +75,7 @@ update_variables_ui <- function(id, title = "") {
     shiny::actionButton(
       inputId = ns("validate"),
       label = htmltools::tagList(
-        phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes")),
+        phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"),
         i18n$t("Apply changes")
       ),
       width = "100%"

SESSION.md

@@ -2,20 +2,20 @@
 -------------------------------- R environment ---------------------------------
 --------------------------------------------------------------------------------
 |setting     |value                                                                                              |
-|:-----------|:------------------------------------------|
+|:-----------|:--------------------------------------------------------------------------------------------------|
 |version     |R version 4.5.2 (2025-10-31)                                                                       |
-|os          |macOS Tahoe 26.3                           |
+|os          |macOS Tahoe 26.5                                                                                   |
 |system      |aarch64, darwin20                                                                                  |
 |ui          |RStudio                                                                                            |
 |language    |(EN)                                                                                               |
 |collate     |en_US.UTF-8                                                                                        |
 |ctype       |en_US.UTF-8                                                                                        |
 |tz          |Europe/Copenhagen                                                                                  |
-|date        |2026-03-30                                 |
+|date        |2026-06-01                                                                                         |
-|rstudio     |2026.01.1+403 Apple Blossom (desktop)      |
+|rstudio     |2026.04.0+526 Globemaster Allium (desktop)                                                         |
-|pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
+|pandoc      |3.8.3 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/aarch64/ (via rmarkdown) |
-|quarto      |1.7.30 @ /usr/local/bin/quarto             |
+|quarto      |1.9.37 @ /usr/local/bin/quarto                                                                     |
-|FreesearchR |26.3.5.260330                              |
+|FreesearchR |26.6.1.260601                                                                                      |
                                                                                 
                                                                                 
 --------------------------------------------------------------------------------
@@ -26,6 +26,8 @@
 |apexcharter       |0.4.5         |2026-01-07 |CRAN (R 4.5.2) |
 |askpass           |1.2.1         |2024-10-04 |CRAN (R 4.5.0) |
 |assertthat        |0.2.1         |2019-03-21 |CRAN (R 4.5.0) |
+|attachment        |0.4.5         |2025-03-14 |CRAN (R 4.5.0) |
+|attempt           |0.3.1         |2020-05-03 |CRAN (R 4.5.0) |
 |backports         |1.5.0         |2024-05-23 |CRAN (R 4.5.0) |
 |base64enc         |0.1-6         |2026-02-02 |CRAN (R 4.5.2) |
 |bayestestR        |0.17.0        |2025-08-29 |CRAN (R 4.5.0) |
@@ -44,6 +46,7 @@
 |cardx             |0.3.2         |2026-02-05 |CRAN (R 4.5.2) |
 |caTools           |1.18.3        |2024-09-04 |CRAN (R 4.5.0) |
 |cellranger        |1.1.0         |2016-07-27 |CRAN (R 4.5.0) |
+|cffr              |1.2.1         |2026-01-12 |CRAN (R 4.5.2) |
 |checkmate         |2.3.4         |2026-02-03 |CRAN (R 4.5.2) |
 |class             |7.3-23        |2025-01-01 |CRAN (R 4.5.0) |
 |classInt          |0.4-11        |2025-01-08 |CRAN (R 4.5.0) |
@@ -53,7 +56,6 @@
 |colorspace        |2.1-2         |2025-09-22 |CRAN (R 4.5.0) |
 |commonmark        |2.0.0         |2025-07-07 |CRAN (R 4.5.0) |
 |crayon            |1.5.3         |2024-06-20 |CRAN (R 4.5.0) |
-|curl              |7.0.0         |2025-08-19 |CRAN (R 4.5.0) |
 |data.table        |1.18.2.1      |2026-01-27 |CRAN (R 4.5.2) |
 |datamods          |1.5.3         |2024-10-02 |CRAN (R 4.5.0) |
 |datawizard        |1.3.0         |2025-10-11 |CRAN (R 4.5.0) |
@@ -62,6 +64,7 @@
 |devtools          |2.4.6         |2025-10-03 |CRAN (R 4.5.0) |
 |DHARMa            |0.4.7         |2024-10-18 |CRAN (R 4.5.0) |
 |digest            |0.6.39        |2025-11-19 |CRAN (R 4.5.2) |
+|dockerfiler       |0.2.5         |2025-05-07 |CRAN (R 4.5.0) |
 |doParallel        |1.0.17        |2022-02-07 |CRAN (R 4.5.0) |
 |dplyr             |1.2.0         |2026-02-03 |CRAN (R 4.5.2) |
 |DT                |0.34.0        |2025-09-02 |CRAN (R 4.5.0) |
@@ -84,7 +87,7 @@
 |foreach           |1.5.2         |2022-02-02 |CRAN (R 4.5.0) |
 |foreign           |0.8-91        |2026-01-29 |CRAN (R 4.5.2) |
 |Formula           |1.2-5         |2023-02-24 |CRAN (R 4.5.0) |
-|FreesearchR       |26.3.5        |NA         |NA             |
+|FreesearchR       |26.6.1        |NA         |NA             |
 |fs                |1.6.7         |2026-03-06 |CRAN (R 4.5.2) |
 |gdtools           |0.5.0         |2026-02-09 |CRAN (R 4.5.2) |
 |generics          |0.1.4         |2025-05-09 |CRAN (R 4.5.0) |
@@ -94,7 +97,7 @@
 |ggplot2           |4.0.2         |2026-02-03 |CRAN (R 4.5.2) |
 |ggridges          |0.5.7         |2025-08-27 |CRAN (R 4.5.0) |
 |ggstats           |0.13.0        |2026-03-06 |CRAN (R 4.5.2) |
-|glue              |1.8.0         |2024-09-30 |CRAN (R 4.5.0) |
+|glue              |1.8.0         |2024-09-30 |CRAN (R 4.5.2) |
 |gridExtra         |2.3           |2017-09-09 |CRAN (R 4.5.0) |
 |gt                |1.3.0         |2026-01-22 |CRAN (R 4.5.2) |
 |gtable            |0.3.6         |2024-10-25 |CRAN (R 4.5.0) |
@@ -107,7 +110,6 @@
 |htmltools         |0.5.9         |2025-12-04 |CRAN (R 4.5.2) |
 |htmlwidgets       |1.6.4         |2023-12-06 |CRAN (R 4.5.0) |
 |httpuv            |1.6.16        |2025-04-16 |CRAN (R 4.5.0) |
-|httr              |1.4.8         |2026-02-13 |CRAN (R 4.5.2) |
 |IDEAFilter        |0.2.1         |2025-07-29 |CRAN (R 4.5.0) |
 |insight           |1.4.6         |2026-02-04 |CRAN (R 4.5.2) |
 |iterators         |1.0.14        |2022-02-05 |CRAN (R 4.5.0) |
@@ -117,7 +119,6 @@
 |keyring           |1.4.1         |2025-06-15 |CRAN (R 4.5.0) |
 |knitr             |1.51          |2025-12-20 |CRAN (R 4.5.2) |
 |labeling          |0.4.3         |2023-08-29 |CRAN (R 4.5.0) |
-|labelled          |2.16.0        |2025-10-22 |CRAN (R 4.5.0) |
 |later             |1.4.8         |2026-03-05 |CRAN (R 4.5.2) |
 |lattice           |0.22-7        |2025-04-02 |CRAN (R 4.5.2) |
 |lifecycle         |1.0.5         |2026-01-08 |CRAN (R 4.5.2) |
@@ -127,6 +128,7 @@
 |MASS              |7.3-65        |2025-02-28 |CRAN (R 4.5.0) |
 |Matrix            |1.7-4         |2025-08-28 |CRAN (R 4.5.0) |
 |memoise           |2.0.1         |2021-11-26 |CRAN (R 4.5.0) |
+|mgcv              |1.9-4         |2025-11-07 |CRAN (R 4.5.0) |
 |mime              |0.13          |2025-03-17 |CRAN (R 4.5.0) |
 |minqa             |1.2.8         |2024-08-17 |CRAN (R 4.5.0) |
 |mvtnorm           |1.3-2         |2024-11-04 |CRAN (R 4.5.2) |
@@ -139,6 +141,7 @@
 |openssl           |2.3.5         |2026-02-26 |CRAN (R 4.5.2) |
 |openxlsx2         |1.25          |2026-03-07 |CRAN (R 4.5.2) |
 |otel              |0.2.0         |2025-08-29 |CRAN (R 4.5.0) |
+|pak               |0.9.2         |2025-12-22 |CRAN (R 4.5.2) |
 |parameters        |0.28.3        |2025-11-25 |CRAN (R 4.5.2) |
 |patchwork         |1.3.2         |2025-08-25 |CRAN (R 4.5.0) |
 |pbmcapply         |1.5.1         |2022-04-28 |CRAN (R 4.5.0) |
@@ -150,6 +153,7 @@
 |pkgload           |1.5.0         |2026-02-03 |CRAN (R 4.5.2) |
 |plyr              |1.8.9         |2023-10-02 |CRAN (R 4.5.0) |
 |polyclip          |1.10-7        |2024-07-23 |CRAN (R 4.5.0) |
+|polylabelr        |1.0.0         |2026-01-19 |CRAN (R 4.5.2) |
 |pracma            |2.4.6         |2025-10-22 |CRAN (R 4.5.0) |
 |processx          |3.8.6         |2025-02-21 |CRAN (R 4.5.0) |
 |promises          |1.5.0         |2025-11-01 |CRAN (R 4.5.0) |
@@ -194,6 +198,7 @@
 |sessioninfo       |1.2.3         |2025-02-05 |CRAN (R 4.5.0) |
 |shiny             |1.13.0        |2026-02-20 |CRAN (R 4.5.2) |
 |shiny.i18n        |0.3.0         |2023-01-16 |CRAN (R 4.5.0) |
+|shiny2docker      |0.0.3         |2025-06-28 |CRAN (R 4.5.0) |
 |shinybusy         |0.3.3         |2024-03-09 |CRAN (R 4.5.0) |
 |shinyjs           |2.1.1         |2026-01-15 |CRAN (R 4.5.2) |
 |shinyTime         |1.0.3         |2022-08-19 |CRAN (R 4.5.0) |
@@ -226,4 +231,5 @@
 |xml2              |1.5.2         |2026-01-17 |CRAN (R 4.5.2) |
 |xtable            |1.8-8         |2026-02-22 |CRAN (R 4.5.2) |
 |yaml              |2.3.12        |2025-12-10 |CRAN (R 4.5.2) |
+|yesno             |0.1.3         |2024-07-26 |CRAN (R 4.5.0) |
 |zip               |2.3.3         |2025-05-13 |CRAN (R 4.5.0) |

app_docker/translations/translation_da.csv

@@ -89,7 +89,6 @@
 "and","og"
 "from each pair","fra hvert par"
 "Plot","Tegn"
-"Adjust settings, then press ""Plot"".","Juster indstillingerne og tryk så ""Tegn""."
 "Plot height (mm)","Højde af grafik (mm)"
 "Plot width (mm)","Bredde af grafik (mm)"
 "File format","File format"
@@ -97,12 +96,7 @@
 "Select variable","Vælg variabel"
 "Response variable","Svarvariable"
 "Plot type","Type af grafik"
-"Please select","Vælg"
-"Additional variables","Yderligere variabler"
-"Secondary variable","Sekundær variabel"
 "No variable","Ingen variabel"
-"Grouping variable","Variabel til gruppering"
-"No stratification","Ingen stratificering"
 "Drawing the plot. Hold tight for a moment..","Tegner grafikken. Spænd selen.."
 "#Plotting\n","#Tegner\n"
 "Stacked horizontal bars","Stablede horisontale søjler"
@@ -260,7 +254,6 @@
 "FreesearchR is available in multiple languages. To help with translations, please contact us at info@freesearchr.org","FreesearchR er tilgængelig på flere sprog. For at få hjælp med oversættelser, kontakt os venligst på info@freesearchr.org"
 "Home","Hjem"
 "Start with FreesearchR for basic data evaluation and analysis.","Start med FreesearchR til grundlæggende dataevaluering og -analyse."
-"When you need more advanced tools, you'll be better prepared to use R directly.","Når du har brug for mere avancerede værktøjer, vil du være bedre forberedt på at bruge R direkte."
 "(Read more)","(Læs mere)"
 "Run the FreesearchR app locally when working with sensitive data.","Kør FreesearchR-appen lokalt, når du arbejder med følsomme data."
 "Load data from spreadsheets, REDCap servers, or try with sample data. Multiple sources supported for maximum flexibility.","Indlæs data fra regneark, REDCap-servere, eller prøv med eksempeldata. Flere kilder understøttes for maksimal fleksibilitet."
@@ -271,14 +264,11 @@
 "When you need more advanced tools, you'll be prepared to use R directly.","Når du har brug for mere avancerede værktøjer, vil du være forberedt på at bruge R direkte."
 "The app contains a selelct number of features and will guide you through key analyses.","Appen indeholder udvalgte funktioner, og guider dig gennem de vigtigste analyser."
 "Sort by Levels","Sorter efter niveauer"
-"Modify factor levels","Ændr kategoriske niveauer"
-"Reorder or rename the levels of factor/categorical variables.","Ændr navn eller rækkefølge på kategorisk variabel."
 "Maximum number of observations:","Maximale antal observationer:"
 "setting to 0 includes all","angiv 0 for at inkludere alle"
 "Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata."
 "Select a sample dataset from a package.","Vælg et træningsdatasæt."
 "Data ready to be imported!","Data er klar til at blive importeret!"
-"Data has %s obs. of %s variables.","Data har %s obs. på %s variabler."
 "Data successfully imported!","Data successfully imported!"
 "Click to see data","Klik for at se data"
 "No data present.","Ingen data tilstede."
@@ -314,10 +304,23 @@
 "Sample data","Sample data"
 "Settings","Settings"
 "Create new factor","Create new factor"
-"Choose color palette","Choose color palette"
 "Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
 "Drop empty","Drop empty"
 "Choose variable:","Choose variable:"
 "An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
 "An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
 "Likert diagram","Likert diagram"
+"Modify factor","Modify factor"
+"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
+"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
+"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
+"Define plot","Define plot"
+"Choose color palette","Choose color palette"
+"Additional variable","Additional variable"
+"Grouping variable","Grouping variable"
+"Secondary variable","Secondary variable"
+"Reverse colors","Reverse colors"
+"Plot survey results","Plot survey results"
+"Additional variables","Additional variables"
+"Other variables","Other variables"
+"Select variables and plot type,\nthen click 'Plot' to generate visualization","Select variables and plot type,\nthen click 'Plot' to generate visualization"

app_docker/translations/translation_sw.csv

@@ -89,7 +89,6 @@
 "and","na"
 "from each pair","kutoka kwa kila jozi"
 "Plot","Kipande cha habari"
-"Adjust settings, then press ""Plot"".","Rekebisha mipangilio, kisha bonyeza ""Plot""."
 "Plot height (mm)","Urefu wa kiwanja (mm)"
 "Plot width (mm)","Upana wa kiwanja (mm)"
 "File format","Umbizo la faili"
@@ -97,12 +96,7 @@
 "Select variable","Chagua kigezo"
 "Response variable","Kigezo cha majibu"
 "Plot type","Aina ya kiwanja"
-"Please select","Tafadhali chagua"
-"Additional variables","Vigezo vya ziada"
-"Secondary variable","Kigezo cha pili"
 "No variable","Hakuna kigezo"
-"Grouping variable","Kigezo cha kuweka katika makundi"
-"No stratification","Hakuna matabaka"
 "Drawing the plot. Hold tight for a moment..","Kuchora njama. Shikilia kwa muda.."
 "#Plotting\n","#Upangaji\n"
 "Stacked horizontal bars","Pau za mlalo zilizopangwa kwa mpangilio"
@@ -260,7 +254,6 @@
 "FreesearchR is available in multiple languages. To help with translations, please contact us at info@freesearchr.org","FreesearchR inapatikana katika lugha nyingi. Ili kukusaidia na tafsiri, tafadhali wasiliana nasi kwa info@freesearchr.org."
 "Home","Nyumbani"
 "Start with FreesearchR for basic data evaluation and analysis.","Anza na FreesearchR kwa tathmini na uchambuzi wa data ya msingi."
-"When you need more advanced tools, you'll be better prepared to use R directly.","Unapohitaji zana za hali ya juu zaidi, utakuwa tayari zaidi kutumia R moja kwa moja."
 "(Read more)","(Soma zaidi)"
 "Run the FreesearchR app locally when working with sensitive data.","Endesha programu ya FreesearchR ndani ya eneo lako unapofanya kazi na data nyeti."
 "Load data from spreadsheets, REDCap servers, or try with sample data. Multiple sources supported for maximum flexibility.","Pakia data kutoka kwa lahajedwali, seva za REDCap, au jaribu na data ya sampuli. Vyanzo vingi vinaungwa mkono kwa unyumbufu wa hali ya juu."
@@ -271,14 +264,11 @@
 "When you need more advanced tools, you'll be prepared to use R directly.","Unapohitaji zana za hali ya juu zaidi, utakuwa tayari kutumia R moja kwa moja."
 "The app contains a selelct number of features and will guide you through key analyses.","The app contains a selelct number of features and will guide you through key analyses."
 "Sort by Levels","Sort by Levels"
-"Modify factor levels","Modify factor levels"
-"Reorder or rename the levels of factor/categorical variables.","Reorder or rename the levels of factor/categorical variables."
 "Maximum number of observations:","Maximum number of observations:"
 "setting to 0 includes all","setting to 0 includes all"
 "Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package."
 "Select a sample dataset from a package.","Select a sample dataset from a package."
 "Data ready to be imported!","Data ready to be imported!"
-"Data has %s obs. of %s variables.","Data has %s obs. of %s variables."
 "Data successfully imported!","Data successfully imported!"
 "Click to see data","Click to see data"
 "No data present.","No data present."
@@ -314,10 +304,23 @@
 "Sample data","Sample data"
 "Settings","Settings"
 "Create new factor","Create new factor"
-"Choose color palette","Choose color palette"
 "Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
 "Drop empty","Drop empty"
 "Choose variable:","Choose variable:"
 "An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
 "An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
 "Likert diagram","Likert diagram"
+"Modify factor","Modify factor"
+"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
+"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
+"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
+"Define plot","Define plot"
+"Choose color palette","Choose color palette"
+"Additional variable","Additional variable"
+"Grouping variable","Grouping variable"
+"Secondary variable","Secondary variable"
+"Reverse colors","Reverse colors"
+"Plot survey results","Plot survey results"
+"Additional variables","Additional variables"
+"Other variables","Other variables"
+"Select variables and plot type,\nthen click 'Plot' to generate visualization","Select variables and plot type,\nthen click 'Plot' to generate visualization"

examples/visuals_module_demo.R

@@ -22,7 +22,7 @@ visuals_demo_app <- function() {
     )
   )
   server <- function(input, output, session) {
-    pl <- data_visuals_server("visuals", data = shiny::reactive(default_parsing(mtcars)))
+    pl <- data_visuals_server("visuals", data = shiny::reactive(default_parsing(mtcars)),palettes = color_choices())
   }
   shiny::shinyApp(ui, server)
 }

inst/translations/translation_da.csv

@@ -89,7 +89,6 @@
 "and","og"
 "from each pair","fra hvert par"
 "Plot","Tegn"
-"Adjust settings, then press ""Plot"".","Juster indstillingerne og tryk så ""Tegn""."
 "Plot height (mm)","Højde af grafik (mm)"
 "Plot width (mm)","Bredde af grafik (mm)"
 "File format","File format"
@@ -97,12 +96,7 @@
 "Select variable","Vælg variabel"
 "Response variable","Svarvariable"
 "Plot type","Type af grafik"
-"Please select","Vælg"
-"Additional variables","Yderligere variabler"
-"Secondary variable","Sekundær variabel"
 "No variable","Ingen variabel"
-"Grouping variable","Variabel til gruppering"
-"No stratification","Ingen stratificering"
 "Drawing the plot. Hold tight for a moment..","Tegner grafikken. Spænd selen.."
 "#Plotting\n","#Tegner\n"
 "Stacked horizontal bars","Stablede horisontale søjler"
@@ -260,7 +254,6 @@
 "FreesearchR is available in multiple languages. To help with translations, please contact us at info@freesearchr.org","FreesearchR er tilgængelig på flere sprog. For at få hjælp med oversættelser, kontakt os venligst på info@freesearchr.org"
 "Home","Hjem"
 "Start with FreesearchR for basic data evaluation and analysis.","Start med FreesearchR til grundlæggende dataevaluering og -analyse."
-"When you need more advanced tools, you'll be better prepared to use R directly.","Når du har brug for mere avancerede værktøjer, vil du være bedre forberedt på at bruge R direkte."
 "(Read more)","(Læs mere)"
 "Run the FreesearchR app locally when working with sensitive data.","Kør FreesearchR-appen lokalt, når du arbejder med følsomme data."
 "Load data from spreadsheets, REDCap servers, or try with sample data. Multiple sources supported for maximum flexibility.","Indlæs data fra regneark, REDCap-servere, eller prøv med eksempeldata. Flere kilder understøttes for maksimal fleksibilitet."
@@ -271,14 +264,11 @@
 "When you need more advanced tools, you'll be prepared to use R directly.","Når du har brug for mere avancerede værktøjer, vil du være forberedt på at bruge R direkte."
 "The app contains a selelct number of features and will guide you through key analyses.","Appen indeholder udvalgte funktioner, og guider dig gennem de vigtigste analyser."
 "Sort by Levels","Sorter efter niveauer"
-"Modify factor levels","Ændr kategoriske niveauer"
-"Reorder or rename the levels of factor/categorical variables.","Ændr navn eller rækkefølge på kategorisk variabel."
 "Maximum number of observations:","Maximale antal observationer:"
 "setting to 0 includes all","angiv 0 for at inkludere alle"
 "Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata."
 "Select a sample dataset from a package.","Vælg et træningsdatasæt."
 "Data ready to be imported!","Data er klar til at blive importeret!"
-"Data has %s obs. of %s variables.","Data har %s obs. på %s variabler."
 "Data successfully imported!","Data successfully imported!"
 "Click to see data","Klik for at se data"
 "No data present.","Ingen data tilstede."
@@ -314,10 +304,23 @@
 "Sample data","Sample data"
 "Settings","Settings"
 "Create new factor","Create new factor"
-"Choose color palette","Choose color palette"
 "Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
 "Drop empty","Drop empty"
 "Choose variable:","Choose variable:"
 "An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
 "An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
 "Likert diagram","Likert diagram"
+"Modify factor","Modify factor"
+"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
+"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
+"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
+"Define plot","Define plot"
+"Choose color palette","Choose color palette"
+"Additional variable","Additional variable"
+"Grouping variable","Grouping variable"
+"Secondary variable","Secondary variable"
+"Reverse colors","Reverse colors"
+"Plot survey results","Plot survey results"
+"Additional variables","Additional variables"
+"Other variables","Other variables"
+"Select variables and plot type,\nthen click 'Plot' to generate visualization","Select variables and plot type,\nthen click 'Plot' to generate visualization"

inst/translations/translation_sw.csv

@@ -89,7 +89,6 @@
 "and","na"
 "from each pair","kutoka kwa kila jozi"
 "Plot","Kipande cha habari"
-"Adjust settings, then press ""Plot"".","Rekebisha mipangilio, kisha bonyeza ""Plot""."
 "Plot height (mm)","Urefu wa kiwanja (mm)"
 "Plot width (mm)","Upana wa kiwanja (mm)"
 "File format","Umbizo la faili"
@@ -97,12 +96,7 @@
 "Select variable","Chagua kigezo"
 "Response variable","Kigezo cha majibu"
 "Plot type","Aina ya kiwanja"
-"Please select","Tafadhali chagua"
-"Additional variables","Vigezo vya ziada"
-"Secondary variable","Kigezo cha pili"
 "No variable","Hakuna kigezo"
-"Grouping variable","Kigezo cha kuweka katika makundi"
-"No stratification","Hakuna matabaka"
 "Drawing the plot. Hold tight for a moment..","Kuchora njama. Shikilia kwa muda.."
 "#Plotting\n","#Upangaji\n"
 "Stacked horizontal bars","Pau za mlalo zilizopangwa kwa mpangilio"
@@ -260,7 +254,6 @@
 "FreesearchR is available in multiple languages. To help with translations, please contact us at info@freesearchr.org","FreesearchR inapatikana katika lugha nyingi. Ili kukusaidia na tafsiri, tafadhali wasiliana nasi kwa info@freesearchr.org."
 "Home","Nyumbani"
 "Start with FreesearchR for basic data evaluation and analysis.","Anza na FreesearchR kwa tathmini na uchambuzi wa data ya msingi."
-"When you need more advanced tools, you'll be better prepared to use R directly.","Unapohitaji zana za hali ya juu zaidi, utakuwa tayari zaidi kutumia R moja kwa moja."
 "(Read more)","(Soma zaidi)"
 "Run the FreesearchR app locally when working with sensitive data.","Endesha programu ya FreesearchR ndani ya eneo lako unapofanya kazi na data nyeti."
 "Load data from spreadsheets, REDCap servers, or try with sample data. Multiple sources supported for maximum flexibility.","Pakia data kutoka kwa lahajedwali, seva za REDCap, au jaribu na data ya sampuli. Vyanzo vingi vinaungwa mkono kwa unyumbufu wa hali ya juu."
@@ -271,14 +264,11 @@
 "When you need more advanced tools, you'll be prepared to use R directly.","Unapohitaji zana za hali ya juu zaidi, utakuwa tayari kutumia R moja kwa moja."
 "The app contains a selelct number of features and will guide you through key analyses.","The app contains a selelct number of features and will guide you through key analyses."
 "Sort by Levels","Sort by Levels"
-"Modify factor levels","Modify factor levels"
-"Reorder or rename the levels of factor/categorical variables.","Reorder or rename the levels of factor/categorical variables."
 "Maximum number of observations:","Maximum number of observations:"
 "setting to 0 includes all","setting to 0 includes all"
 "Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package."
 "Select a sample dataset from a package.","Select a sample dataset from a package."
 "Data ready to be imported!","Data ready to be imported!"
-"Data has %s obs. of %s variables.","Data has %s obs. of %s variables."
 "Data successfully imported!","Data successfully imported!"
 "Click to see data","Click to see data"
 "No data present.","No data present."
@@ -314,10 +304,23 @@
 "Sample data","Sample data"
 "Settings","Settings"
 "Create new factor","Create new factor"
-"Choose color palette","Choose color palette"
 "Optional filter logic (e.g., ⁠[gender] = 'female')","Optional filter logic (e.g., ⁠[gender] = 'female')"
 "Drop empty","Drop empty"
 "Choose variable:","Choose variable:"
 "An empty data set was imported. Please review data filter.","An empty data set was imported. Please review data filter."
 "An error was encountered exporting data. Please review data filter.","An error was encountered exporting data. Please review data filter."
 "Likert diagram","Likert diagram"
+"Modify factor","Modify factor"
+"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
+"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
+"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
+"Define plot","Define plot"
+"Choose color palette","Choose color palette"
+"Additional variable","Additional variable"
+"Grouping variable","Grouping variable"
+"Secondary variable","Secondary variable"
+"Reverse colors","Reverse colors"
+"Plot survey results","Plot survey results"
+"Additional variables","Additional variables"
+"Other variables","Other variables"
+"Select variables and plot type,\nthen click 'Plot' to generate visualization","Select variables and plot type,\nthen click 'Plot' to generate visualization"

man/align_axes.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{align_axes}
 \alias{align_axes}
 \title{Aligns axes between plots}
 \usage{
-align_axes(..., x.axis = TRUE, y.axis = TRUE)
+align_axes(..., x.axis = TRUE, y.axis = TRUE, percentage = FALSE)
 }
 \arguments{
 \item{...}{ggplot2 objects or list of ggplot2 objects}

man/all_but.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{all_but}
 \alias{all_but}
 \title{Select all from vector but}

man/available_plots.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot-helpers.R
+\name{available_plots}
+\alias{available_plots}
+\title{Implemented functions}
+\usage{
+available_plots()
+}
+\value{
+list
+}
+\description{
+Library of supported functions. The list name and "descr" element should be
+unique for each element on list.
+\itemize{
+\item fun: the plotting function
+\item fun.args: default parameters for the plotting function
+\item descr: Plot description
+\item note: Short note/description of the function for displaying in ui and docs
+\item primary.type: Primary variable data type (see \link{data_type})
+\item base: holds a list of parameters for plot input fields generation
+Secondary and tertiary variable input fields are mandatory.
+}
+}
+\examples{
+available_plots() |> str()
+}

man/clean_common_axis.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{clean_common_axis}
 \alias{clean_common_axis}
 \title{Extract and clean axis ranges}

man/data-plots.Rd

@@ -1,12 +1,13 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R, R/plot_bar.R, R/plot_box.R,
+% Please edit documentation in R/data_plots.R, R/plot-helpers.R, R/plot_bar.R,
-%   R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R, R/plot_sankey.R,
+%   R/plot_box.R, R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R,
-%   R/plot_scatter.R, R/plot_violin.R
+%   R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R
 \name{data-plots}
 \alias{data-plots}
 \alias{data_visuals_ui}
 \alias{data_visuals_server}
 \alias{create_plot}
+\alias{plot_bar}
 \alias{plot_bar_single}
 \alias{plot_box}
 \alias{plot_box_single}
@@ -21,19 +22,21 @@
 \usage{
 data_visuals_ui(id, tab_title = "Plots", ...)
 
-data_visuals_server(
+data_visuals_server(id, data, palettes = color_choices(), ...)
-  id,
-  data,
-  palettes = c(`Perceptual (blue-yellow)` = "viridis", `Perceptual (fire)` = "plasma",
-    `Colour-blind friendly` = "Okabe-Ito", `Qualitative (bold)` = "Dark 2",
-    `Qualitative (paired)` = "Paired", `Sequential (blues)` = "Blues",
-    `Diverging (red-blue)` = "RdBu", `Tableau style` = "Tableau 10", Pastel = "Pastel 1",
-    Rainbow = "rainbow"),
-  ...
-)
 
 create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...)
 
+plot_bar(
+  data,
+  pri,
+  sec = NULL,
+  ter = NULL,
+  style = c("stack", "dodge", "fill"),
+  color.palette = "viridis",
+  max_level = 30,
+  ...
+)
+
 plot_bar_single(
   data,
   pri,
@@ -47,9 +50,9 @@ plot_box(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
 
 plot_box_single(data, pri, sec = NULL, seed = 2103, color.palette = "viridis")
 
-plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis")
+plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
 
-plot_likert(data, pri, sec = NULL, ter = NULL, color.palette = "viridis")
+plot_likert(data, pri, sec = NULL, ter = NULL, color.palette = "viridis", ...)
 
 plot_ridge(data, x, y, z = NULL, color.palette = "viridis", ...)
 
@@ -66,12 +69,13 @@ plot_sankey(
   default.color = "#2986cc",
   box.color = "#1E4B66",
   na.color = "grey80",
-  missing.level = "Missing"
+  missing.level = "Missing",
+  ...
 )
 
-plot_scatter(data, pri, sec, ter = NULL, color.palette = "viridis")
+plot_scatter(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
 
-plot_violin(data, pri, sec, ter = NULL, color.palette = "viridis")
+plot_violin(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
 }
 \arguments{
 \item{id}{Module id. (Use 'ns("id")')}
@@ -100,6 +104,8 @@ shiny server module
 
 ggplot2 object
 
+ggplot list object
+
 ggplot object
 
 ggplot2 object
@@ -125,6 +131,8 @@ Data correlations evaluation module
 
 Wrapper to create plot based on provided type
 
+Title
+
 Single vertical barplot
 
 Beautiful box plot(s)
@@ -147,6 +155,13 @@ Beautiful violin plot
 }
 \examples{
 create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
+mtcars |>
+  dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
+  plot_bar(pri = "cyl", sec = "am", style = "fill")
+
+mtcars |>
+  dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
+  plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
 mtcars |>
   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
   plot_bar_single(pri = "cyl", sec = "am", style = "fill")
@@ -170,7 +185,7 @@ mtcars |> plot_hbars(pri = "carb", sec = "cyl")
 mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
 mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues")
 mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma")
-mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis")
+mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis")
 mtcars |> plot_likert(pri = "carb", sec = "cyl")
 mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am")
 mtcars |> plot_likert(pri = "cyl",color.palette="Blues")

man/get_input_params.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot-helpers.R
+\name{get_input_params}
+\alias{get_input_params}
+\title{Get the function parameters based on the selected function description}
+\usage{
+get_input_params(data)
+}
+\arguments{
+\item{data}{vector}
+}
+\value{
+list
+}
+\description{
+Get the function parameters based on the selected function description
+}
+\examples{
+ls <- mtcars |>
+  default_parsing() |>
+  dplyr::pull(mpg) |>
+  possible_plots() |>
+  (\(.x){
+    .x[[1]]
+  })() |>
+  get_input_params()
+}

man/get_label.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{get_label}
 \alias{get_label}
 \title{Print label, and if missing print variable name for plots}

man/get_plot_options.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{get_plot_options}
 \alias{get_plot_options}
 \title{Get the function options based on the selected function description}

man/line_break.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{line_break}
 \alias{line_break}
 \title{Line breaking at given number of characters for nicely plotting labels}

man/plot_euler_single.Rd

@@ -4,7 +4,7 @@
 \alias{plot_euler_single}
 \title{Easily plot single euler diagrams}
 \usage{
-plot_euler_single(data, color.palette = "viridis")
+plot_euler_single(data, color.palette = "viridis", ...)
 }
 \value{
 ggplot2 object

man/possible_plots.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{possible_plots}
 \alias{possible_plots}
 \title{Get possible regression models}
 \usage{
-possible_plots(data)
+possible_plots(data, source_list = supported_plots())
 }
 \arguments{
 \item{data}{data}

man/selectPlotVariables.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot-helpers.R
+\name{selectPlotVariables}
+\alias{selectPlotVariables}
+\title{Wrapper for columnSelectInput}
+\usage{
+selectPlotVariables(data, exclude = NULL, allow_none = TRUE, var_types, ...)
+}
+\description{
+Wrapper for columnSelectInput
+}

man/subset_types.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{subset_types}
 \alias{subset_types}
 \title{Easily subset by data type function}

man/supported_plots.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{supported_plots}
 \alias{supported_plots}
 \title{Implemented functions}

man/vertical_stacked_bars.Rd

@@ -9,7 +9,7 @@ vertical_stacked_bars(
   score = "full_score",
   group = "pase_0_q",
   strata = NULL,
-  t.size = 10,
+  t.size = 8,
   l.color = "black",
   l.size = 0.5,
   draw.lines = TRUE,

man/wrap_plot_list.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
+% Please edit documentation in R/plot-helpers.R
 \name{wrap_plot_list}
 \alias{wrap_plot_list}
 \title{Wrapping}
@@ -12,6 +12,7 @@ wrap_plot_list(
   guides = "collect",
   axes = "collect",
   axis_titles = "collect",
+  y.axis.percentage = FALSE,
   ...
 )
 }