DESCRIPTION

@@ -80,9 +80,7 @@ Suggests:
     rsconnect,
     knitr,
     rmarkdown,
-    testthat (>= 3.0.0),
+    testthat (>= 3.0.0)
-    shinytest,
-    covr
 URL: https://github.com/agdamsbo/FreesearchR, https://agdamsbo.github.io/FreesearchR/
 BugReports: https://github.com/agdamsbo/FreesearchR/issues
 VignetteBuilder: knitr

NAMESPACE

@@ -5,13 +5,12 @@ S3method(cut_var,hms)
 S3method(plot,tbl_regression)
 export(add_class_icon)
 export(add_sparkline)
-export(align_axes)
 export(all_but)
+export(allign_axes)
 export(append_column)
 export(append_list)
 export(argsstring2list)
 export(baseline_table)
-export(class_icons)
 export(clean_common_axis)
 export(clean_date)
 export(clean_sep)
@@ -96,6 +95,7 @@ export(regression_model_uv_list)
 export(regression_table)
 export(remove_empty_attr)
 export(remove_empty_cols)
+export(remove_na_attr)
 export(remove_nested_list)
 export(repeated_instruments)
 export(sankey_ready)
@@ -108,7 +108,6 @@ export(supported_functions)
 export(supported_plots)
 export(symmetrical_scale_x_log10)
 export(tbl_merge)
-export(type_icons)
 export(update_factor_server)
 export(update_factor_ui)
 export(update_variables_server)
@@ -116,6 +115,7 @@ export(update_variables_ui)
 export(vectorSelectInput)
 export(vertical_stacked_bars)
 export(wide2long)
+export(winbox_cut_variable)
 export(winbox_update_factor)
 export(wrap_plot_list)
 export(write_quarto)

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'Version: 25.4.3.250415_1627'
+app_version <- function()'Version: 25.4.3.250414_1342'

R/baseline_table.R

@@ -49,7 +49,7 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
     }
   }
 
-  suppressMessages(gtsummary::theme_gtsummary_journal(journal = theme))
+  gtsummary::theme_gtsummary_journal(journal = theme)
 
   args <- list(...)
 

R/correlations-module.R

@@ -46,8 +46,7 @@ data_correlations_server <- function(id,
         } else {
           out <- data()
         }
-        # out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
+        out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
-        sapply(out,as.numeric)
         # as.numeric()
       })
 
@@ -101,9 +100,8 @@ data_correlations_server <- function(id,
 }
 
 correlation_pairs <- function(data, threshold = .8) {
-  data <- as.data.frame(data)[!sapply(as.data.frame(data), is.character)]
+  data <- data[!sapply(data, is.character)]
-  data <- sapply(data,\(.x)if (is.factor(.x)) as.numeric(.x) else .x) |> as.data.frame()
+  data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
-  # data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
   cor <- Hmisc::rcorr(as.matrix(data))
   r <- cor$r %>% as.table()
   d <- r |>

R/cut-variable-dates.R

@@ -18,7 +18,7 @@ cut_var <- function(x, ...) {
 #' @export
 #' @name cut_var
 cut_var.default <- function(x, ...) {
-  base::cut(x, ...)
+  base::cut.default(x, ...)
 }
 
 #' @name cut_var
@@ -581,6 +581,36 @@ modal_cut_variable <- function(id,
 }
 
 
+#' @inheritParams shinyWidgets::WinBox
+#' @export
+#'
+#' @importFrom shinyWidgets WinBox wbOptions wbControls
+#' @importFrom htmltools tagList
+#' @rdname cut-variable
+winbox_cut_variable <- function(id,
+                                title = i18n("Convert Numeric to Factor"),
+                                options = shinyWidgets::wbOptions(),
+                                controls = shinyWidgets::wbControls()) {
+  ns <- NS(id)
+  WinBox(
+    title = title,
+    ui = tagList(
+      cut_variable_ui(id),
+      tags$div(
+        style = "display: none;",
+        textInput(inputId = ns("hidden"), label = NULL, value = genId())
+      )
+    ),
+    options = modifyList(
+      shinyWidgets::wbOptions(height = "750px", modal = TRUE),
+      options
+    ),
+    controls = controls,
+    auto_height = FALSE
+  )
+}
+
+
 #' @importFrom graphics abline axis hist par plot.new plot.window
 plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") {
   x <- data[[column]]
@@ -597,4 +627,3 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
   abline(v = breaks, col = "#FFFFFF", lty = 1, lwd = 1.5)
   abline(v = breaks, col = "#2E2E2E", lty = 2, lwd = 1.5)
 }
-

R/data-summary.R

@@ -155,8 +155,8 @@ overview_vars <- function(data) {
   data <- as.data.frame(data)
 
   dplyr::tibble(
-    icon = data_type(data),
+    class = get_classes(data),
-    type = icon,
+    type = data_type(data),
     name = names(data),
     n_missing = unname(colSums(is.na(data))),
     p_complete = 1 - n_missing / nrow(data),
@@ -188,7 +188,7 @@ create_overview_datagrid <- function(data,...) {
 
   std_names <- c(
     "Name" = "name",
-    "Icon" = "icon",
+    "Class" = "class",
     "Type" = "type",
     "Missings" = "n_missing",
     "Complete" = "p_complete",
@@ -226,7 +226,7 @@ create_overview_datagrid <- function(data,...) {
 
   grid <- toastui::grid_columns(
     grid = grid,
-    columns = "icon",
+    columns = "class",
     header = " ",
     align = "center",sortable = FALSE,
     width = 40
@@ -234,8 +234,7 @@ create_overview_datagrid <- function(data,...) {
 
   grid <- add_class_icon(
     grid = grid,
-    column = "icon",
+    column = "class"
-    fun = type_icons
   )
 
   grid <- toastui::grid_format(
@@ -272,14 +271,32 @@ create_overview_datagrid <- function(data,...) {
 #'   overview_vars() |>
 #'   toastui::datagrid() |>
 #'   add_class_icon()
-add_class_icon <- function(grid, column = "class", fun=class_icons) {
+add_class_icon <- function(grid, column = "class") {
   out <- toastui::grid_format(
     grid = grid,
     column = column,
     formatter = function(value) {
       lapply(
         X = value,
-        FUN = fun
+        FUN = function(x) {
+          if (identical(x, "numeric")) {
+            shiny::icon("calculator")
+          } else if (identical(x, "factor")) {
+            shiny::icon("chart-simple")
+          } else if (identical(x, "integer")) {
+            shiny::icon("arrow-down-1-9")
+          } else if (identical(x, "character")) {
+            shiny::icon("arrow-down-a-z")
+          } else if (identical(x, "logical")) {
+            shiny::icon("toggle-off")
+          } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
+            shiny::icon("calendar-days")
+          } else if ("hms" %in% x) {
+            shiny::icon("clock")
+          } else {
+            shiny::icon("table")
+          }
+        }
       )
     }
   )
@@ -291,71 +308,3 @@ add_class_icon <- function(grid, column = "class", fun=class_icons) {
     width = 60
   )
 }
-
-
-#' Get data class icons
-#'
-#' @param x character vector of data classes
-#'
-#' @returns list
-#' @export
-#'
-#' @examples
-#' "numeric" |> class_icons()|> str()
-#' mtcars |> sapply(class) |> class_icons() |> str()
-class_icons <- function(x) {
-  if (length(x)>1){
-    lapply(x,class_icons)
-  } else {
-  if (identical(x, "numeric")) {
-    shiny::icon("calculator")
-  } else if (identical(x, "factor")) {
-    shiny::icon("chart-simple")
-  } else if (identical(x, "integer")) {
-    shiny::icon("arrow-down-1-9")
-  } else if (identical(x, "character")) {
-    shiny::icon("arrow-down-a-z")
-  } else if (identical(x, "logical")) {
-    shiny::icon("toggle-off")
-  } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
-    shiny::icon("calendar-days")
-  } else if ("hms" %in% x) {
-    shiny::icon("clock")
-  } else {
-    shiny::icon("table")
-  }}
-}
-
-#' Get data type icons
-#'
-#' @param x character vector of data classes
-#'
-#' @returns list
-#' @export
-#'
-#' @examples
-#' "ordinal" |> type_icons()
-#' default_parsing(mtcars) |> sapply(data_type) |> type_icons()
-type_icons <- function(x) {
-  if (length(x)>1){
-    lapply(x,class_icons)
-  } else {
-    if (identical(x, "continuous")) {
-      shiny::icon("calculator")
-    } else if (identical(x, "categorical")) {
-      shiny::icon("chart-simple")
-    } else if (identical(x, "ordinal")) {
-      shiny::icon("arrow-down-1-9")
-    } else if (identical(x, "text")) {
-      shiny::icon("arrow-down-a-z")
-    } else if (identical(x, "dichotomous")) {
-      shiny::icon("toggle-off")
-    } else if (identical(x,"datetime")) {
-      shiny::icon("calendar-days")
-    } else if (identical(x,"id")) {
-      shiny::icon("id-card")
-    } else {
-      shiny::icon("table")
-    }
-    }
-}

R/data_plots.R

@@ -88,7 +88,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
     ),
     bslib::nav_panel(
       title = tab_title,
-      shiny::plotOutput(ns("plot"), height = "70vh"),
+      shiny::plotOutput(ns("plot"),height = "70vh"),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::htmlOutput(outputId = ns("code_plot"))
@@ -115,7 +115,7 @@ data_visuals_server <- function(id,
       rv <- shiny::reactiveValues(
         plot.params = NULL,
         plot = NULL,
-        code = NULL
+        code=NULL
       )
 
       # ## --- New attempt
@@ -216,7 +216,7 @@ data_visuals_server <- function(id,
         shiny::req(data())
         columnSelectInput(
           inputId = ns("primary"),
-          col_subset = names(data())[sapply(data(), data_type) != "text"],
+          col_subset=names(data())[sapply(data(),data_type)!="text"],
           data = data,
           placeholder = "Select variable",
           label = "Response variable",
@@ -318,30 +318,37 @@ data_visuals_server <- function(id,
 
       shiny::observeEvent(input$act_plot,
         {
-          if (NROW(data()) > 0) {
+          if (NROW(data())>0){
-            tryCatch(
+          tryCatch(
-              {
+            {
-                parameters <- list(
+              parameters <- list(
-                  type = rv$plot.params()[["fun"]],
+                type = rv$plot.params()[["fun"]],
-                  pri = input$primary,
+                x = input$primary,
-                  sec = input$secondary,
+                y = input$secondary,
-                  ter = input$tertiary
+                z = input$tertiary
-                )
+              )
 
-                shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
+              shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
-                  rv$plot <- rlang::exec(create_plot, !!!append_list(data(), parameters, "data"))
+                rv$plot <- rlang::exec(create_plot, !!!append_list(data(),parameters,"data"))
-                })
+              # rv$plot <- create_plot(
+              #   data = data(),
+              #   type = rv$plot.params()[["fun"]],
+              #   x = input$primary,
+              #   y = input$secondary,
+              #   z = input$tertiary
+              # )
+              })
 
-                rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
+              rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
-              },
+
-              # warning = function(warn) {
+            },
-              #   showNotification(paste0(warn), type = "warning")
+            # warning = function(warn) {
-              # },
+            #   showNotification(paste0(warn), type = "warning")
-              error = function(err) {
+            # },
-                showNotification(paste0(err), type = "err")
+            error = function(err) {
-              }
+              showNotification(paste0(err), type = "err")
-            )
+            }
-          }
+          )}
         },
         ignoreInit = TRUE
       )
@@ -408,7 +415,7 @@ all_but <- function(data, ...) {
 #'
 #' @examples
 #' default_parsing(mtcars) |> subset_types("ordinal")
-#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal" ,"categorical"))
 #' #' default_parsing(mtcars) |> subset_types("factor",class)
 subset_types <- function(data, types, type.fun = data_type) {
   data[sapply(data, type.fun) %in% types]
@@ -443,21 +450,21 @@ supported_plots <- function() {
       fun = "plot_hbars",
       descr = "Stacked horizontal bars",
       note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = "none"
     ),
     plot_violin = list(
       fun = "plot_violin",
       descr = "Violin plot",
       note = "A modern alternative to the classic boxplot to visualise data distribution",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime","continuous", "dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
       secondary.extra = "none",
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical")
     ),
     # plot_ridge = list(
     #   descr = "Ridge plot",
@@ -471,30 +478,30 @@ supported_plots <- function() {
       fun = "plot_sankey",
       descr = "Sankey plot",
       note = "A way of visualising change between groups",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
       secondary.extra = NULL,
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical")
     ),
     plot_scatter = list(
       fun = "plot_scatter",
       descr = "Scatter plot",
       note = "A classic way of showing the association between to variables",
-      primary.type = c("datatime", "continuous"),
+      primary.type = c("datatime","continuous"),
-      secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
+      secondary.type = c("datatime","continuous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = NULL
     ),
     plot_box = list(
       fun = "plot_box",
       descr = "Box plot",
       note = "A classic way to plot data distribution by groups",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime","continuous", "dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = "none"
     ),
     plot_euler = list(
@@ -505,7 +512,7 @@ supported_plots <- function() {
       secondary.type = "dichotomous",
       secondary.multi = TRUE,
       secondary.max = 4,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = NULL
     )
   )
@@ -584,9 +591,9 @@ get_plot_options <- function(data) {
 #' Wrapper to create plot based on provided type
 #'
 #' @param data data.frame
-#' @param pri primary variable
+#' @param x primary variable
-#' @param sec secondary variable
+#' @param y secondary variable
-#' @param ter tertiary variable
+#' @param z tertiary variable
 #' @param type plot type (derived from possible_plots() and matches custom function)
 #' @param ... ignored for now
 #'
@@ -596,36 +603,20 @@ get_plot_options <- function(data) {
 #' @export
 #'
 #' @examples
-#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
+#' create_plot(mtcars, "plot_violin", "mpg", "cyl")
-create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
+create_plot <- function(data, type, x, y, z = NULL, ...) {
-  if (!is.null(sec)) {
+  if (!any(y %in% names(data))) {
-    if (!any(sec %in% names(data))) {
+    y <- NULL
-      sec <- NULL
-    }
   }
 
-  if (!is.null(ter)) {
+  if (!z %in% names(data)) {
-    if (!ter %in% names(data)) {
+    z <- NULL
-      ter <- NULL
-    }
   }
 
-  parameters <- list(
+  do.call(
-    pri = pri,
-    sec = sec,
-    ter = ter,
-    ...
-  )
-
-  out <- do.call(
     type,
-    modifyList(parameters,list(data=data))
+    list(data, x, y, z, ...)
   )
-
-  code <- rlang::call2(type,!!!parameters,.ns = "FreesearchR")
-
-  attr(out,"code") <- code
-  out
 }
 
 #' Print label, and if missing print variable name
@@ -675,8 +666,8 @@ get_label <- function(data, var = NULL) {
 #'
 #' @examples
 #' "Lorem ipsum... you know the routine" |> line_break()
-#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
+#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(fixed = TRUE)
-line_break <- function(data, lineLength = 20, force = FALSE) {
+line_break <- function(data, lineLength = 20, fixed = FALSE) {
   if (isTRUE(force)) {
     gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
   } else {
@@ -707,7 +698,7 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
             .x
           }
         })() |>
-        align_axes() |>
+        allign_axes() |>
         patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
       if (!is.null(tag_levels)) {
         out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
@@ -722,21 +713,19 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
 }
 
 
-#' Aligns axes between plots
+#' Alligns axes between plots
 #'
 #' @param ... ggplot2 objects or list of ggplot2 objects
 #'
 #' @returns list of ggplot2 objects
 #' @export
 #'
-align_axes <- function(...) {
+allign_axes <- function(...) {
   # 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")
@@ -748,7 +737,7 @@ align_axes <- function(...) {
 
   suppressWarnings({
     p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
-  })
+    })
 }
 
 #' Extract and clean axis ranges

R/helpers.R

@@ -357,7 +357,7 @@ data_description <- function(data, data_text = "Data") {
   p_complete <- n_complete / n
 
   sprintf(
-    "%s has %s observations and %s variables, with %s (%s%%) complete cases.",
+    i18n("%s has %s observations and %s variables, with %s (%s%%) complete cases."),
     data_text,
     n,
     n_var,

R/plot_box.R

@@ -6,13 +6,13 @@
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
 #' mtcars |>
 #'   default_parsing() |>
-#'   plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+#'   plot_box(x = "mpg", y = "cyl", z = "gear")
-plot_box <- function(data, pri, sec, ter = NULL) {
+plot_box <- function(data, x, y, z = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
@@ -20,12 +20,13 @@ plot_box <- function(data, pri, sec, ter = NULL) {
   out <- lapply(ds, \(.ds){
     plot_box_single(
       data = .ds,
-      pri = pri,
+      x = x,
-      sec = sec
+      y = y
     )
   })
 
   wrap_plot_list(out)
+  # patchwork::wrap_plots(out,guides = "collect")
 }
 
 
@@ -40,18 +41,18 @@ plot_box <- function(data, pri, sec, ter = NULL) {
 #'
 #' @examples
 #' mtcars |> plot_box_single("mpg","cyl")
-plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
+plot_box_single <- function(data, x, y=NULL, seed = 2103) {
   set.seed(seed)
 
-  if (is.null(sec)) {
+  if (is.null(y)) {
-    sec <- "All"
+    y <- "All"
-    data[[y]] <- sec
+    data[[y]] <- y
   }
 
-  discrete <- !data_type(data[[sec]]) %in% "continuous"
+  discrete <- !data_type(data[[y]]) %in% "continuous"
 
   data |>
-    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(pri), y = !!dplyr::sym(sec), fill = !!dplyr::sym(sec), group = !!dplyr::sym(sec))) +
+    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
     ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
     ## THis could be optional in future
     ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9, width = 0.1, height = .5) +

R/plot_euler.R

@@ -76,16 +76,16 @@ ggeulerr <- function(
 #'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 #' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
 #' mtcars |> plot_euler("vs", "am", seed = 1)
-plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
+plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
   set.seed(seed = seed)
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
 
   out <- lapply(ds, \(.x){
-    .x[c(pri, sec)] |>
+    .x[c(x, y)] |>
       as.data.frame() |>
       plot_euler_single()
   })
@@ -95,6 +95,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   # patchwork::wrap_plots(out, guides = "collect")
 }
 
+?withCallingHandlers()
 #' Easily plot single euler diagrams
 #'
 #' @returns ggplot2 object

R/plot_hbar.R

@@ -6,10 +6,10 @@
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+#' mtcars |> plot_hbars(x = "carb", y = "cyl")
-#' mtcars |> plot_hbars(pri = "carb", sec = NULL)
+#' mtcars |> plot_hbars(x = "carb", y = NULL)
-plot_hbars <- function(data, pri, sec, ter = NULL) {
+plot_hbars <- function(data, x, y, z = NULL) {
-  out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)
+  out <- vertical_stacked_bars(data = data, score = x, group = y, strata = z)
 
   out
 }

R/plot_sankey.R

@@ -15,42 +15,42 @@
 #'   last = sample(c(TRUE, FALSE, FALSE), 100, TRUE)
 #' ) |>
 #'   sankey_ready("first", "last")
-sankey_ready <- function(data, pri, sec, numbers = "count", ...) {
+sankey_ready <- function(data, x, y, numbers = "count", ...) {
   ## TODO: Ensure ordering x and y
 
   ## Ensure all are factors
-  data[c(pri, sec)] <- data[c(pri, sec)] |>
+  data[c(x, y)] <- data[c(x, y)] |>
     dplyr::mutate(dplyr::across(!dplyr::where(is.factor), forcats::as_factor))
 
-  out <- dplyr::count(data, !!dplyr::sym(pri), !!dplyr::sym(sec))
+  out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y))
 
   out <- out |>
-    dplyr::group_by(!!dplyr::sym(pri)) |>
+    dplyr::group_by(!!dplyr::sym(x)) |>
     dplyr::mutate(gx.sum = sum(n)) |>
     dplyr::ungroup() |>
-    dplyr::group_by(!!dplyr::sym(sec)) |>
+    dplyr::group_by(!!dplyr::sym(y)) |>
     dplyr::mutate(gy.sum = sum(n)) |>
     dplyr::ungroup()
 
   if (numbers == "count") {
     out <- out |> dplyr::mutate(
-      lx = factor(paste0(!!dplyr::sym(pri), "\n(n=", gx.sum, ")")),
+      lx = factor(paste0(!!dplyr::sym(x), "\n(n=", gx.sum, ")")),
-      ly = factor(paste0(!!dplyr::sym(sec), "\n(n=", gy.sum, ")"))
+      ly = factor(paste0(!!dplyr::sym(y), "\n(n=", gy.sum, ")"))
     )
   } else if (numbers == "percentage") {
     out <- out |> dplyr::mutate(
-      lx = factor(paste0(!!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
+      lx = factor(paste0(!!dplyr::sym(x), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
-      ly = factor(paste0(!!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
+      ly = factor(paste0(!!dplyr::sym(y), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
     )
   }
 
-  if (is.factor(data[[pri]])) {
+  if (is.factor(data[[x]])) {
-    index <- match(levels(data[[pri]]), str_remove_last(levels(out$lx), "\n"))
+    index <- match(levels(data[[x]]), str_remove_last(levels(out$lx), "\n"))
     out$lx <- factor(out$lx, levels = levels(out$lx)[index])
   }
 
-  if (is.factor(data[[sec]])) {
+  if (is.factor(data[[y]])) {
-    index <- match(levels(data[[sec]]), str_remove_last(levels(out$ly), "\n"))
+    index <- match(levels(data[[y]]), str_remove_last(levels(out$ly), "\n"))
     out$ly <- factor(out$ly, levels = levels(out$ly)[index])
   }
 
@@ -75,15 +75,15 @@ str_remove_last <- function(data, pattern = "\n") {
 #' ds |> plot_sankey("first", "last")
 #' ds |> plot_sankey("first", "last", color.group = "y")
 #' ds |> plot_sankey("first", "last", z = "g", color.group = "y")
-plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "x", colors = NULL) {
+plot_sankey <- function(data, x, y, z = NULL, color.group = "x", colors = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
 
   out <- lapply(ds, \(.ds){
-    plot_sankey_single(.ds, x = pri, y = sec, color.group = color.group, colors = colors)
+    plot_sankey_single(.ds, x = x, y = y, color.group = color.group, colors = colors)
   })
 
   patchwork::wrap_plots(out)
@@ -112,10 +112,10 @@ default_theme <- function() {
 #'   first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)),
 #'   last = sample(c(TRUE, FALSE, FALSE), 100, TRUE)
 #' ) |>
-#'   plot_sankey_single("first", "last", color.group = "pri")
+#'   plot_sankey_single("first", "last", color.group = "x")
-plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) {
+plot_sankey_single <- function(data, x, y, color.group = c("x", "y"), colors = NULL, ...) {
   color.group <- match.arg(color.group)
-  data <- data |> sankey_ready(pri = pri, sec = sec, ...)
+  data <- data |> sankey_ready(x = x, y = y, ...)
 
   library(ggalluvial)
 
@@ -123,13 +123,13 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
   box.color <- "#1E4B66"
 
   if (is.null(colors)) {
-    if (color.group == "sec") {
+    if (color.group == "y") {
-      main.colors <- viridisLite::viridis(n = length(levels(data[[sec]])))
+      main.colors <- viridisLite::viridis(n = length(levels(data[[y]])))
-      secondary.colors <- rep(na.color, length(levels(data[[pri]])))
+      secondary.colors <- rep(na.color, length(levels(data[[x]])))
       label.colors <- Reduce(c, lapply(list(secondary.colors, rev(main.colors)), contrast_text))
     } else {
-      main.colors <- viridisLite::viridis(n = length(levels(data[[pri]])))
+      main.colors <- viridisLite::viridis(n = length(levels(data[[x]])))
-      secondary.colors <- rep(na.color, length(levels(data[[sec]])))
+      secondary.colors <- rep(na.color, length(levels(data[[y]])))
       label.colors <- Reduce(c, lapply(list(rev(main.colors), secondary.colors), contrast_text))
     }
     colors <- c(na.color, main.colors, secondary.colors)
@@ -137,33 +137,33 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
     label.colors <- contrast_text(colors)
   }
 
-  group_labels <- c(get_label(data, pri), get_label(data, sec)) |>
+  group_labels <- c(get_label(data, x), get_label(data, y)) |>
     sapply(line_break) |>
     unname()
 
   p <- ggplot2::ggplot(data, ggplot2::aes(y = n, axis1 = lx, axis2 = ly))
 
-  if (color.group == "sec") {
+  if (color.group == "y") {
     p <- p +
       ggalluvial::geom_alluvium(
-        ggplot2::aes(fill = !!dplyr::sym(sec), color = !!dplyr::sym(sec)),
+        ggplot2::aes(fill = !!dplyr::sym(y), color = !!dplyr::sym(y)),
         width = 1 / 16,
         alpha = .8,
         knot.pos = 0.4,
         curve_type = "sigmoid"
-      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)),
+      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(y)),
         size = 2,
         width = 1 / 3.4
       )
   } else {
     p <- p +
       ggalluvial::geom_alluvium(
-        ggplot2::aes(fill = !!dplyr::sym(pri), color = !!dplyr::sym(pri)),
+        ggplot2::aes(fill = !!dplyr::sym(x), color = !!dplyr::sym(x)),
         width = 1 / 16,
         alpha = .8,
         knot.pos = 0.4,
         curve_type = "sigmoid"
-      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)),
+      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(x)),
         size = 2,
         width = 1 / 3.4
       )

R/plot_scatter.R

@@ -6,24 +6,20 @@
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
+#' mtcars |> plot_scatter(x = "mpg", y = "wt")
-plot_scatter <- function(data, pri, sec, ter = NULL) {
+plot_scatter <- function(data, x, y, z = NULL) {
-  if (is.null(ter)) {
+  if (is.null(z)) {
     rempsyc::nice_scatter(
       data = data,
-      predictor = sec,
+      predictor = y,
-      response = pri,
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   } else {
     rempsyc::nice_scatter(
       data = data,
-      predictor = sec,
+      predictor = y,
-      response = pri,
+      response = x,
-      group = ter,
+      group = z, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   }
 }

R/plot_violin.R

@@ -6,10 +6,10 @@
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear")
+#' mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
-plot_violin <- function(data, pri, sec, ter = NULL) {
+plot_violin <- function(data, x, y, z = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
@@ -17,10 +17,8 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
   out <- lapply(ds, \(.ds){
     rempsyc::nice_violin(
       data = .ds,
-      group = sec,
+      group = y,
-      response = pri,
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   })
 

inst/apps/FreesearchR/app.R

@@ -10,7 +10,7 @@
 #### Current file: /Users/au301842/FreesearchR/R//app_version.R 
 ########
 
-app_version <- function()'Version: 25.4.3.250415_1627'
+app_version <- function()'Version: 25.4.3.250414_1342'
 
 
 ########
@@ -68,7 +68,7 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
     }
   }
 
-  suppressMessages(gtsummary::theme_gtsummary_journal(journal = theme))
+  gtsummary::theme_gtsummary_journal(journal = theme)
 
   args <- list(...)
 
@@ -207,8 +207,7 @@ data_correlations_server <- function(id,
         } else {
           out <- data()
         }
-        # out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
+        out |> dplyr::mutate(dplyr::across(tidyselect::everything(),as.numeric))
-        sapply(out,as.numeric)
         # as.numeric()
       })
 
@@ -262,9 +261,8 @@ data_correlations_server <- function(id,
 }
 
 correlation_pairs <- function(data, threshold = .8) {
-  data <- as.data.frame(data)[!sapply(as.data.frame(data), is.character)]
+  data <- data[!sapply(data, is.character)]
-  data <- sapply(data,\(.x)if (is.factor(.x)) as.numeric(.x) else .x) |> as.data.frame()
+  data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
-  # data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.factor), as.numeric))
   cor <- Hmisc::rcorr(as.matrix(data))
   r <- cor$r %>% as.table()
   d <- r |>
@@ -518,7 +516,7 @@ cut_var <- function(x, ...) {
 #' @export
 #' @name cut_var
 cut_var.default <- function(x, ...) {
-  base::cut(x, ...)
+  base::cut.default(x, ...)
 }
 
 #' @name cut_var
@@ -1081,6 +1079,36 @@ modal_cut_variable <- function(id,
 }
 
 
+#' @inheritParams shinyWidgets::WinBox
+#' @export
+#'
+#' @importFrom shinyWidgets WinBox wbOptions wbControls
+#' @importFrom htmltools tagList
+#' @rdname cut-variable
+winbox_cut_variable <- function(id,
+                                title = i18n("Convert Numeric to Factor"),
+                                options = shinyWidgets::wbOptions(),
+                                controls = shinyWidgets::wbControls()) {
+  ns <- NS(id)
+  WinBox(
+    title = title,
+    ui = tagList(
+      cut_variable_ui(id),
+      tags$div(
+        style = "display: none;",
+        textInput(inputId = ns("hidden"), label = NULL, value = genId())
+      )
+    ),
+    options = modifyList(
+      shinyWidgets::wbOptions(height = "750px", modal = TRUE),
+      options
+    ),
+    controls = controls,
+    auto_height = FALSE
+  )
+}
+
+
 #' @importFrom graphics abline axis hist par plot.new plot.window
 plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") {
   x <- data[[column]]
@@ -1099,7 +1127,6 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
 }
 
 
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//data_plots.R 
 ########
@@ -1194,7 +1221,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
     ),
     bslib::nav_panel(
       title = tab_title,
-      shiny::plotOutput(ns("plot"), height = "70vh"),
+      shiny::plotOutput(ns("plot"),height = "70vh"),
       shiny::tags$br(),
       shiny::tags$br(),
       shiny::htmlOutput(outputId = ns("code_plot"))
@@ -1221,7 +1248,7 @@ data_visuals_server <- function(id,
       rv <- shiny::reactiveValues(
         plot.params = NULL,
         plot = NULL,
-        code = NULL
+        code=NULL
       )
 
       # ## --- New attempt
@@ -1322,7 +1349,7 @@ data_visuals_server <- function(id,
         shiny::req(data())
         columnSelectInput(
           inputId = ns("primary"),
-          col_subset = names(data())[sapply(data(), data_type) != "text"],
+          col_subset=names(data())[sapply(data(),data_type)!="text"],
           data = data,
           placeholder = "Select variable",
           label = "Response variable",
@@ -1424,30 +1451,37 @@ data_visuals_server <- function(id,
 
       shiny::observeEvent(input$act_plot,
         {
-          if (NROW(data()) > 0) {
+          if (NROW(data())>0){
-            tryCatch(
+          tryCatch(
-              {
+            {
-                parameters <- list(
+              parameters <- list(
-                  type = rv$plot.params()[["fun"]],
+                type = rv$plot.params()[["fun"]],
-                  pri = input$primary,
+                x = input$primary,
-                  sec = input$secondary,
+                y = input$secondary,
-                  ter = input$tertiary
+                z = input$tertiary
-                )
+              )
 
-                shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
+              shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
-                  rv$plot <- rlang::exec(create_plot, !!!append_list(data(), parameters, "data"))
+                rv$plot <- rlang::exec(create_plot, !!!append_list(data(),parameters,"data"))
-                })
+              # rv$plot <- create_plot(
+              #   data = data(),
+              #   type = rv$plot.params()[["fun"]],
+              #   x = input$primary,
+              #   y = input$secondary,
+              #   z = input$tertiary
+              # )
+              })
 
-                rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
+              rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
-              },
+
-              # warning = function(warn) {
+            },
-              #   showNotification(paste0(warn), type = "warning")
+            # warning = function(warn) {
-              # },
+            #   showNotification(paste0(warn), type = "warning")
-              error = function(err) {
+            # },
-                showNotification(paste0(err), type = "err")
+            error = function(err) {
-              }
+              showNotification(paste0(err), type = "err")
-            )
+            }
-          }
+          )}
         },
         ignoreInit = TRUE
       )
@@ -1514,7 +1548,7 @@ all_but <- function(data, ...) {
 #'
 #' @examples
 #' default_parsing(mtcars) |> subset_types("ordinal")
-#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+#' default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal" ,"categorical"))
 #' #' default_parsing(mtcars) |> subset_types("factor",class)
 subset_types <- function(data, types, type.fun = data_type) {
   data[sapply(data, type.fun) %in% types]
@@ -1549,21 +1583,21 @@ supported_plots <- function() {
       fun = "plot_hbars",
       descr = "Stacked horizontal bars",
       note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = "none"
     ),
     plot_violin = list(
       fun = "plot_violin",
       descr = "Violin plot",
       note = "A modern alternative to the classic boxplot to visualise data distribution",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime","continuous", "dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
       secondary.extra = "none",
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical")
     ),
     # plot_ridge = list(
     #   descr = "Ridge plot",
@@ -1577,30 +1611,30 @@ supported_plots <- function() {
       fun = "plot_sankey",
       descr = "Sankey plot",
       note = "A way of visualising change between groups",
-      primary.type = c("dichotomous", "ordinal", "categorical"),
+      primary.type = c("dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
       secondary.extra = NULL,
-      tertiary.type = c("dichotomous", "ordinal", "categorical")
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical")
     ),
     plot_scatter = list(
       fun = "plot_scatter",
       descr = "Scatter plot",
       note = "A classic way of showing the association between to variables",
-      primary.type = c("datatime", "continuous"),
+      primary.type = c("datatime","continuous"),
-      secondary.type = c("datatime", "continuous", "ordinal", "categorical"),
+      secondary.type = c("datatime","continuous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = NULL
     ),
     plot_box = list(
       fun = "plot_box",
       descr = "Box plot",
       note = "A classic way to plot data distribution by groups",
-      primary.type = c("datatime", "continuous", "dichotomous", "ordinal", "categorical"),
+      primary.type = c("datatime","continuous", "dichotomous", "ordinal" ,"categorical"),
-      secondary.type = c("dichotomous", "ordinal", "categorical"),
+      secondary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.multi = FALSE,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = "none"
     ),
     plot_euler = list(
@@ -1611,7 +1645,7 @@ supported_plots <- function() {
       secondary.type = "dichotomous",
       secondary.multi = TRUE,
       secondary.max = 4,
-      tertiary.type = c("dichotomous", "ordinal", "categorical"),
+      tertiary.type = c("dichotomous", "ordinal" ,"categorical"),
       secondary.extra = NULL
     )
   )
@@ -1690,9 +1724,9 @@ get_plot_options <- function(data) {
 #' Wrapper to create plot based on provided type
 #'
 #' @param data data.frame
-#' @param pri primary variable
+#' @param x primary variable
-#' @param sec secondary variable
+#' @param y secondary variable
-#' @param ter tertiary variable
+#' @param z tertiary variable
 #' @param type plot type (derived from possible_plots() and matches custom function)
 #' @param ... ignored for now
 #'
@@ -1702,36 +1736,20 @@ get_plot_options <- function(data) {
 #' @export
 #'
 #' @examples
-#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
+#' create_plot(mtcars, "plot_violin", "mpg", "cyl")
-create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
+create_plot <- function(data, type, x, y, z = NULL, ...) {
-  if (!is.null(sec)) {
+  if (!any(y %in% names(data))) {
-    if (!any(sec %in% names(data))) {
+    y <- NULL
-      sec <- NULL
-    }
   }
 
-  if (!is.null(ter)) {
+  if (!z %in% names(data)) {
-    if (!ter %in% names(data)) {
+    z <- NULL
-      ter <- NULL
-    }
   }
 
-  parameters <- list(
+  do.call(
-    pri = pri,
-    sec = sec,
-    ter = ter,
-    ...
-  )
-
-  out <- do.call(
     type,
-    modifyList(parameters,list(data=data))
+    list(data, x, y, z, ...)
   )
-
-  code <- rlang::call2(type,!!!parameters,.ns = "FreesearchR")
-
-  attr(out,"code") <- code
-  out
 }
 
 #' Print label, and if missing print variable name
@@ -1781,8 +1799,8 @@ get_label <- function(data, var = NULL) {
 #'
 #' @examples
 #' "Lorem ipsum... you know the routine" |> line_break()
-#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
+#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(fixed = TRUE)
-line_break <- function(data, lineLength = 20, force = FALSE) {
+line_break <- function(data, lineLength = 20, fixed = FALSE) {
   if (isTRUE(force)) {
     gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
   } else {
@@ -1813,7 +1831,7 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
             .x
           }
         })() |>
-        align_axes() |>
+        allign_axes() |>
         patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
       if (!is.null(tag_levels)) {
         out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
@@ -1828,21 +1846,19 @@ wrap_plot_list <- function(data, tag_levels = NULL) {
 }
 
 
-#' Aligns axes between plots
+#' Alligns axes between plots
 #'
 #' @param ... ggplot2 objects or list of ggplot2 objects
 #'
 #' @returns list of ggplot2 objects
 #' @export
 #'
-align_axes <- function(...) {
+allign_axes <- function(...) {
   # 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")
@@ -1854,7 +1870,7 @@ align_axes <- function(...) {
 
   suppressWarnings({
     p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
-  })
+    })
 }
 
 #' Extract and clean axis ranges
@@ -2197,8 +2213,8 @@ overview_vars <- function(data) {
   data <- as.data.frame(data)
 
   dplyr::tibble(
-    icon = data_type(data),
+    class = get_classes(data),
-    type = icon,
+    type = data_type(data),
     name = names(data),
     n_missing = unname(colSums(is.na(data))),
     p_complete = 1 - n_missing / nrow(data),
@@ -2230,7 +2246,7 @@ create_overview_datagrid <- function(data,...) {
 
   std_names <- c(
     "Name" = "name",
-    "Icon" = "icon",
+    "Class" = "class",
     "Type" = "type",
     "Missings" = "n_missing",
     "Complete" = "p_complete",
@@ -2268,7 +2284,7 @@ create_overview_datagrid <- function(data,...) {
 
   grid <- toastui::grid_columns(
     grid = grid,
-    columns = "icon",
+    columns = "class",
     header = " ",
     align = "center",sortable = FALSE,
     width = 40
@@ -2276,8 +2292,7 @@ create_overview_datagrid <- function(data,...) {
 
   grid <- add_class_icon(
     grid = grid,
-    column = "icon",
+    column = "class"
-    fun = type_icons
   )
 
   grid <- toastui::grid_format(
@@ -2314,14 +2329,32 @@ create_overview_datagrid <- function(data,...) {
 #'   overview_vars() |>
 #'   toastui::datagrid() |>
 #'   add_class_icon()
-add_class_icon <- function(grid, column = "class", fun=class_icons) {
+add_class_icon <- function(grid, column = "class") {
   out <- toastui::grid_format(
     grid = grid,
     column = column,
     formatter = function(value) {
       lapply(
         X = value,
-        FUN = fun
+        FUN = function(x) {
+          if (identical(x, "numeric")) {
+            shiny::icon("calculator")
+          } else if (identical(x, "factor")) {
+            shiny::icon("chart-simple")
+          } else if (identical(x, "integer")) {
+            shiny::icon("arrow-down-1-9")
+          } else if (identical(x, "character")) {
+            shiny::icon("arrow-down-a-z")
+          } else if (identical(x, "logical")) {
+            shiny::icon("toggle-off")
+          } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
+            shiny::icon("calendar-days")
+          } else if ("hms" %in% x) {
+            shiny::icon("clock")
+          } else {
+            shiny::icon("table")
+          }
+        }
       )
     }
   )
@@ -2335,74 +2368,6 @@ add_class_icon <- function(grid, column = "class", fun=class_icons) {
 }
 
 
-#' Get data class icons
-#'
-#' @param x character vector of data classes
-#'
-#' @returns
-#' @export
-#'
-#' @examples
-#' "numeric" |> class_icons()
-#' default_parsing(mtcars) |> sapply(class) |> class_icons()
-class_icons <- function(x) {
-  if (length(x)>1){
-    sapply(x,class_icons)
-  } else {
-  if (identical(x, "numeric")) {
-    shiny::icon("calculator")
-  } else if (identical(x, "factor")) {
-    shiny::icon("chart-simple")
-  } else if (identical(x, "integer")) {
-    shiny::icon("arrow-down-1-9")
-  } else if (identical(x, "character")) {
-    shiny::icon("arrow-down-a-z")
-  } else if (identical(x, "logical")) {
-    shiny::icon("toggle-off")
-  } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
-    shiny::icon("calendar-days")
-  } else if ("hms" %in% x) {
-    shiny::icon("clock")
-  } else {
-    shiny::icon("table")
-  }}
-}
-
-#' Get data type icons
-#'
-#' @param x character vector of data classes
-#'
-#' @returns
-#' @export
-#'
-#' @examples
-#' "ordinal" |> type_icons()
-#' default_parsing(mtcars) |> sapply(data_type) |> type_icons()
-type_icons <- function(x) {
-  if (length(x)>1){
-    sapply(x,class_icons)
-  } else {
-    if (identical(x, "continuous")) {
-      shiny::icon("calculator")
-    } else if (identical(x, "categorical")) {
-      shiny::icon("chart-simple")
-    } else if (identical(x, "ordinal")) {
-      shiny::icon("arrow-down-1-9")
-    } else if (identical(x, "text")) {
-      shiny::icon("arrow-down-a-z")
-    } else if (identical(x, "dichotomous")) {
-      shiny::icon("toggle-off")
-    } else if (identical(x,"datetime")) {
-      shiny::icon("calendar-days")
-    } else if (identical(x,"id")) {
-      shiny::icon("id-card")
-    } else {
-      shiny::icon("table")
-    }
-    }
-}
-
-
 ########
 #### Current file: /Users/au301842/FreesearchR/R//helpers.R 
 ########
@@ -2766,7 +2731,7 @@ data_description <- function(data, data_text = "Data") {
   p_complete <- n_complete / n
 
   sprintf(
-    "%s has %s observations and %s variables, with %s (%s%%) complete cases.",
+    i18n("%s has %s observations and %s variables, with %s (%s%%) complete cases."),
     data_text,
     n,
     n_var,
@@ -3668,13 +3633,13 @@ launch_FreesearchR <- function(...){
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
 #' mtcars |>
 #'   default_parsing() |>
-#'   plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+#'   plot_box(x = "mpg", y = "cyl", z = "gear")
-plot_box <- function(data, pri, sec, ter = NULL) {
+plot_box <- function(data, x, y, z = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
@@ -3682,12 +3647,13 @@ plot_box <- function(data, pri, sec, ter = NULL) {
   out <- lapply(ds, \(.ds){
     plot_box_single(
       data = .ds,
-      pri = pri,
+      x = x,
-      sec = sec
+      y = y
     )
   })
 
   wrap_plot_list(out)
+  # patchwork::wrap_plots(out,guides = "collect")
 }
 
 
@@ -3702,18 +3668,18 @@ plot_box <- function(data, pri, sec, ter = NULL) {
 #'
 #' @examples
 #' mtcars |> plot_box_single("mpg","cyl")
-plot_box_single <- function(data, pri, sec=NULL, seed = 2103) {
+plot_box_single <- function(data, x, y=NULL, seed = 2103) {
   set.seed(seed)
 
-  if (is.null(sec)) {
+  if (is.null(y)) {
-    sec <- "All"
+    y <- "All"
-    data[[y]] <- sec
+    data[[y]] <- y
   }
 
-  discrete <- !data_type(data[[sec]]) %in% "continuous"
+  discrete <- !data_type(data[[y]]) %in% "continuous"
 
   data |>
-    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(pri), y = !!dplyr::sym(sec), fill = !!dplyr::sym(sec), group = !!dplyr::sym(sec))) +
+    ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
     ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
     ## THis could be optional in future
     ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9, width = 0.1, height = .5) +
@@ -3823,16 +3789,16 @@ ggeulerr <- function(
 #'   D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 #' ) |> plot_euler("A", c("B", "C"), "D", seed = 4)
 #' mtcars |> plot_euler("vs", "am", seed = 1)
-plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
+plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
   set.seed(seed = seed)
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
 
   out <- lapply(ds, \(.x){
-    .x[c(pri, sec)] |>
+    .x[c(x, y)] |>
       as.data.frame() |>
       plot_euler_single()
   })
@@ -3842,6 +3808,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
   # patchwork::wrap_plots(out, guides = "collect")
 }
 
+?withCallingHandlers()
 #' Easily plot single euler diagrams
 #'
 #' @returns ggplot2 object
@@ -3887,10 +3854,10 @@ plot_euler_single <- function(data) {
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+#' mtcars |> plot_hbars(x = "carb", y = "cyl")
-#' mtcars |> plot_hbars(pri = "carb", sec = NULL)
+#' mtcars |> plot_hbars(x = "carb", y = NULL)
-plot_hbars <- function(data, pri, sec, ter = NULL) {
+plot_hbars <- function(data, x, y, z = NULL) {
-  out <- vertical_stacked_bars(data = data, score = pri, group = sec, strata = ter)
+  out <- vertical_stacked_bars(data = data, score = x, group = y, strata = z)
 
   out
 }
@@ -4031,42 +3998,42 @@ plot_ridge <- function(data, x, y, z = NULL, ...) {
 #'   last = sample(c(TRUE, FALSE, FALSE), 100, TRUE)
 #' ) |>
 #'   sankey_ready("first", "last")
-sankey_ready <- function(data, pri, sec, numbers = "count", ...) {
+sankey_ready <- function(data, x, y, numbers = "count", ...) {
   ## TODO: Ensure ordering x and y
 
   ## Ensure all are factors
-  data[c(pri, sec)] <- data[c(pri, sec)] |>
+  data[c(x, y)] <- data[c(x, y)] |>
     dplyr::mutate(dplyr::across(!dplyr::where(is.factor), forcats::as_factor))
 
-  out <- dplyr::count(data, !!dplyr::sym(pri), !!dplyr::sym(sec))
+  out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y))
 
   out <- out |>
-    dplyr::group_by(!!dplyr::sym(pri)) |>
+    dplyr::group_by(!!dplyr::sym(x)) |>
     dplyr::mutate(gx.sum = sum(n)) |>
     dplyr::ungroup() |>
-    dplyr::group_by(!!dplyr::sym(sec)) |>
+    dplyr::group_by(!!dplyr::sym(y)) |>
     dplyr::mutate(gy.sum = sum(n)) |>
     dplyr::ungroup()
 
   if (numbers == "count") {
     out <- out |> dplyr::mutate(
-      lx = factor(paste0(!!dplyr::sym(pri), "\n(n=", gx.sum, ")")),
+      lx = factor(paste0(!!dplyr::sym(x), "\n(n=", gx.sum, ")")),
-      ly = factor(paste0(!!dplyr::sym(sec), "\n(n=", gy.sum, ")"))
+      ly = factor(paste0(!!dplyr::sym(y), "\n(n=", gy.sum, ")"))
     )
   } else if (numbers == "percentage") {
     out <- out |> dplyr::mutate(
-      lx = factor(paste0(!!dplyr::sym(pri), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
+      lx = factor(paste0(!!dplyr::sym(x), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
-      ly = factor(paste0(!!dplyr::sym(sec), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
+      ly = factor(paste0(!!dplyr::sym(y), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
     )
   }
 
-  if (is.factor(data[[pri]])) {
+  if (is.factor(data[[x]])) {
-    index <- match(levels(data[[pri]]), str_remove_last(levels(out$lx), "\n"))
+    index <- match(levels(data[[x]]), str_remove_last(levels(out$lx), "\n"))
     out$lx <- factor(out$lx, levels = levels(out$lx)[index])
   }
 
-  if (is.factor(data[[sec]])) {
+  if (is.factor(data[[y]])) {
-    index <- match(levels(data[[sec]]), str_remove_last(levels(out$ly), "\n"))
+    index <- match(levels(data[[y]]), str_remove_last(levels(out$ly), "\n"))
     out$ly <- factor(out$ly, levels = levels(out$ly)[index])
   }
 
@@ -4091,15 +4058,15 @@ str_remove_last <- function(data, pattern = "\n") {
 #' ds |> plot_sankey("first", "last")
 #' ds |> plot_sankey("first", "last", color.group = "y")
 #' ds |> plot_sankey("first", "last", z = "g", color.group = "y")
-plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "x", colors = NULL) {
+plot_sankey <- function(data, x, y, z = NULL, color.group = "x", colors = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
 
   out <- lapply(ds, \(.ds){
-    plot_sankey_single(.ds, x = pri, y = sec, color.group = color.group, colors = colors)
+    plot_sankey_single(.ds, x = x, y = y, color.group = color.group, colors = colors)
   })
 
   patchwork::wrap_plots(out)
@@ -4128,10 +4095,10 @@ default_theme <- function() {
 #'   first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)),
 #'   last = sample(c(TRUE, FALSE, FALSE), 100, TRUE)
 #' ) |>
-#'   plot_sankey_single("first", "last", color.group = "pri")
+#'   plot_sankey_single("first", "last", color.group = "x")
-plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) {
+plot_sankey_single <- function(data, x, y, color.group = c("x", "y"), colors = NULL, ...) {
   color.group <- match.arg(color.group)
-  data <- data |> sankey_ready(pri = pri, sec = sec, ...)
+  data <- data |> sankey_ready(x = x, y = y, ...)
 
   library(ggalluvial)
 
@@ -4139,13 +4106,13 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
   box.color <- "#1E4B66"
 
   if (is.null(colors)) {
-    if (color.group == "sec") {
+    if (color.group == "y") {
-      main.colors <- viridisLite::viridis(n = length(levels(data[[sec]])))
+      main.colors <- viridisLite::viridis(n = length(levels(data[[y]])))
-      secondary.colors <- rep(na.color, length(levels(data[[pri]])))
+      secondary.colors <- rep(na.color, length(levels(data[[x]])))
       label.colors <- Reduce(c, lapply(list(secondary.colors, rev(main.colors)), contrast_text))
     } else {
-      main.colors <- viridisLite::viridis(n = length(levels(data[[pri]])))
+      main.colors <- viridisLite::viridis(n = length(levels(data[[x]])))
-      secondary.colors <- rep(na.color, length(levels(data[[sec]])))
+      secondary.colors <- rep(na.color, length(levels(data[[y]])))
       label.colors <- Reduce(c, lapply(list(rev(main.colors), secondary.colors), contrast_text))
     }
     colors <- c(na.color, main.colors, secondary.colors)
@@ -4153,33 +4120,33 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
     label.colors <- contrast_text(colors)
   }
 
-  group_labels <- c(get_label(data, pri), get_label(data, sec)) |>
+  group_labels <- c(get_label(data, x), get_label(data, y)) |>
     sapply(line_break) |>
     unname()
 
   p <- ggplot2::ggplot(data, ggplot2::aes(y = n, axis1 = lx, axis2 = ly))
 
-  if (color.group == "sec") {
+  if (color.group == "y") {
     p <- p +
       ggalluvial::geom_alluvium(
-        ggplot2::aes(fill = !!dplyr::sym(sec), color = !!dplyr::sym(sec)),
+        ggplot2::aes(fill = !!dplyr::sym(y), color = !!dplyr::sym(y)),
         width = 1 / 16,
         alpha = .8,
         knot.pos = 0.4,
         curve_type = "sigmoid"
-      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(sec)),
+      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(y)),
         size = 2,
         width = 1 / 3.4
       )
   } else {
     p <- p +
       ggalluvial::geom_alluvium(
-        ggplot2::aes(fill = !!dplyr::sym(pri), color = !!dplyr::sym(pri)),
+        ggplot2::aes(fill = !!dplyr::sym(x), color = !!dplyr::sym(x)),
         width = 1 / 16,
         alpha = .8,
         knot.pos = 0.4,
         curve_type = "sigmoid"
-      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(pri)),
+      ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(x)),
         size = 2,
         width = 1 / 3.4
       )
@@ -4228,24 +4195,20 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
+#' mtcars |> plot_scatter(x = "mpg", y = "wt")
-plot_scatter <- function(data, pri, sec, ter = NULL) {
+plot_scatter <- function(data, x, y, z = NULL) {
-  if (is.null(ter)) {
+  if (is.null(z)) {
     rempsyc::nice_scatter(
       data = data,
-      predictor = sec,
+      predictor = y,
-      response = pri,
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   } else {
     rempsyc::nice_scatter(
       data = data,
-      predictor = sec,
+      predictor = y,
-      response = pri,
+      response = x,
-      group = ter,
+      group = z, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   }
 }
@@ -4263,10 +4226,10 @@ plot_scatter <- function(data, pri, sec, ter = NULL) {
 #' @name data-plots
 #'
 #' @examples
-#' mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear")
+#' mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
-plot_violin <- function(data, pri, sec, ter = NULL) {
+plot_violin <- function(data, x, y, z = NULL) {
-  if (!is.null(ter)) {
+  if (!is.null(z)) {
-    ds <- split(data, data[ter])
+    ds <- split(data, data[z])
   } else {
     ds <- list(data)
   }
@@ -4274,10 +4237,8 @@ plot_violin <- function(data, pri, sec, ter = NULL) {
   out <- lapply(ds, \(.ds){
     rempsyc::nice_violin(
       data = .ds,
-      group = sec,
+      group = y,
-      response = pri,
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
-      xtitle = get_label(data, var = sec),
-      ytitle = get_label(data, var = pri)
     )
   })
 

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

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 13611288
-bundleId: 10119038
+bundleId: 10111887
 url: https://agdamsbo.shinyapps.io/freesearcheR/
 version: 1

man/add_class_icon.Rd

@@ -4,7 +4,7 @@
 \alias{add_class_icon}
 \title{Convert class grid column to icon}
 \usage{
-add_class_icon(grid, column = "class", fun = class_icons)
+add_class_icon(grid, column = "class")
 }
 \arguments{
 \item{grid}{grid}

man/allign_axes.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/data_plots.R
-\name{align_axes}
+\name{allign_axes}
-\alias{align_axes}
+\alias{allign_axes}
-\title{Aligns axes between plots}
+\title{Alligns axes between plots}
 \usage{
-align_axes(...)
+allign_axes(...)
 }
 \arguments{
 \item{...}{ggplot2 objects or list of ggplot2 objects}
@@ -13,5 +13,5 @@ align_axes(...)
 list of ggplot2 objects
 }
 \description{
-Aligns axes between plots
+Alligns axes between plots
 }

man/argsstring2list.Rd

@@ -15,7 +15,3 @@ list
 \description{
 Idea from the answer: https://stackoverflow.com/a/62979238
 }
-\examples{
-argsstring2list("A=1:5,b=2:4")
-
-}

man/class_icons.Rd

@@ -1,21 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data-summary.R
-\name{class_icons}
-\alias{class_icons}
-\title{Get data class icons}
-\usage{
-class_icons(x)
-}
-\arguments{
-\item{x}{character vector of data classes}
-}
-\value{
-list
-}
-\description{
-Get data class icons
-}
-\examples{
-"numeric" |> class_icons()|> str()
-mtcars |> sapply(class) |> class_icons() |> str()
-}

man/create_baseline.Rd

@@ -32,5 +32,4 @@ Create a baseline table
 }
 \examples{
 mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
-create_baseline(default_parsing(mtcars), by.var = "am", add.p = FALSE, add.overall = FALSE, theme = "lancet")
 }

man/cut-variable.Rd

@@ -5,6 +5,7 @@
 \alias{cut_variable_ui}
 \alias{cut_variable_server}
 \alias{modal_cut_variable}
+\alias{winbox_cut_variable}
 \title{Module to Convert Numeric to Factor}
 \usage{
 cut_variable_ui(id)
@@ -18,6 +19,13 @@ modal_cut_variable(
   size = "l",
   footer = NULL
 )
+
+winbox_cut_variable(
+  id,
+  title = i18n("Convert Numeric to Factor"),
+  options = shinyWidgets::wbOptions(),
+  controls = shinyWidgets::wbControls()
+)
 }
 \arguments{
 \item{id}{Module ID.}
@@ -39,6 +47,10 @@ pass \code{\link[bslib:bs_theme]{bslib::bs_theme()}} to the \code{theme} argumen
 like \code{\link[shiny:fluidPage]{fluidPage()}}).}
 
 \item{footer}{UI for footer. Use \code{NULL} for no footer.}
+
+\item{options}{List of options, see \code{\link[shinyWidgets:wbOptions]{wbOptions()}}.}
+
+\item{controls}{List of controls, see \code{\link[shinyWidgets:wbControls]{wbControls()}}.}
 }
 \value{
 A \code{\link[shiny:reactive]{shiny::reactive()}} function returning the data.

man/data-plots.Rd

@@ -20,23 +20,23 @@ data_visuals_ui(id, tab_title = "Plots", ...)
 
 data_visuals_server(id, data, ...)
 
-create_plot(data, type, pri, sec, ter = NULL, ...)
+create_plot(data, type, x, y, z = NULL, ...)
 
-plot_box(data, pri, sec, ter = NULL)
+plot_box(data, x, y, z = NULL)
 
-plot_box_single(data, pri, sec = NULL, seed = 2103)
+plot_box_single(data, x, y = NULL, seed = 2103)
 
-plot_hbars(data, pri, sec, ter = NULL)
+plot_hbars(data, x, y, z = NULL)
 
 plot_ridge(data, x, y, z = NULL, ...)
 
-sankey_ready(data, pri, sec, numbers = "count", ...)
+sankey_ready(data, x, y, numbers = "count", ...)
 
-plot_sankey(data, pri, sec, ter = NULL, color.group = "x", colors = NULL)
+plot_sankey(data, x, y, z = NULL, color.group = "x", colors = NULL)
 
-plot_scatter(data, pri, sec, ter = NULL)
+plot_scatter(data, x, y, z = NULL)
 
-plot_violin(data, pri, sec, ter = NULL)
+plot_violin(data, x, y, z = NULL)
 }
 \arguments{
 \item{id}{Module id. (Use 'ns("id")')}
@@ -47,11 +47,11 @@ plot_violin(data, pri, sec, ter = NULL)
 
 \item{type}{plot type (derived from possible_plots() and matches custom function)}
 
-\item{pri}{primary variable}
+\item{x}{primary variable}
 
-\item{sec}{secondary variable}
+\item{y}{secondary variable}
 
-\item{ter}{tertiary variable}
+\item{z}{tertiary variable}
 }
 \value{
 Shiny ui module
@@ -98,14 +98,14 @@ Beautiful violin plot
 Beatiful violin plot
 }
 \examples{
-create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
+create_plot(mtcars, "plot_violin", "mpg", "cyl")
-mtcars |> plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
 mtcars |>
   default_parsing() |>
-  plot_box(pri = "mpg", sec = "cyl", ter = "gear")
+  plot_box(x = "mpg", y = "cyl", z = "gear")
 mtcars |> plot_box_single("mpg","cyl")
-mtcars |> plot_hbars(pri = "carb", sec = "cyl")
+mtcars |> plot_hbars(x = "carb", y = "cyl")
-mtcars |> plot_hbars(pri = "carb", sec = NULL)
+mtcars |> plot_hbars(x = "carb", y = NULL)
 mtcars |>
   default_parsing() |>
   plot_ridge(x = "mpg", y = "cyl")
@@ -123,6 +123,6 @@ ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_fac
 ds |> plot_sankey("first", "last")
 ds |> plot_sankey("first", "last", color.group = "y")
 ds |> plot_sankey("first", "last", z = "g", color.group = "y")
-mtcars |> plot_scatter(pri = "mpg", sec = "wt")
+mtcars |> plot_scatter(x = "mpg", y = "wt")
-mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear")
+mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
 }

man/data_type_filter.Rd

@@ -18,13 +18,8 @@ data.frame
 Filter function to filter data set by variable type
 }
 \examples{
-default_parsing(mtcars) |>
+default_parsing(mtcars) |> data_type_filter(type=c("categorical","continuous")) |> attributes()
-  data_type_filter(type = c("categorical", "continuous")) |>
-  attributes()
-default_parsing(mtcars) |>
-  data_type_filter(type = NULL) |>
-  attributes()
 \dontrun{
-default_parsing(mtcars) |> data_type_filter(type = c("test", "categorical", "continuous"))
+default_parsing(mtcars) |> data_type_filter(type=c("test","categorical","continuous"))
 }
 }

man/expression_string.Rd

@@ -17,7 +17,7 @@ Deparses expression as string, substitutes native pipe and adds assign
 }
 \examples{
 list(
-  as.symbol(paste0("mtcars$", "mpg")),
+as.symbol(paste0("mtcars$","mpg")),
   rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
   rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
 ) |>

man/factorize.Rd

@@ -17,6 +17,3 @@ data.frame
 \description{
 Factorize variables in data.frame
 }
-\examples{
-factorize(mtcars,names(mtcars))
-}

man/line_break.Rd

@@ -4,7 +4,7 @@
 \alias{line_break}
 \title{Line breaking at given number of characters for nicely plotting labels}
 \usage{
-line_break(data, lineLength = 20, force = FALSE)
+line_break(data, lineLength = 20, fixed = FALSE)
 }
 \arguments{
 \item{data}{string}
@@ -22,5 +22,5 @@ Line breaking at given number of characters for nicely plotting labels
 }
 \examples{
 "Lorem ipsum... you know the routine" |> line_break()
-paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
+paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(fixed = TRUE)
 }

man/plot_euler.Rd

@@ -4,18 +4,18 @@
 \alias{plot_euler}
 \title{Easily plot euler diagrams}
 \usage{
-plot_euler(data, pri, sec, ter = NULL, seed = 2103)
+plot_euler(data, x, y, z = NULL, seed = 2103)
 }
 \arguments{
 \item{data}{data}
 
-\item{seed}{seed}
-
 \item{x}{name of main variable}
 
 \item{y}{name of secondary variables}
 
 \item{z}{grouping variable}
+
+\item{seed}{seed}
 }
 \value{
 patchwork object

man/plot_sankey_single.Rd

@@ -4,14 +4,7 @@
 \alias{plot_sankey_single}
 \title{Beautiful sankey plot}
 \usage{
-plot_sankey_single(
+plot_sankey_single(data, x, y, color.group = c("x", "y"), colors = NULL, ...)
-  data,
-  pri,
-  sec,
-  color.group = c("pri", "sec"),
-  colors = NULL,
-  ...
-)
 }
 \arguments{
 \item{color.group}{set group to colour by. "x" or "y".}
@@ -36,5 +29,5 @@ data.frame(
   first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)),
   last = sample(c(TRUE, FALSE, FALSE), 100, TRUE)
 ) |>
-  plot_sankey_single("first", "last", color.group = "pri")
+  plot_sankey_single("first", "last", color.group = "x")
 }

man/remove_empty_attr.Rd

@@ -15,12 +15,3 @@ data of same class as input
 \description{
 Remove empty/NA attributes
 }
-\examples{
-ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> dplyr::bind_cols()
-ds |>
-  remove_empty_attr() |>
-  str()
- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label")) |> remove_empty_attr() |>
-  str()
-
-}

man/remove_na_attr.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{remove_na_attr}
+\alias{remove_na_attr}
+\title{Remove NA labels}
+\usage{
+remove_na_attr(data, attr = "label")
+}
+\arguments{
+\item{data}{data}
+}
+\value{
+data.frame
+}
+\description{
+Remove NA labels
+}
+\examples{
+ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label"))
+ds |>
+  remove_na_attr() |>
+  str()
+}

man/remove_nested_list.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/helpers.R
 \name{remove_nested_list}
 \alias{remove_nested_list}
-\title{Very simple function to remove nested lists, like when uploading .rds}
+\title{Very simple function to remove nested lists, lik ewhen uploading .rds}
 \usage{
 remove_nested_list(data)
 }
@@ -13,7 +13,7 @@ remove_nested_list(data)
 data.frame
 }
 \description{
-Very simple function to remove nested lists, like when uploading .rds
+Very simple function to remove nested lists, lik ewhen uploading .rds
 }
 \examples{
 dplyr::tibble(a = 1:10, b = rep(list("a"), 10)) |> remove_nested_list()

man/subset_types.Rd

@@ -21,6 +21,6 @@ Easily subset by data type function
 }
 \examples{
 default_parsing(mtcars) |> subset_types("ordinal")
-default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
+default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal" ,"categorical"))
 #' default_parsing(mtcars) |> subset_types("factor",class)
 }

man/type_icons.Rd

@@ -1,21 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data-summary.R
-\name{type_icons}
-\alias{type_icons}
-\title{Get data type icons}
-\usage{
-type_icons(x)
-}
-\arguments{
-\item{x}{character vector of data classes}
-}
-\value{
-list
-}
-\description{
-Get data type icons
-}
-\examples{
-"ordinal" |> type_icons()
-default_parsing(mtcars) |> sapply(data_type) |> type_icons()
-}

tests/testthat.R

@@ -8,6 +8,5 @@
 
 library(testthat)
 library(FreesearchR)
-library(shiny)
 
 test_check("FreesearchR")

tests/testthat/_snaps/contrast_text.md

@@ -1,23 +0,0 @@
-# Contrasting works
-
-    Code
-      contrast_text(colors)
-    Output
-      [1] "black" "white" "white" "white" "black" "white"
-
----
-
-    Code
-      contrast_text(colors, light_text = "blue", dark_text = "grey10", method = "relative",
-        threshold = 0.1)
-    Output
-      [1] "grey10" "blue"   "grey10" "blue"   "grey10" "grey10"
-
----
-
-    Code
-      contrast_text(colors, light_text = "blue", dark_text = "grey10", method = "perceived",
-        threshold = 0.7)
-    Output
-      [1] "grey10" "blue"   "blue"   "blue"   "grey10" "blue"  
-

tests/testthat/_snaps/data_plots.md

@@ -1,160 +0,0 @@
-# all_but works
-
-    Code
-      all_but(1:10, c(2, 3), 11, 5)
-    Output
-      [1]  1  4  6  7  8  9 10
-
-# subset_types works
-
-    Code
-      subset_types(default_parsing(mtcars), "continuous")
-    Output
-      # A tibble: 32 x 6
-           mpg  disp    hp  drat    wt  qsec
-         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-       1  21    160    110  3.9   2.62  16.5
-       2  21    160    110  3.9   2.88  17.0
-       3  22.8  108     93  3.85  2.32  18.6
-       4  21.4  258    110  3.08  3.22  19.4
-       5  18.7  360    175  3.15  3.44  17.0
-       6  18.1  225    105  2.76  3.46  20.2
-       7  14.3  360    245  3.21  3.57  15.8
-       8  24.4  147.    62  3.69  3.19  20  
-       9  22.8  141.    95  3.92  3.15  22.9
-      10  19.2  168.   123  3.92  3.44  18.3
-      # i 22 more rows
-
----
-
-    Code
-      subset_types(default_parsing(mtcars), c("dichotomous", "ordinal", "categorical"))
-    Output
-      # A tibble: 32 x 5
-         cyl   vs    am    gear  carb 
-         <fct> <lgl> <lgl> <fct> <fct>
-       1 6     FALSE TRUE  4     4    
-       2 6     FALSE TRUE  4     4    
-       3 4     TRUE  TRUE  4     1    
-       4 6     TRUE  FALSE 3     1    
-       5 8     FALSE FALSE 3     2    
-       6 6     TRUE  FALSE 3     1    
-       7 8     FALSE FALSE 3     4    
-       8 4     TRUE  FALSE 4     2    
-       9 4     TRUE  FALSE 4     2    
-      10 6     TRUE  FALSE 4     4    
-      # i 22 more rows
-
----
-
-    Code
-      subset_types(default_parsing(mtcars), "test")
-    Output
-      # A tibble: 32 x 0
-
-# possible_plots works
-
-    Code
-      possible_plots(mtcars$mpg)
-    Output
-      [1] "Violin plot"  "Scatter plot" "Box plot"    
-
----
-
-    Code
-      possible_plots(default_parsing(mtcars)["cyl"])
-    Output
-      [1] "Stacked horizontal bars" "Violin plot"            
-      [3] "Sankey plot"             "Box plot"               
-
-# get_plot_options works
-
-    Code
-      get_plot_options((function(.x) {
-        .x[[1]]
-      })(possible_plots(default_parsing(mtcars)["mpg"])))
-    Output
-      $plot_violin
-      $plot_violin$fun
-      [1] "plot_violin"
-      
-      $plot_violin$descr
-      [1] "Violin plot"
-      
-      $plot_violin$note
-      [1] "A modern alternative to the classic boxplot to visualise data distribution"
-      
-      $plot_violin$primary.type
-      [1] "datatime"    "continuous"  "dichotomous" "ordinal"     "categorical"
-      
-      $plot_violin$secondary.type
-      [1] "dichotomous" "ordinal"     "categorical"
-      
-      $plot_violin$secondary.multi
-      [1] FALSE
-      
-      $plot_violin$secondary.extra
-      [1] "none"
-      
-      $plot_violin$tertiary.type
-      [1] "dichotomous" "ordinal"     "categorical"
-      
-      
-
-# get_label works
-
-    Code
-      get_label(mtcars, var = "mpg")
-    Output
-      [1] "mpg"
-
----
-
-    Code
-      get_label(mtcars)
-    Output
-      [1] "mtcars"
-
----
-
-    Code
-      get_label(mtcars$mpg)
-    Output
-      [1] "mtcars$mpg"
-
----
-
-    Code
-      get_label(gtsummary::trial, var = "trt")
-    Output
-      [1] "Chemotherapy Treatment"
-
----
-
-    Code
-      get_label(1:10)
-    Output
-      [1] "1:10"
-
-# line_break works
-
-    Code
-      line_break("Lorem ipsum... you know the routine")
-    Output
-      [1] "Lorem ipsum... you\nknow the routine"
-
----
-
-    Code
-      line_break(paste(sample(letters[1:10], 100, TRUE), collapse = ""), force = TRUE,
-      lineLength = 5)
-    Output
-      [1] "cjijd\ncjcfb\nihfgi\nfcffh\neaddf\ngegjb\njeegi\nfdhbe\nbgcac\nibfbe\nejibi\nggedh\ngajhf\ngadca\nijeig\ncieeh\ncah\n"
-
----
-
-    Code
-      line_break(paste(sample(letters[1:10], 100, TRUE), collapse = ""), force = FALSE)
-    Output
-      [1] "idjcgcjceeefchffjdbjafabigaiadcfdcfgfgibibhcjbbbejabddeheafggcgbdfbcbeegijggbibaghfidjgeaefhcadbfjig"
-

tests/testthat/_snaps/helpers.md

@@ -1,532 +0,0 @@
-# getfun works
-
-    Code
-      getfun("stats::lm")
-    Output
-      function (formula, data, subset, weights, na.action, method = "qr", 
-          model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
-          contrasts = NULL, offset, ...) 
-      {
-          ret.x <- x
-          ret.y <- y
-          cl <- match.call()
-          mf <- match.call(expand.dots = FALSE)
-          m <- match(c("formula", "data", "subset", "weights", "na.action", 
-              "offset"), names(mf), 0L)
-          mf <- mf[c(1L, m)]
-          mf$drop.unused.levels <- TRUE
-          mf[[1L]] <- quote(stats::model.frame)
-          mf <- eval(mf, parent.frame())
-          if (method == "model.frame") 
-              return(mf)
-          else if (method != "qr") 
-              warning(gettextf("method = '%s' is not supported. Using 'qr'", 
-                  method), domain = NA)
-          mt <- attr(mf, "terms")
-          y <- model.response(mf, "numeric")
-          w <- as.vector(model.weights(mf))
-          if (!is.null(w) && !is.numeric(w)) 
-              stop("'weights' must be a numeric vector")
-          offset <- model.offset(mf)
-          mlm <- is.matrix(y)
-          ny <- if (mlm) 
-              nrow(y)
-          else length(y)
-          if (!is.null(offset)) {
-              if (!mlm) 
-                  offset <- as.vector(offset)
-              if (NROW(offset) != ny) 
-                  stop(gettextf("number of offsets is %d, should equal %d (number of observations)", 
-                      NROW(offset), ny), domain = NA)
-          }
-          if (is.empty.model(mt)) {
-              x <- NULL
-              z <- list(coefficients = if (mlm) matrix(NA_real_, 0, 
-                  ncol(y)) else numeric(), residuals = y, fitted.values = 0 * 
-                  y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w != 
-                  0) else ny)
-              if (!is.null(offset)) {
-                  z$fitted.values <- offset
-                  z$residuals <- y - offset
-              }
-          }
-          else {
-              x <- model.matrix(mt, mf, contrasts)
-              z <- if (is.null(w)) 
-                  lm.fit(x, y, offset = offset, singular.ok = singular.ok, 
-                      ...)
-              else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, 
-                  ...)
-          }
-          class(z) <- c(if (mlm) "mlm", "lm")
-          z$na.action <- attr(mf, "na.action")
-          z$offset <- offset
-          z$contrasts <- attr(x, "contrasts")
-          z$xlevels <- .getXlevels(mt, mf)
-          z$call <- cl
-          z$terms <- mt
-          if (model) 
-              z$model <- mf
-          if (ret.x) 
-              z$x <- x
-          if (ret.y) 
-              z$y <- y
-          if (!qr) 
-              z$qr <- NULL
-          z
-      }
-      <bytecode: 0x12c7f2dd8>
-      <environment: namespace:stats>
-
-# argsstring2list works
-
-    Code
-      argsstring2list("A=1:5,b=2:4")
-    Output
-      $A
-      [1] 1 2 3 4 5
-      
-      $b
-      [1] 2 3 4
-      
-
-# factorize works
-
-    Code
-      factorize(mtcars, names(mtcars))
-    Output
-                           mpg cyl  disp  hp drat    wt  qsec vs am gear carb
-      Mazda RX4             21   6   160 110  3.9  2.62 16.46  0  1    4    4
-      Mazda RX4 Wag         21   6   160 110  3.9 2.875 17.02  0  1    4    4
-      Datsun 710          22.8   4   108  93 3.85  2.32 18.61  1  1    4    1
-      Hornet 4 Drive      21.4   6   258 110 3.08 3.215 19.44  1  0    3    1
-      Hornet Sportabout   18.7   8   360 175 3.15  3.44 17.02  0  0    3    2
-      Valiant             18.1   6   225 105 2.76  3.46 20.22  1  0    3    1
-      Duster 360          14.3   8   360 245 3.21  3.57 15.84  0  0    3    4
-      Merc 240D           24.4   4 146.7  62 3.69  3.19    20  1  0    4    2
-      Merc 230            22.8   4 140.8  95 3.92  3.15  22.9  1  0    4    2
-      Merc 280            19.2   6 167.6 123 3.92  3.44  18.3  1  0    4    4
-      Merc 280C           17.8   6 167.6 123 3.92  3.44  18.9  1  0    4    4
-      Merc 450SE          16.4   8 275.8 180 3.07  4.07  17.4  0  0    3    3
-      Merc 450SL          17.3   8 275.8 180 3.07  3.73  17.6  0  0    3    3
-      Merc 450SLC         15.2   8 275.8 180 3.07  3.78    18  0  0    3    3
-      Cadillac Fleetwood  10.4   8   472 205 2.93  5.25 17.98  0  0    3    4
-      Lincoln Continental 10.4   8   460 215    3 5.424 17.82  0  0    3    4
-      Chrysler Imperial   14.7   8   440 230 3.23 5.345 17.42  0  0    3    4
-      Fiat 128            32.4   4  78.7  66 4.08   2.2 19.47  1  1    4    1
-      Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
-      Toyota Corolla      33.9   4  71.1  65 4.22 1.835  19.9  1  1    4    1
-      Toyota Corona       21.5   4 120.1  97  3.7 2.465 20.01  1  0    3    1
-      Dodge Challenger    15.5   8   318 150 2.76  3.52 16.87  0  0    3    2
-      AMC Javelin         15.2   8   304 150 3.15 3.435  17.3  0  0    3    2
-      Camaro Z28          13.3   8   350 245 3.73  3.84 15.41  0  0    3    4
-      Pontiac Firebird    19.2   8   400 175 3.08 3.845 17.05  0  0    3    2
-      Fiat X1-9           27.3   4    79  66 4.08 1.935  18.9  1  1    4    1
-      Porsche 914-2         26   4 120.3  91 4.43  2.14  16.7  0  1    5    2
-      Lotus Europa        30.4   4  95.1 113 3.77 1.513  16.9  1  1    5    2
-      Ford Pantera L      15.8   8   351 264 4.22  3.17  14.5  0  1    5    4
-      Ferrari Dino        19.7   6   145 175 3.62  2.77  15.5  0  1    5    6
-      Maserati Bora         15   8   301 335 3.54  3.57  14.6  0  1    5    8
-      Volvo 142E          21.4   4   121 109 4.11  2.78  18.6  1  1    4    2
-
-# default_parsing works
-
-    Code
-      default_parsing(mtcars)
-    Output
-      # A tibble: 32 x 11
-           mpg cyl    disp    hp  drat    wt  qsec vs    am    gear  carb 
-         <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <lgl> <lgl> <fct> <fct>
-       1  21   6      160    110  3.9   2.62  16.5 FALSE TRUE  4     4    
-       2  21   6      160    110  3.9   2.88  17.0 FALSE TRUE  4     4    
-       3  22.8 4      108     93  3.85  2.32  18.6 TRUE  TRUE  4     1    
-       4  21.4 6      258    110  3.08  3.22  19.4 TRUE  FALSE 3     1    
-       5  18.7 8      360    175  3.15  3.44  17.0 FALSE FALSE 3     2    
-       6  18.1 6      225    105  2.76  3.46  20.2 TRUE  FALSE 3     1    
-       7  14.3 8      360    245  3.21  3.57  15.8 FALSE FALSE 3     4    
-       8  24.4 4      147.    62  3.69  3.19  20   TRUE  FALSE 4     2    
-       9  22.8 4      141.    95  3.92  3.15  22.9 TRUE  FALSE 4     2    
-      10  19.2 6      168.   123  3.92  3.44  18.3 TRUE  FALSE 4     4    
-      # i 22 more rows
-
-# remove_empty_attr works
-
-    Code
-      remove_empty_attr(ds)
-    Output
-      $mpg
-       [1] 21.0 21.0 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 17.8 16.4 17.3 15.2 10.4
-      [16] 10.4 14.7 32.4 30.4 33.9 21.5 15.5 15.2 13.3 19.2 27.3 26.0 30.4 15.8 19.7
-      [31] 15.0 21.4
-      
-      $cyl
-       [1] 6 6 4 6 8 6 8 4 4 6 6 8 8 8 8 8 8 4 4 4 4 8 8 8 8 4 4 4 8 6 8 4
-      
-      $disp
-       [1] 160.0 160.0 108.0 258.0 360.0 225.0 360.0 146.7 140.8 167.6 167.6 275.8
-      [13] 275.8 275.8 472.0 460.0 440.0  78.7  75.7  71.1 120.1 318.0 304.0 350.0
-      [25] 400.0  79.0 120.3  95.1 351.0 145.0 301.0 121.0
-      
-      $hp
-       [1] 110 110  93 110 175 105 245  62  95 123 123 180 180 180 205 215 230  66  52
-      [20]  65  97 150 150 245 175  66  91 113 264 175 335 109
-      
-      $drat
-       [1] 3.90 3.90 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 3.92 3.07 3.07 3.07 2.93
-      [16] 3.00 3.23 4.08 4.93 4.22 3.70 2.76 3.15 3.73 3.08 4.08 4.43 3.77 4.22 3.62
-      [31] 3.54 4.11
-      
-      $wt
-       [1] 2.620 2.875 2.320 3.215 3.440 3.460 3.570 3.190 3.150 3.440 3.440 4.070
-      [13] 3.730 3.780 5.250 5.424 5.345 2.200 1.615 1.835 2.465 3.520 3.435 3.840
-      [25] 3.845 1.935 2.140 1.513 3.170 2.770 3.570 2.780
-      
-      $qsec
-       [1] 16.46 17.02 18.61 19.44 17.02 20.22 15.84 20.00 22.90 18.30 18.90 17.40
-      [13] 17.60 18.00 17.98 17.82 17.42 19.47 18.52 19.90 20.01 16.87 17.30 15.41
-      [25] 17.05 18.90 16.70 16.90 14.50 15.50 14.60 18.60
-      
-      $vs
-       [1] 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1
-      
-      $am
-       [1] 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1
-      
-      $gear
-       [1] 4 4 4 3 3 3 3 4 4 4 4 3 3 3 3 3 3 4 4 4 3 3 3 3 3 4 5 5 5 5 5 4
-      
-      $carb
-       [1] 4 4 1 1 2 1 4 2 2 4 4 3 3 3 4 4 4 1 2 1 1 2 2 4 2 1 2 2 4 6 8 2
-      
-
----
-
-    Code
-      remove_empty_attr(dplyr::bind_cols(ds))
-    Output
-      # A tibble: 32 x 11
-           mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
-         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-       1  21       6  160    110  3.9   2.62  16.5     0     1     4     4
-       2  21       6  160    110  3.9   2.88  17.0     0     1     4     4
-       3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1
-       4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1
-       5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2
-       6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1
-       7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4
-       8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2
-       9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2
-      10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4
-      # i 22 more rows
-
----
-
-    Code
-      remove_empty_attr(ds[[1]])
-    Output
-       [1] 21.0 21.0 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 17.8 16.4 17.3 15.2 10.4
-      [16] 10.4 14.7 32.4 30.4 33.9 21.5 15.5 15.2 13.3 19.2 27.3 26.0 30.4 15.8 19.7
-      [31] 15.0 21.4
-
-# remove_empty_cols works
-
-    Code
-      remove_empty_cols(data.frame(a = 1:10, b = NA, c = c(2, NA)), cutoff = 0.5)
-    Output
-          a  c
-      1   1  2
-      2   2 NA
-      3   3  2
-      4   4 NA
-      5   5  2
-      6   6 NA
-      7   7  2
-      8   8 NA
-      9   9  2
-      10 10 NA
-
-# append_list works
-
-    Code
-      append_list(data.frame(letters[1:20], 1:20), ls_d, "letters")
-    Output
-      $letters
-         letters.1.20. X1.20
-      1              a     1
-      2              b     2
-      3              c     3
-      4              d     4
-      5              e     5
-      6              f     6
-      7              g     7
-      8              h     8
-      9              i     9
-      10             j    10
-      11             k    11
-      12             l    12
-      13             m    13
-      14             n    14
-      15             o    15
-      16             p    16
-      17             q    17
-      18             r    18
-      19             s    19
-      20             t    20
-      
-
----
-
-    Code
-      append_list(letters[1:20], ls_d, "letters")
-    Output
-      $letters
-       [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
-      [20] "t"
-      
-
-# missing_fraction works
-
-    Code
-      missing_fraction(c(NA, 1:10, rep(NA, 3)))
-    Output
-      [1] 0.2857143
-
-# data_description works
-
-    Code
-      data_description(data.frame(sample(1:8, 20, TRUE), sample(c(1:8, NA), 20, TRUE)),
-      data_text = "This data")
-    Output
-      [1] "This data has 20 observations and 2 variables, with 16 (80%) complete cases."
-
-# Data type filter works
-
-    Code
-      data_type_filter(default_parsing(mtcars), type = c("categorical", "continuous"))
-    Output
-      # A tibble: 32 x 9
-           mpg cyl    disp    hp  drat    wt  qsec gear  carb 
-         <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct>
-       1  21   6      160    110  3.9   2.62  16.5 4     4    
-       2  21   6      160    110  3.9   2.88  17.0 4     4    
-       3  22.8 4      108     93  3.85  2.32  18.6 4     1    
-       4  21.4 6      258    110  3.08  3.22  19.4 3     1    
-       5  18.7 8      360    175  3.15  3.44  17.0 3     2    
-       6  18.1 6      225    105  2.76  3.46  20.2 3     1    
-       7  14.3 8      360    245  3.21  3.57  15.8 3     4    
-       8  24.4 4      147.    62  3.69  3.19  20   4     2    
-       9  22.8 4      141.    95  3.92  3.15  22.9 4     2    
-      10  19.2 6      168.   123  3.92  3.44  18.3 4     4    
-      # i 22 more rows
-
----
-
-    Code
-      data_type_filter(default_parsing(mtcars), type = NULL)
-    Output
-      # A tibble: 32 x 11
-           mpg cyl    disp    hp  drat    wt  qsec vs    am    gear  carb 
-         <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <lgl> <lgl> <fct> <fct>
-       1  21   6      160    110  3.9   2.62  16.5 FALSE TRUE  4     4    
-       2  21   6      160    110  3.9   2.88  17.0 FALSE TRUE  4     4    
-       3  22.8 4      108     93  3.85  2.32  18.6 TRUE  TRUE  4     1    
-       4  21.4 6      258    110  3.08  3.22  19.4 TRUE  FALSE 3     1    
-       5  18.7 8      360    175  3.15  3.44  17.0 FALSE FALSE 3     2    
-       6  18.1 6      225    105  2.76  3.46  20.2 TRUE  FALSE 3     1    
-       7  14.3 8      360    245  3.21  3.57  15.8 FALSE FALSE 3     4    
-       8  24.4 4      147.    62  3.69  3.19  20   TRUE  FALSE 4     2    
-       9  22.8 4      141.    95  3.92  3.15  22.9 TRUE  FALSE 4     2    
-      10  19.2 6      168.   123  3.92  3.44  18.3 TRUE  FALSE 4     4    
-      # i 22 more rows
-
-# sort_by works
-
-    Code
-      sort_by(c("Multivariable", "Univariable"), c("Univariable", "Minimal",
-        "Multivariable"))
-    Output
-      [1] "Univariable"   NA              "Multivariable"
-
-# if_not_missing works
-
-    Code
-      if_not_missing(NULL, "new")
-    Output
-      [1] "new"
-
----
-
-    Code
-      if_not_missing(c(2, "a", NA))
-    Output
-      [1] "2" "a"
-
----
-
-    Code
-      if_not_missing("See")
-    Output
-      [1] "See"
-
-# merge_expression, expression_string and pipe_string works
-
-    Code
-      merge_expression(list(rlang::call2(.fn = "select", !!!list(c("cyl", "disp")),
-      .ns = "dplyr"), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")))
-    Output
-      dplyr::select(c("cyl", "disp")) %>% FreesearchR::default_parsing()
-
----
-
-    Code
-      expression_string(pipe_string(lapply(list("mtcars", rlang::call2(.fn = "select",
-        !!!list(c("cyl", "disp")), .ns = "dplyr"), rlang::call2(.fn = "default_parsing",
-        .ns = "FreesearchR")), expression_string)), "data<-")
-    Output
-      [1] "data<-mtcars|>\ndplyr::select(c('cyl','disp'))|>\nFreesearchR::default_parsing()"
-
----
-
-    Code
-      expression_string(merge_expression(list(as.symbol(paste0("mtcars$", "mpg")),
-      rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"), rlang::call2(
-        .fn = "default_parsing", .ns = "FreesearchR"))))
-    Output
-      [1] "mtcars$mpg|>\ndplyr::select(c('cyl','disp'))|>\nFreesearchR::default_parsing()"
-
-# remove_nested_list works
-
-    Code
-      remove_nested_list(dplyr::tibble(a = 1:10, b = rep(list("a"), 10)))
-    Output
-      # A tibble: 10 x 1
-             a
-         <int>
-       1     1
-       2     2
-       3     3
-       4     4
-       5     5
-       6     6
-       7     7
-       8     8
-       9     9
-      10    10
-
----
-
-    Code
-      remove_nested_list(as.data.frame(dplyr::tibble(a = 1:10, b = rep(list(c("a",
-        "b")), 10))))
-    Output
-          a
-      1   1
-      2   2
-      3   3
-      4   4
-      5   5
-      6   6
-      7   7
-      8   8
-      9   9
-      10 10
-
-# set_column_label works
-
-    Code
-      set_column_label(set_column_label(set_column_label(mtcars, ls), ls2), ls3)
-    Output
-      # A tibble: 32 x 11
-           mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
-         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-       1  21       6  160    110  3.9   2.62  16.5     0     1     4     4
-       2  21       6  160    110  3.9   2.88  17.0     0     1     4     4
-       3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1
-       4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1
-       5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2
-       6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1
-       7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4
-       8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2
-       9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2
-      10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4
-      # i 22 more rows
-
----
-
-    Code
-      expression_string(rlang::expr(FreesearchR::set_column_label(label = !!ls3)))
-    Output
-      [1] "FreesearchR::set_column_label(label=c(mpg='',cyl='',disp='',hp='Horses',drat='',wt='',qsec='',vs='',am='',gear='',carb=''))"
-
-# append_column works
-
-    Code
-      append_column(dplyr::mutate(mtcars, mpg_cut = mpg), mtcars$mpg, "mpg_cutter")
-    Output
-                           mpg cyl  disp  hp drat    wt  qsec vs am gear carb mpg_cut
-      Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4    21.0
-      Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4    21.0
-      Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1    22.8
-      Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1    21.4
-      Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2    18.7
-      Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1    18.1
-      Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4    14.3
-      Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2    24.4
-      Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2    22.8
-      Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4    19.2
-      Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4    17.8
-      Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3    16.4
-      Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3    17.3
-      Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3    15.2
-      Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4    10.4
-      Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4    10.4
-      Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4    14.7
-      Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1    32.4
-      Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2    30.4
-      Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1    33.9
-      Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1    21.5
-      Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2    15.5
-      AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2    15.2
-      Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4    13.3
-      Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2    19.2
-      Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1    27.3
-      Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2    26.0
-      Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2    30.4
-      Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4    15.8
-      Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6    19.7
-      Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8    15.0
-      Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2    21.4
-                          mpg_cutter
-      Mazda RX4                 21.0
-      Mazda RX4 Wag             21.0
-      Datsun 710                22.8
-      Hornet 4 Drive            21.4
-      Hornet Sportabout         18.7
-      Valiant                   18.1
-      Duster 360                14.3
-      Merc 240D                 24.4
-      Merc 230                  22.8
-      Merc 280                  19.2
-      Merc 280C                 17.8
-      Merc 450SE                16.4
-      Merc 450SL                17.3
-      Merc 450SLC               15.2
-      Cadillac Fleetwood        10.4
-      Lincoln Continental       10.4
-      Chrysler Imperial         14.7
-      Fiat 128                  32.4
-      Honda Civic               30.4
-      Toyota Corolla            33.9
-      Toyota Corona             21.5
-      Dodge Challenger          15.5
-      AMC Javelin               15.2
-      Camaro Z28                13.3
-      Pontiac Firebird          19.2
-      Fiat X1-9                 27.3
-      Porsche 914-2             26.0
-      Lotus Europa              30.4
-      Ford Pantera L            15.8
-      Ferrari Dino              19.7
-      Maserati Bora             15.0
-      Volvo 142E                21.4
-

tests/testthat/test-baseline_table.R

@@ -3,26 +3,44 @@
 
 test_that("Creates correct table",{
   ## This is by far the easiest way to test all functions. Based on examples.
-  tbl <- create_baseline(mtcars,by.var = "gear", add.p = "yes" == "yes",add.overall = TRUE, theme = "lancet")
+  expect_snapshot(create_baseline(mtcars,by.var = "gear", add.p = "yes" == "yes",add.overall = TRUE, theme = "lancet"))
+  expect_snapshot(create_baseline(mtcars,by.var = "none", add.p = FALSE,add.overall = FALSE, theme = "lancet"))
+  expect_snapshot(create_baseline(mtcars,by.var = "test", add.p = FALSE,add.overall = FALSE, theme = "jama"))
+  expect_snapshot(create_baseline(default_parsing(mtcars),by.var = "am", add.p = FALSE,add.overall = FALSE, theme = "nejm"))
+})
 
-  expect_equal(length(tbl),5)
+test_that("Creates table", {
+  tbl <- mtcars |> baseline_table(fun.args = list(by = "gear"))
+
+  expect_equal(length(tbl), 5)
+
+  expect_equal(NROW(tbl$table_body), 19)
+
+  expect_equal(NCOL(tbl$table_body), 8)
+
+  expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs"))
+})
+
+test_that("Creates table", {
+  tbl <- mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
+
+  expect_equal(length(tbl), 5)
 
   expect_equal(NROW(tbl$table_body), 19)
 
   expect_equal(NCOL(tbl$table_body), 13)
-  tbl$call_list
+
   expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs"))
-
-  tbl <- create_baseline(mtcars,by.var = "none", add.p = FALSE,add.overall = FALSE, theme = "lancet")
-
-  expect_equal(length(tbl),5)
-
-  tbl <- create_baseline(mtcars,by.var = "test", add.p = FALSE,add.overall = FALSE, theme = "jama")
-
-  expect_equal(length(tbl),5)
-
-  tbl <- create_baseline(default_parsing(mtcars),by.var = "am", add.p = FALSE,add.overall = FALSE, theme = "nejm")
-
-  expect_equal(length(tbl),5)
 })
 
+test_that("Creates table", {
+  tbl <- mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
+
+  expect_equal(length(tbl), 5)
+
+  expect_equal(NROW(tbl$table_body), 19)
+
+  expect_equal(NCOL(tbl$table_body), 13)
+
+  expect_equal(names(tbl), c("table_body", "table_styling", "call_list", "cards", "inputs"))
+})

tests/testthat/test-correlations-module.R

@@ -1,17 +0,0 @@
-test_that("correlations module works", {
-  testServer(data_correlations_server, args=list(data = mtcars,cutoff = shiny::reactive(.8)), {
-    expect_equal(nchar(output$suggest), 281)
-    expect_equal(class(output$correlation_plot),"list")
-    expect_equal(length(output$correlation_plot),5)
-  })
-
-  expect_snapshot(
-    correlation_pairs(data = gtsummary::trial,threshold = .2)
-    )
-
-  expect_snapshot(
-  sentence_paste(letters[1:8])
-  )
-
-})
-

tests/testthat/test-custom_SelectInput.R

@@ -1,83 +1,3 @@
 test_that("Create columnSelectInput", {
-  library(shiny)
+  expect_snapshot(columnSelectInput("x",label = "X",data = mtcars))
-  ui <- shiny::fluidPage(
-    shiny::uiOutput("x"),
-    shiny::uiOutput("out")
-  )
-  server <- function(input, output, session) {
-    library(FreesearchR)
-    output$x <-
-      shiny::renderUI({
-      columnSelectInput(inputId = "x",selected = "mpg",label = "X",data = mtcars)
-      })
-
-    output$out <- renderText({
-      # req(input$x)
-      input$x
-      })
-  }
-
-  # shinyApp(ui,server)
-
-  testServer(server, {
-    session$setInputs(x = "cyl")
-    expect_equal(output$out, "cyl")
-
-    session$setInputs(x = "mpg")
-    expect_equal(output$out, "mpg")
-  })
-
-  server <- function(input, output, session) {
-    library(FreesearchR)
-    output$x <-
-      shiny::renderUI({
-        columnSelectInput(inputId = "x",label = "X",data = gtsummary::trial)
-      })
-
-    output$out <- renderText({
-      # req(input$x)
-      input$x
-    })
-  }
-
-  # shinyApp(ui,server)
-
-  testServer(server, {
-    session$setInputs(x = "trt")
-    expect_equal(output$out, "trt")
-
-    session$setInputs(x = "stage")
-    expect_equal(output$out, "stage")
-  })
-
-})
-
-test_that("Create columnSelectInput", {
-  library(shiny)
-  ui <- shiny::fluidPage(
-    shiny::uiOutput("x"),
-    shiny::uiOutput("out")
-  )
-  server <- function(input, output, session) {
-    library(FreesearchR)
-    output$x <-
-      shiny::renderUI({
-        vectorSelectInput(inputId = "x",choices = setNames(names(mtcars),seq_len(ncol(mtcars))),label = "X")
-      })
-
-    output$out <- renderText({
-      # req(input$x)
-      input$x
-    })
-  }
-
-  # shinyApp(ui,server)
-
-  testServer(server, {
-    session$setInputs(x = "cyl")
-    expect_equal(output$out, "cyl")
-
-    session$setInputs(x = "mpg")
-    expect_equal(output$out, "mpg")
-  })
 })

tests/testthat/test-cut-variable-dates.R

@@ -1,47 +0,0 @@
-test_that("datetime cutting works", {
-  ## HMS
-  data <- readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "08:20:20", "21:20:20", "03:02:20"))
-
-  breaks <- list(2, "min", "hour", hms::as_hms(c("01:00:00", "03:01:20", "9:20:20")))
-
-  lapply(breaks, \(.x){
-    cut_var(x = data, breaks = .x)
-  }) |> expect_snapshot()
-
-
-  data <- readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA))
-
-  lapply(breaks, \(.x){
-    cut_var(x = data, breaks = .x)
-  }) |> expect_snapshot()
-
-  expect_snapshot(
-    readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA)) |> cut_var(breaks = lubridate::as_datetime(c(hms::as_hms(levels(cut_var(data, 2))), hms::as_hms(max(data, na.rm = TRUE) + 1))), right = FALSE)
-  )
-
-  ## DATETIME
-
-  data <- readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20"))
-
-  breaks <- list(list(breaks = 2), list(breaks = "weekday"), list(breaks = "month_only"), list(breaks = NULL, format = "%A-%H"))
-
-  lapply(breaks, \(.x){
-    do.call(cut_var, modifyList(.x, list(x = data)))
-  }) |> expect_snapshot()
-})
-
-## is_any_class
-test_that("is_any_class works", {
-  expect_snapshot(
-    vapply(REDCapCAST::redcapcast_data, \(.x){
-    is_any_class(.x, c("hms", "Date", "POSIXct", "POSIXt"))
-  }, logical(1))
-  )
-
-  expect_snapshot(
-  vapply(REDCapCAST::redcapcast_data, is_datetime, logical(1))
-
-  )
-
-})
-

tests/testthat/test-data_plots.R

@@ -1,85 +0,0 @@
-## all_but
-test_that("all_but works", {
-  expect_snapshot(all_but(1:10, c(2, 3), 11, 5))
-})
-
-## subset_types
-test_that("subset_types works", {
-  expect_snapshot(
-    default_parsing(mtcars) |> subset_types("continuous")
-  )
-  expect_snapshot(
-    default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal", "categorical"))
-  )
-  expect_snapshot(
-    default_parsing(mtcars) |> subset_types("test")
-  )
-})
-
-## supported_plots
-test_that("supported_plots works", {
-  expect_true(is.list(supported_plots()))
-})
-
-## possible_plots
-test_that("possible_plots works", {
-  expect_snapshot(possible_plots(mtcars$mpg))
-
-  expect_snapshot(default_parsing(mtcars)["cyl"] |>
-    possible_plots())
-})
-
-## get_plot_options
-test_that("get_plot_options works", {
-  expect_snapshot(default_parsing(mtcars)["mpg"] |>
-    possible_plots() |>
-    (\(.x){
-      .x[[1]]
-    })() |>
-    get_plot_options())
-})
-
-## create_plot and friends
-test_that("create_plot works", {
-  ## Violin
-  p_list <- create_plot(mtcars, type = "plot_violin", pri = "mpg", sec = "cyl", ter = "am")
-  p <- p_list[[1]] + ggplot2::labs(title = "Test plot")
-
-  expect_equal(length(p_list), 2)
-  expect_true(ggplot2::is.ggplot(p))
-
-  # Includes helper functions
-  #   wrap_plot_list
-  #   align_axes
-  #   clean_common_axis
-
-  ## Scatter
-  p_list <- list(
-    create_plot(mtcars, type = "plot_scatter", pri = "mpg", sec = "cyl"),
-    create_plot(mtcars, type = "plot_scatter", pri = "mpg", sec = "cyl", ter = "am")
-  )
-
-  lapply(p_list, \(.x){
-    expect_true(ggplot2::is.ggplot(.x))
-  })
-
-  purrr::map2(p_list, list(11, 11), \(.x, .y){
-    expect_equal(length(.x), .y)
-  })
-})
-
-## get_label
-test_that("get_label works", {
-  expect_snapshot(mtcars |> get_label(var = "mpg"))
-  expect_snapshot(mtcars |> get_label())
-  expect_snapshot(mtcars$mpg |> get_label())
-  expect_snapshot(gtsummary::trial |> get_label(var = "trt"))
-  expect_snapshot(1:10 |> get_label())
-})
-
-## line_break
-test_that("line_break works", {
-  expect_snapshot("Lorem ipsum... you know the routine" |> line_break())
-  expect_snapshot(paste(rep(letters, 5), collapse = "") |> line_break(force = TRUE, lineLength = 5))
-  expect_snapshot(paste(rep(letters, 5), collapse = "") |> line_break(force = FALSE))
-})