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.4.2
+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.4.2
+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)

NEWS.md

@@ -1,3 +1,7 @@
+# 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.

R/app_version.R

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

R/data_plots.R

@@ -14,12 +14,23 @@ 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 = phosphoricons::ph("chart-line"),
             # icon = bsicons::bs_icon("graph-up"),
             shiny::uiOutput(outputId = ns("primary")),
@@ -30,19 +41,16 @@ 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("color_palette")),
-            shiny::br(),
-            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::uiOutput(outputId = ns("tertiary"))
           ),
-            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",
@@ -95,14 +103,14 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
         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"))
@@ -119,10 +127,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
 #' @name data-plots
 #' @returns shiny server module
 #' @export
-data_visuals_server <- function(id,
-                                data,
-                                palettes,
-                                ...) {
+data_visuals_server <- function(id, data, palettes = color_choices(), ...) {
   shiny::moduleServer(
     id = id,
     module = function(input, output, session) {
@@ -174,69 +179,99 @@ 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(
-          subset_types(data(), rv$plot.params()[["secondary.type"]])
-        ), input$primary))
+        # Get the plot function name
+        base_params <- rv$plot.params()[["base"]]
 
-        columnSelectInput(
-          inputId = ns("secondary"),
-          data = data,
-          selected = cols[1],
-          placeholder = i18n$t("Please select"),
-          label = if (isTRUE(rv$plot.params()[["secondary.multi"]]))
-            i18n$t("Additional variables")
-          else
-            i18n$t("Secondary variable"),
-          multiple = rv$plot.params()[["secondary.multi"]],
-          maxItems = rv$plot.params()[["secondary.max"]],
-          col_subset = cols,
-          none_label = i18n$t("No variable")
+        filtered_params <- base_params[sapply(base_params, function(params) {
+          params$id %in% "secondary"
+        })][[1]]
+
+        filtered_params$exclude <- input$primary
+
+        create_input_element(
+          input_id = "secondary",
+          ns = ns,
+          params = append_list(data(), filtered_params, "data")
         )
+
       })
 
       output$tertiary <- shiny::renderUI({
         shiny::req(input$type)
-        columnSelectInput(
-          inputId = ns("tertiary"),
-          data = data,
-          placeholder = i18n$t("Please select"),
-          label = i18n$t("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 = i18n$t("No stratification")
+        # Get the plot function name
+        base_params <- rv$plot.params()[["base"]]
+
+        filtered_params <- base_params[sapply(base_params, function(params) {
+          params$id %in% "tertiary"
+        })][[1]]
+
+        filtered_params$exclude <- c(input$primary, input$secondary)
+
+        create_input_element(
+          input_id = "tertiary",
+          ns = ns,
+          params = append_list(data(), filtered_params, "data")
         )
       })
 
+
+      ### 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)
@@ -251,18 +286,48 @@ data_visuals_server <- function(id,
       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,
-              color.palette = input$color_palette
+              ter = input$tertiary
             )
 
+            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.."),
@@ -298,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)
         }
       })
 
@@ -342,503 +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,
-      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) {
-  # 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",
-                           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/generate_colors.R

@@ -56,38 +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) {
-    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.")
-  }
-
+  # --- Named palette dispatch -------------------------------------------------
   palette_lower <- tolower(palette)
 
-  viridis_palettes <- c("viridis",
-                        "magma",
-                        "plasma",
-                        "inferno",
-                        "cividis",
-                        "mako",
-                        "rocket",
-                        "turbo")
+  viridis_palettes <- c("viridis", "magma", "plasma", "inferno",
+                        "cividis", "mako", "rocket", "turbo")
 
   if (palette_lower %in% viridis_palettes) {
     viridisLite::viridis(n = n, option = palette_lower, ...)
@@ -107,25 +94,32 @@ 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)) {
-    max_n       <- RColorBrewer::brewer.pal.info[palette, "maxcolors"]
-    fetch_n     <- max(min(n, max_n), 3L)          # clamp to [3, max_n] for brewer.pal()
-    base_colors <- RColorBrewer::brewer.pal(n = fetch_n, name = palette)
+  } else {
+    # Case-insensitive RColorBrewer lookup
+    brewer_names <- rownames(RColorBrewer::brewer.pal.info)
+    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()) {
-    grDevices::colorRampPalette(palette.colors(palette = palette))(n)
+    } else {
+      # 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(
-        "Unknown palette: '",
-        palette,
-        "'. ",
-        "Falling back to default R colors.\n",
+        warning(
+          "Unknown palette: '", palette, "'. Falling back to viridis.\n",
           "Available options:\n",
           "  viridisLite  : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n",
           "  grDevices    : hcl, rainbow, heat, terrain, topo\n",
@@ -133,9 +127,9 @@ generate_colors <- function(n, palette = "viridis", ...) {
           "  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)
+      }
+    }
   }
 }
 

R/hosted_version.R

@@ -1 +1 @@
-hosted_version <- function()'v26.4.2-260410'
+hosted_version <- function()'v26.6.1'

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

@@ -39,14 +39,14 @@ plot_bar <- function(data,
       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)}")),
-                 y.axis.percentage = TRUE,
-                 ...)
+                 y.axis.percentage = TRUE)
 }
 
 

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

@@ -15,13 +15,15 @@ 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,
+    ...
   )
 }
 
@@ -74,7 +76,7 @@ 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)
   }
 

R/plot_likert.R

@@ -15,7 +15,8 @@ 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 {

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/ui_elements.R

@@ -247,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"
               ),
@@ -694,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",

SESSION.md

@@ -2,20 +2,20 @@
 -------------------------------- R environment ---------------------------------
 --------------------------------------------------------------------------------
 |setting     |value                                                                                              |
-|:-----------|:------------------------------------------|
+|:-----------|:--------------------------------------------------------------------------------------------------|
 |version     |R version 4.5.2 (2025-10-31)                                                                       |
-|os          |macOS Tahoe 26.4.1                         |
+|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-04-10                                 |
-|rstudio     |2026.01.1+403 Apple Blossom (desktop)      |
-|pandoc      |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
-|quarto      |1.7.30 @ /usr/local/bin/quarto             |
-|FreesearchR |26.4.2.260410                              |
+|date        |2026-06-01                                                                                         |
+|rstudio     |2026.04.0+526 Globemaster Allium (desktop)                                                         |
+|pandoc      |3.8.3 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/aarch64/ (via rmarkdown) |
+|quarto      |1.9.37 @ /usr/local/bin/quarto                                                                     |
+|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) |
@@ -61,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) |
@@ -83,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.4.2        |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) |
@@ -93,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) |
@@ -124,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) |
@@ -136,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) |
@@ -147,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) |
@@ -191,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) |
@@ -223,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"
@@ -310,7 +304,6 @@
 "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:"
@@ -320,3 +313,14 @@
 "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"
@@ -310,7 +304,6 @@
 "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:"
@@ -320,3 +313,14 @@
 "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"
@@ -310,7 +304,6 @@
 "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:"
@@ -320,3 +313,14 @@
 "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"
@@ -310,7 +304,6 @@
 "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:"
@@ -320,3 +313,14 @@
 "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,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{align_axes}
 \alias{align_axes}
 \title{Aligns axes between plots}

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,7 +1,7 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R, R/plot_bar.R, R/plot_box.R,
-%   R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R, R/plot_sankey.R,
-%   R/plot_scatter.R, R/plot_violin.R
+% Please edit documentation in R/data_plots.R, R/plot-helpers.R, R/plot_bar.R,
+%   R/plot_box.R, R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R,
+%   R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R
 \name{data-plots}
 \alias{data-plots}
 \alias{data_visuals_ui}
@@ -22,7 +22,7 @@
 \usage{
 data_visuals_ui(id, tab_title = "Plots", ...)
 
-data_visuals_server(id, data, palettes, ...)
+data_visuals_server(id, data, palettes = color_choices(), ...)
 
 create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...)
 
@@ -50,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", ...)
 
@@ -69,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")')}

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