too much..

DESCRIPTION

@@ -64,7 +64,8 @@ Imports:
     Hmisc,
     ggstats,
     rempsyc,
-    ggridges
+    ggridges,
+    ggalluvial
 Suggests: 
     styler,
     devtools,

NAMESPACE

@@ -4,11 +4,14 @@ S3method(cut,hms)
 S3method(plot,tbl_regression)
 export(add_class_icon)
 export(add_sparkline)
+export(all_but)
 export(argsstring2list)
 export(baseline_table)
 export(clean_date)
 export(clean_sep)
+export(contrast_text)
 export(create_overview_datagrid)
+export(create_plot)
 export(custom_theme)
 export(cut_variable_server)
 export(cut_variable_ui)
@@ -16,12 +19,16 @@ export(data_correlations_server)
 export(data_correlations_ui)
 export(data_summary_server)
 export(data_summary_ui)
+export(data_visuals_server)
+export(data_visuals_ui)
 export(default_format_arguments)
 export(default_parsing)
 export(factorize)
 export(file_export)
 export(format_writer)
 export(get_fun_options)
+export(get_label)
+export(get_plot_options)
 export(getfun)
 export(gg_theme_export)
 export(gg_theme_shiny)
@@ -29,16 +36,27 @@ export(index_embed)
 export(is_any_class)
 export(is_consecutive)
 export(is_datetime)
-export(launch)
+export(is_valid_redcap_url)
+export(is_valid_token)
+export(launch_freesearcheR)
+export(line_break)
 export(m_datafileUI)
 export(m_redcap_readServer)
 export(m_redcap_readUI)
 export(merge_long)
 export(modal_cut_variable)
+export(modal_update_factor)
 export(modify_qmd)
 export(outcome_type)
 export(overview_vars)
+export(plot_hbars)
+export(plot_ridge)
+export(plot_sankey)
+export(plot_sankey_single)
+export(plot_scatter)
+export(plot_violin)
 export(possible_functions)
+export(possible_plots)
 export(read_input)
 export(regression_model)
 export(regression_model_list)
@@ -47,17 +65,25 @@ export(regression_model_uv_list)
 export(regression_table)
 export(remove_empty_cols)
 export(remove_na_attr)
+export(sankey_ready)
 export(shiny_freesearcheR)
 export(specify_qmd_format)
+export(subset_types)
 export(supported_functions)
+export(supported_plots)
 export(tbl_merge)
+export(update_factor_server)
+export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_ui)
+export(vertical_stacked_bars)
 export(winbox_cut_variable)
+export(winbox_update_factor)
 export(write_quarto)
 importFrom(classInt,classIntervals)
 importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
+importFrom(grDevices,col2rgb)
 importFrom(graphics,abline)
 importFrom(graphics,axis)
 importFrom(graphics,hist)
@@ -65,6 +91,7 @@ importFrom(graphics,par)
 importFrom(graphics,plot.new)
 importFrom(graphics,plot.window)
 importFrom(htmltools,tagList)
+importFrom(htmltools,tags)
 importFrom(rlang,"%||%")
 importFrom(rlang,call2)
 importFrom(rlang,expr)
@@ -72,30 +99,42 @@ importFrom(rlang,set_names)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
 importFrom(shiny,NS)
+importFrom(shiny,actionButton)
 importFrom(shiny,bindEvent)
 importFrom(shiny,checkboxInput)
 importFrom(shiny,column)
 importFrom(shiny,fluidRow)
+importFrom(shiny,getDefaultReactiveDomain)
+importFrom(shiny,icon)
+importFrom(shiny,isTruthy)
 importFrom(shiny,modalDialog)
 importFrom(shiny,moduleServer)
 importFrom(shiny,numericInput)
 importFrom(shiny,observeEvent)
 importFrom(shiny,plotOutput)
 importFrom(shiny,reactive)
+importFrom(shiny,reactiveValues)
 importFrom(shiny,renderPlot)
 importFrom(shiny,req)
+importFrom(shiny,selectizeInput)
 importFrom(shiny,showModal)
+importFrom(shiny,tagList)
 importFrom(shiny,textInput)
 importFrom(shiny,uiOutput)
+importFrom(shiny,updateActionButton)
 importFrom(shinyWidgets,WinBox)
 importFrom(shinyWidgets,noUiSliderInput)
+importFrom(shinyWidgets,prettyCheckbox)
 importFrom(shinyWidgets,updateVirtualSelect)
 importFrom(shinyWidgets,virtualSelectInput)
 importFrom(shinyWidgets,wbControls)
 importFrom(shinyWidgets,wbOptions)
 importFrom(stats,as.formula)
 importFrom(toastui,datagrid)
+importFrom(toastui,datagridOutput)
 importFrom(toastui,datagridOutput2)
 importFrom(toastui,grid_colorbar)
+importFrom(toastui,grid_columns)
+importFrom(toastui,renderDatagrid)
 importFrom(toastui,renderDatagrid2)
 importFrom(utils,type.convert)

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250227_1342'
+app_version <- function()'250305_1101'

R/data_plots.R

@@ -8,7 +8,7 @@
 #' @returns Shiny ui module
 #' @export
 #'
-data_visuals_ui <- function(id, tab_title="Plots", ...) {
+data_visuals_ui <- function(id, tab_title = "Plots", ...) {
   ns <- shiny::NS(id)
 
   # bslib::navset_bar(
@@ -40,7 +40,7 @@ data_visuals_ui <- function(id, tab_title="Plots", ...) {
             max = 300,
             value = 100,
             step = 1,
-            format = shinyWidgets::wNumbFormat(decimals=0),
+            format = shinyWidgets::wNumbFormat(decimals = 0),
             color = datamods:::get_primary_color()
           ),
           shinyWidgets::noUiSliderInput(
@@ -50,7 +50,7 @@ data_visuals_ui <- function(id, tab_title="Plots", ...) {
             max = 300,
             value = 100,
             step = 1,
-            format = shinyWidgets::wNumbFormat(decimals=0),
+            format = shinyWidgets::wNumbFormat(decimals = 0),
             color = datamods:::get_primary_color()
           ),
           shiny::selectInput(
@@ -163,7 +163,6 @@ data_visuals_server <- function(id,
           ),
           none_label = "No variable"
         )
-
       })
 
       output$tertiary <- shiny::renderUI({
@@ -213,12 +212,14 @@ data_visuals_server <- function(id,
         }),
         content = function(file) {
           shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
-          ggplot2::ggsave(filename = file,
+            ggplot2::ggsave(
+              filename = file,
               plot = rv$plot(),
               width = input$width,
               height = input$height,
               dpi = 300,
-                          units = "mm",scale = 2)
+              units = "mm", scale = 2
+            )
           })
         }
       )
@@ -238,7 +239,7 @@ data_visuals_server <- function(id,
 #' @param data vector
 #' @param ... exclude
 #'
-#' @returns
+#' @returns vector
 #' @export
 #'
 #' @examples
@@ -253,7 +254,7 @@ all_but <- function(data, ...) {
 #' @param types desired types
 #' @param type.fun function to get type. Default is outcome_type
 #'
-#' @returns
+#' @returns vector
 #' @export
 #'
 #' @examples
@@ -290,7 +291,8 @@ subset_types <- function(data, types, type.fun = outcome_type) {
 supported_plots <- function() {
   list(
     plot_hbars = list(
-      descr = "Stacked horizontal bars (Grotta bars)",
+      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"),
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -298,6 +300,7 @@ supported_plots <- function() {
     ),
     plot_violin = list(
       descr = "Violin plot",
+      note = "A modern alternative to the classic boxplot to visualise data distribution",
       primary.type = c("continuous", "dichotomous", "ordinal"),
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -305,13 +308,23 @@ supported_plots <- function() {
     ),
     plot_ridge = list(
       descr = "Ridge plot",
+      note = "An alternative option to visualise data distribution",
       primary.type = "continuous",
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
       secondary.extra = NULL
     ),
+    plot_sankey = list(
+      descr = "Sankey plot",
+      note = "A way of visualising change between groups",
+      primary.type = c("dichotomous", "ordinal"),
+      secondary.type = c("dichotomous", "ordinal"),
+      tertiary.type = c("dichotomous", "ordinal"),
+      secondary.extra = NULL
+    ),
     plot_scatter = list(
       descr = "Scatter plot",
+      note = "A classic way of showing the association between to variables",
       primary.type = "continuous",
       secondary.type = c("continuous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -322,9 +335,11 @@ supported_plots <- function() {
 
 #' Title
 #'
-#' @returns
+#' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |>
 #'   default_parsing() |>
@@ -422,7 +437,9 @@ get_plot_options <- function(data) {
 #' @param type plot type (derived from possible_plots() and matches custom function)
 #' @param ... ignored for now
 #'
-#' @returns
+#' @name data-plots
+#'
+#' @returns ggplot2 object
 #' @export
 #'
 #' @examples
@@ -448,6 +465,8 @@ create_plot <- function(data, type, x, y, z = NULL, ...) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_hbars(x = "carb", y = "cyl")
 #' mtcars |> plot_hbars(x = "carb", y = NULL)
@@ -547,6 +566,7 @@ vertical_stacked_bars <- function(data,
 #'
 #' @examples
 #' mtcars |> get_label(var = "mpg")
+#' mtcars |> get_label()
 #' mtcars$mpg |> get_label()
 #' gtsummary::trial |> get_label(var = "trt")
 #' 1:10 |> get_label()
@@ -554,13 +574,16 @@ get_label <- function(data, var = NULL) {
   if (!is.null(var)) {
     data <- data[[var]]
   }
-
   out <- REDCapCAST::get_attr(data = data, attr = "label")
   if (is.na(out)) {
     if (is.null(var)) {
       out <- deparse(substitute(data))
     } else {
+      if (is.symbol(var)) {
         out <- gsub('\"', "", deparse(substitute(var)))
+      } else {
+        out <- var
+      }
     }
   }
   out
@@ -572,6 +595,8 @@ get_label <- function(data, var = NULL) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
 plot_violin <- function(data, x, y, z = NULL) {
@@ -593,11 +618,13 @@ plot_violin <- function(data, x, y, z = NULL) {
 }
 
 
-#' Beatiful violin plot
+#' Beautiful violin plot
 #'
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_scatter(x = "mpg", y = "wt")
 plot_scatter <- function(data, x, y, z = NULL) {
@@ -617,3 +644,205 @@ plot_scatter <- function(data, x, y, z = NULL) {
   }
 }
 
+#' Readying data for sankey plot
+#'
+#' @param data
+#' @param x
+#' @param y
+#' @param z
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = sample(c(letters[1:4], NA), 100, TRUE, prob = c(rep(.23, 4), .08)))
+#' ds |> sankey_ready("first", "last")
+#' ds |> sankey_ready("first", "last", numbers = "percentage")
+sankey_ready <- function(data, x, y, z = NULL, numbers = "count") {
+  ## TODO: Ensure ordering x and y
+
+  if (is.null(z)) {
+    out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y))
+  } else {
+    out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y), !!dplyr::sym(z))
+  }
+  out <- out |>
+    dplyr::group_by(!!dplyr::sym(x)) |>
+    dplyr::mutate(gx.sum = sum(n)) |>
+    dplyr::ungroup() |>
+    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(x), "\n(n=", gx.sum, ")")),
+      ly = factor(paste0(!!dplyr::sym(y), "\n(n=", gy.sum, ")"))
+    )
+  } else if (numbers == "percentage") {
+    out <- out |> dplyr::mutate(
+      lx = factor(paste0(!!dplyr::sym(x), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
+      ly = factor(paste0(!!dplyr::sym(y), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
+    )
+  }
+
+  if (is.factor(data[[x]])){
+    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[[y]])){
+    index <- match(levels(data[[y]]),str_remove_last(levels(out$ly),"\n"))
+    out$ly <- factor(out$ly,levels=levels(out$ly)[index])
+  }
+
+  out
+}
+
+str_remove_last <- function(data,pattern="\n"){
+  strsplit(data,split = pattern) |>
+    lapply(\(.x)paste(unlist(.x[[-length(.x)]]),collapse=pattern)) |>
+    unlist()
+}
+
+#' Line breaking at given number of characters for nicely plotting labels
+#'
+#' @param data
+#' @param lineLength
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+line_break <- function(data, lineLength = 20) {
+  # gsub(paste0('(.{1,',lineLength,'})(\\s)'), '\\1\n', data)
+  paste(strwrap(data, lineLength), collapse = "\n")
+  ## https://stackoverflow.com/a/29847221
+}
+
+#' Beautiful sankey plot with option to split by a tertiary group
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+#' 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, x, y, z = NULL, color.group = "x", colors = NULL) {
+  if (!is.null(z)) {
+    ds <- split(data, data[z])
+  } else {
+    ds <- list(data)
+  }
+
+  out <- lapply(ds, \(.ds){
+    plot_sankey_single(.ds,x = x, y = y,color.group = color.group, colors = colors)
+  })
+
+  patchwork::wrap_plots(out)
+}
+
+default_theme <- function() {
+  theme_void()
+}
+
+#' Beautiful sankey plot
+#'
+#' @param color.group
+#' @param colors
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+#' ds |> plot_sankey_single("first", "last")
+#' ds |> plot_sankey_single("first", "last", color.group = "y")
+plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL){
+  data <- data |> sankey_ready(x = x, y = y)
+# browser()
+  library(ggalluvial)
+
+  na.color <- "#2986cc"
+  box.color <- "#1E4B66"
+
+  if (is.null(colors)) {
+    if (color.group == "y") {
+      main.colors <- viridisLite::viridis(n = length(levels(data[[y]])))
+      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[[x]])))
+      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)
+  } else {
+    label.colors <- contrast_text(colors)
+  }
+
+  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 == "y") {
+    p <- p +
+      ggalluvial::geom_alluvium(
+        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(y)),
+                                   size = 2,
+                                   width = 1 / 3.4
+      )
+  } else {
+    p <- p +
+      ggalluvial::geom_alluvium(
+        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(x)),
+                                   size = 2,
+                                   width = 1 / 3.4
+      )
+  }
+
+  p +
+    ggplot2::geom_text(
+      stat = "stratum",
+      ggplot2::aes(label = after_stat(stratum)),
+      colour = label.colors,
+      size = 8,
+      lineheight = 1
+    ) +
+    ggplot2::scale_x_continuous(
+      breaks = 1:2,
+      labels = group_labels
+    ) +
+    ggplot2::scale_fill_manual(values = colors[-1], na.value = colors[1]) +
+    ggplot2::scale_color_manual(values = main.colors) +
+    ggplot2::theme_void() +
+    ggplot2::theme(
+      legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = element_blank(),
+      # axis.title.y = element_blank(),
+      axis.text.x = ggplot2::element_text(size = 20),
+      # text = element_text(size = 5),
+      # plot.title = element_blank(),
+      # panel.background = ggplot2::element_rect(fill = "white"),
+      plot.background = ggplot2::element_rect(fill = "white"),
+      panel.border = ggplot2::element_blank()
+    )
+}

R/shiny_freesearcheR.R

@@ -32,6 +32,6 @@ shiny_freesearcheR <- function(...) {
 #' @returns shiny app
 #' @export
 #'
-launch <- function(...){
+launch_freesearcheR <- function(...){
   shiny_freesearcheR(...)
 }

R/update-factor-ext.R

@@ -22,7 +22,6 @@
 #'
 #' @name update-factor
 #'
-#' @example examples/update_factor.R
 update_factor_ui <- function(id) {
   ns <- NS(id)
   tagList(

inst/apps/freesearcheR/app.R

@@ -10,7 +10,7 @@
 #### Current file: R//app_version.R 
 ########
 
-app_version <- function()'250227_1342'
+app_version <- function()'250305_1101'
 
 
 ########
@@ -984,7 +984,7 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
 #' @returns Shiny ui module
 #' @export
 #'
-data_visuals_ui <- function(id, tab_title="Plots", ...) {
+data_visuals_ui <- function(id, tab_title = "Plots", ...) {
   ns <- shiny::NS(id)
 
   # bslib::navset_bar(
@@ -1016,7 +1016,7 @@ data_visuals_ui <- function(id, tab_title="Plots", ...) {
             max = 300,
             value = 100,
             step = 1,
-            format = shinyWidgets::wNumbFormat(decimals=0),
+            format = shinyWidgets::wNumbFormat(decimals = 0),
             color = datamods:::get_primary_color()
           ),
           shinyWidgets::noUiSliderInput(
@@ -1026,7 +1026,7 @@ data_visuals_ui <- function(id, tab_title="Plots", ...) {
             max = 300,
             value = 100,
             step = 1,
-            format = shinyWidgets::wNumbFormat(decimals=0),
+            format = shinyWidgets::wNumbFormat(decimals = 0),
             color = datamods:::get_primary_color()
           ),
           shiny::selectInput(
@@ -1139,7 +1139,6 @@ data_visuals_server <- function(id,
           ),
           none_label = "No variable"
         )
-
       })
 
       output$tertiary <- shiny::renderUI({
@@ -1189,12 +1188,14 @@ data_visuals_server <- function(id,
         }),
         content = function(file) {
           shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
-          ggplot2::ggsave(filename = file,
+            ggplot2::ggsave(
+              filename = file,
               plot = rv$plot(),
               width = input$width,
               height = input$height,
               dpi = 300,
-                          units = "mm",scale = 2)
+              units = "mm", scale = 2
+            )
           })
         }
       )
@@ -1214,7 +1215,7 @@ data_visuals_server <- function(id,
 #' @param data vector
 #' @param ... exclude
 #'
-#' @returns
+#' @returns vector
 #' @export
 #'
 #' @examples
@@ -1229,7 +1230,7 @@ all_but <- function(data, ...) {
 #' @param types desired types
 #' @param type.fun function to get type. Default is outcome_type
 #'
-#' @returns
+#' @returns vector
 #' @export
 #'
 #' @examples
@@ -1266,7 +1267,8 @@ subset_types <- function(data, types, type.fun = outcome_type) {
 supported_plots <- function() {
   list(
     plot_hbars = list(
-      descr = "Stacked horizontal bars (Grotta bars)",
+      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"),
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -1274,6 +1276,7 @@ supported_plots <- function() {
     ),
     plot_violin = list(
       descr = "Violin plot",
+      note = "A modern alternative to the classic boxplot to visualise data distribution",
       primary.type = c("continuous", "dichotomous", "ordinal"),
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -1281,13 +1284,23 @@ supported_plots <- function() {
     ),
     plot_ridge = list(
       descr = "Ridge plot",
+      note = "An alternative option to visualise data distribution",
       primary.type = "continuous",
       secondary.type = c("dichotomous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
       secondary.extra = NULL
     ),
+    plot_sankey = list(
+      descr = "Sankey plot",
+      note = "A way of visualising change between groups",
+      primary.type = c("dichotomous", "ordinal"),
+      secondary.type = c("dichotomous", "ordinal"),
+      tertiary.type = c("dichotomous", "ordinal"),
+      secondary.extra = NULL
+    ),
     plot_scatter = list(
       descr = "Scatter plot",
+      note = "A classic way of showing the association between to variables",
       primary.type = "continuous",
       secondary.type = c("continuous", "ordinal"),
       tertiary.type = c("dichotomous", "ordinal"),
@@ -1298,9 +1311,11 @@ supported_plots <- function() {
 
 #' Title
 #'
-#' @returns
+#' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |>
 #'   default_parsing() |>
@@ -1398,7 +1413,9 @@ get_plot_options <- function(data) {
 #' @param type plot type (derived from possible_plots() and matches custom function)
 #' @param ... ignored for now
 #'
-#' @returns
+#' @name data-plots
+#'
+#' @returns ggplot2 object
 #' @export
 #'
 #' @examples
@@ -1424,6 +1441,8 @@ create_plot <- function(data, type, x, y, z = NULL, ...) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_hbars(x = "carb", y = "cyl")
 #' mtcars |> plot_hbars(x = "carb", y = NULL)
@@ -1523,6 +1542,7 @@ vertical_stacked_bars <- function(data,
 #'
 #' @examples
 #' mtcars |> get_label(var = "mpg")
+#' mtcars |> get_label()
 #' mtcars$mpg |> get_label()
 #' gtsummary::trial |> get_label(var = "trt")
 #' 1:10 |> get_label()
@@ -1530,13 +1550,16 @@ get_label <- function(data, var = NULL) {
   if (!is.null(var)) {
     data <- data[[var]]
   }
-
   out <- REDCapCAST::get_attr(data = data, attr = "label")
   if (is.na(out)) {
     if (is.null(var)) {
       out <- deparse(substitute(data))
     } else {
+      if (is.symbol(var)) {
         out <- gsub('\"', "", deparse(substitute(var)))
+      } else {
+        out <- var
+      }
     }
   }
   out
@@ -1548,6 +1571,8 @@ get_label <- function(data, var = NULL) {
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
 plot_violin <- function(data, x, y, z = NULL) {
@@ -1569,11 +1594,13 @@ plot_violin <- function(data, x, y, z = NULL) {
 }
 
 
-#' Beatiful violin plot
+#' Beautiful violin plot
 #'
 #' @returns ggplot2 object
 #' @export
 #'
+#' @name data-plots
+#'
 #' @examples
 #' mtcars |> plot_scatter(x = "mpg", y = "wt")
 plot_scatter <- function(data, x, y, z = NULL) {
@@ -1593,6 +1620,194 @@ plot_scatter <- function(data, x, y, z = NULL) {
   }
 }
 
+#' Readying data for sankey plot
+#'
+#' @param data
+#' @param x
+#' @param y
+#' @param z
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = sample(c(letters[1:4], NA), 100, TRUE, prob = c(rep(.23, 4), .08)))
+#' ds |> sankey_ready("first", "last")
+#' ds |> sankey_ready("first", "last", numbers = "percentage")
+sankey_ready <- function(data, x, y, z = NULL, numbers = "count") {
+  ## TODO: Ensure ordering x and y
+
+  if (is.null(z)) {
+    out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y))
+  } else {
+    out <- dplyr::count(data, !!dplyr::sym(x), !!dplyr::sym(y), !!dplyr::sym(z))
+  }
+  out <- out |>
+    dplyr::group_by(!!dplyr::sym(x)) |>
+    dplyr::mutate(gx.sum = sum(n)) |>
+    dplyr::ungroup() |>
+    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(x), "\n(n=", gx.sum, ")")),
+      ly = factor(paste0(!!dplyr::sym(y), "\n(n=", gy.sum, ")"))
+    )
+  } else if (numbers == "percentage") {
+    out <- out |> dplyr::mutate(
+      lx = factor(paste0(!!dplyr::sym(x), "\n(", round((gx.sum / sum(n)) * 100, 1), "%)")),
+      ly = factor(paste0(!!dplyr::sym(y), "\n(", round((gy.sum / sum(n)) * 100, 1), "%)"))
+    )
+  }
+  out
+}
+
+#' Line breaking at given number of characters for nicely plotting labels
+#'
+#' @param data
+#' @param lineLength
+#'
+#' @returns
+#' @export
+#'
+#' @examples
+line_break <- function(data, lineLength = 20) {
+  # gsub(paste0('(.{1,',lineLength,'})(\\s)'), '\\1\n', data)
+  paste(strwrap(data, lineLength), collapse = "\n")
+  ## https://stackoverflow.com/a/29847221
+}
+
+#' Beautiful sankey plot with option to split by a tertiary group
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @name data-plots
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+#' 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, x, y, z = NULL, color.group = "x", colors = NULL) {
+  if (!is.null(z)) {
+    ds <- split(data, data[z])
+  } else {
+    ds <- list(data)
+  }
+
+  out <- lapply(ds, \(.ds){
+    plot_sankey_single(.ds,x = x, y = y,color.group = color.group, colors = colors)
+  })
+
+  patchwork::wrap_plots(out)
+}
+
+default_theme <- function() {
+  theme_void()
+}
+
+#' Beautiful sankey plot
+#'
+#' @param color.group
+#' @param colors
+#'
+#' @returns ggplot2 object
+#' @export
+#'
+#' @examples
+#' ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+#' ds |> plot_sankey_single("first", "last")
+#' ds |> plot_sankey_single("first", "last", color.group = "y")
+plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL){
+  data <- data |> sankey_ready(x = x, y = y)
+
+  library(ggalluvial)
+
+  na.color <- "#2986cc"
+  box.color <- "#1E4B66"
+
+  if (is.null(colors)) {
+    if (color.group == "y") {
+      main.colors <- viridisLite::viridis(n = length(levels(data[[y]])))
+      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[[x]])))
+      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)
+  } else {
+    label.colors <- contrast_text(colors)
+  }
+
+
+
+  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 == "y") {
+    p <- p +
+      ggalluvial::geom_alluvium(
+        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(y)),
+                                   size = 2,
+                                   width = 1 / 3.4
+      )
+  } else {
+    p <- p +
+      ggalluvial::geom_alluvium(
+        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(x)),
+                                   size = 2,
+                                   width = 1 / 3.4
+      )
+  }
+
+  p +
+    ggplot2::geom_text(
+      stat = "stratum",
+      ggplot2::aes(label = after_stat(stratum)),
+      colour = label.colors,
+      size = 8,
+      lineheight = 1
+    ) +
+    ggplot2::scale_x_continuous(
+      breaks = 1:2,
+      labels = group_labels
+    ) +
+    ggplot2::scale_fill_manual(values = colors[-1], na.value = colors[1]) +
+    ggplot2::scale_color_manual(values = main.colors) +
+    ggplot2::theme_void() +
+    ggplot2::theme(
+      legend.position = "none",
+      # panel.grid.major = element_blank(),
+      # panel.grid.minor = element_blank(),
+      # axis.text.y = element_blank(),
+      # axis.title.y = element_blank(),
+      axis.text.x = ggplot2::element_text(size = 20),
+      # text = element_text(size = 5),
+      # plot.title = element_blank(),
+      # panel.background = ggplot2::element_rect(fill = "white"),
+      plot.background = ggplot2::element_rect(fill = "white"),
+      panel.border = ggplot2::element_blank()
+    )
+}
 
 
 ########
@@ -3811,7 +4026,7 @@ shiny_freesearcheR <- function(...) {
 #' @returns shiny app
 #' @export
 #'
-launch <- function(...){
+launch_freesearcheR <- function(...){
   shiny_freesearcheR(...)
 }
 
@@ -3926,7 +4141,6 @@ gg_theme_export <- function(){
 #'
 #' @name update-factor
 #'
-#' @example examples/update_factor.R
 update_factor_ui <- function(id) {
   ns <- NS(id)
   tagList(
@@ -6430,33 +6644,6 @@ server <- function(input, output, session) {
       gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
   })
 
-  # shiny::observe(
-  #   # list(
-  #   #   input$plot_model
-  #   # ),
-  #   {
-  #     shiny::req(rv$list$regression$tables)
-  #     shiny::req(input$plot_model)
-  #     tryCatch(
-  #       {
-  #         out <- merge_long(rv$list$regression, input$plot_model) |>
-  #           plot.tbl_regression(
-  #             colour = "variable",
-  #             facet_col = "model"
-  #           )
-  #
-  #         rv$list$regression$plot <- out
-  #       },
-  #       warning = function(warn) {
-  #         showNotification(paste0(warn), type = "warning")
-  #       },
-  #       error = function(err) {
-  #         showNotification(paste0("Plotting failed with the following error: ", err), type = "err")
-  #       }
-  #     )
-  #   }
-  # )
-
   output$regression_plot <- shiny::renderPlot(
     {
       # shiny::req(rv$list$regression$plot)

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

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

man/all_but.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{all_but}
+\alias{all_but}
+\title{Select all from vector but}
+\usage{
+all_but(data, ...)
+}
+\arguments{
+\item{data}{vector}
+
+\item{...}{exclude}
+}
+\value{
+vector
+}
+\description{
+Select all from vector but
+}
+\examples{
+all_but(1:10, c(2, 3), 11, 5)
+}

man/append_list.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{append_list}
+\alias{append_list}
+\title{Append list with named index}
+\usage{
+append_list(data, list, index)
+}
+\arguments{
+\item{data}{data to add to list}
+
+\item{list}{list}
+
+\item{index}{index name}
+}
+\value{
+list
+}
+\description{
+Append list with named index
+}
+\examples{
+ls_d <- list(test=c(1:20))
+ls_d <- list()
+data.frame(letters[1:20],1:20) |> append_list(ls_d,"letters")
+letters[1:20]|> append_list(ls_d,"letters")
+}

man/columnSelectInput.Rd

@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/columnSelectInput.R
+\name{columnSelectInput}
+\alias{columnSelectInput}
+\title{A selectizeInput customized for data frames with column labels}
+\usage{
+columnSelectInput(
+  inputId,
+  label,
+  data,
+  selected = "",
+  ...,
+  col_subset = NULL,
+  placeholder = "",
+  onInitialize,
+  none_label = "No variable selected"
+)
+}
+\arguments{
+\item{inputId}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{label}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{data}{\code{data.frame} object from which fields should be populated}
+
+\item{selected}{default selection}
+
+\item{...}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{col_subset}{a \code{vector} containing the list of allowable columns to select}
+
+\item{placeholder}{passed to \code{\link[shiny]{selectizeInput}} options}
+
+\item{onInitialize}{passed to \code{\link[shiny]{selectizeInput}} options}
+
+\item{none_label}{label for "none" item}
+}
+\value{
+a \code{\link[shiny]{selectizeInput}} dropdown element
+}
+\description{
+Copied and modified from the IDEAFilter package
+Adds the option to select "none" which is handled later
+}
+\keyword{internal}

man/contrast_text.Rd

@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/contrast_text.R
+\name{contrast_text}
+\alias{contrast_text}
+\title{Contrast Text Color}
+\usage{
+contrast_text(
+  background,
+  light_text = "white",
+  dark_text = "black",
+  threshold = 0.5,
+  method = "perceived_2",
+  ...
+)
+}
+\arguments{
+\item{background}{A hex/named color value that represents the background.}
+
+\item{light_text}{A hex/named color value that represents the light text
+color.}
+
+\item{dark_text}{A hex/named color value that represents the dark text color.}
+
+\item{threshold}{A numeric value between 0 and 1 that is used to determine
+the luminance threshold of the background color for text color.}
+
+\item{method}{A character string that specifies the method for calculating
+the luminance. Three different methods are available:
+c("relative","perceived","perceived_2")}
+
+\item{...}{parameter overflow. Ignored.}
+}
+\value{
+A character string that contains the best contrast text color.
+}
+\description{
+Calculates the best contrast text color for a given
+background color.
+}
+\details{
+This function aids in deciding the font color to print on a given background.
+The function is based on the example provided by teppo:
+https://stackoverflow.com/a/66669838/21019325.
+The different methods provided are based on the methods outlined in the
+StackOverflow thread:
+https://stackoverflow.com/questions/596216/formula-to-determine-perceived-brightness-of-rgb-color
+}
+\examples{
+contrast_text(c("#F2F2F2", "blue"))
+
+contrast_text(c("#F2F2F2", "blue"), method="relative")
+}

man/data-correlations.Rd

@@ -1,19 +1,25 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/correlations-module.R
+% Please edit documentation in R/correlations-module.R, R/data_plots.R
 \name{data-correlations}
 \alias{data-correlations}
 \alias{data_correlations_ui}
 \alias{data_correlations_server}
+\alias{data_visuals_ui}
+\alias{data_visuals_server}
 \title{Data correlations evaluation module}
 \usage{
 data_correlations_ui(id, ...)
 
 data_correlations_server(id, data, include.class = NULL, cutoff = 0.7, ...)
+
+data_visuals_ui(id, tab_title = "Plots", ...)
+
+data_visuals_server(id, data, ...)
 }
 \arguments{
 \item{id}{Module id. (Use 'ns("id")')}
 
-\item{...}{arguments passed to toastui::datagrid}
+\item{...}{ignored}
 
 \item{data}{data}
 
@@ -24,8 +30,14 @@ data_correlations_server(id, data, include.class = NULL, cutoff = 0.7, ...)
 \value{
 Shiny ui module
 
+shiny server module
+
+Shiny ui module
+
 shiny server module
 }
 \description{
+Data correlations evaluation module
+
 Data correlations evaluation module
 }

man/data-plots.Rd

@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{data-plots}
+\alias{data-plots}
+\alias{plot_ridge}
+\alias{create_plot}
+\alias{plot_hbars}
+\alias{plot_violin}
+\alias{plot_scatter}
+\alias{plot_sankey}
+\title{Title}
+\usage{
+plot_ridge(data, x, y, z = NULL, ...)
+
+create_plot(data, type, x, y, z = NULL, ...)
+
+plot_hbars(data, x, y, z = NULL)
+
+plot_violin(data, x, y, z = NULL)
+
+plot_scatter(data, x, y, z = NULL)
+
+plot_sankey(data, x, y, z = NULL, color.group = "x", colors = NULL)
+}
+\arguments{
+\item{...}{ignored for now}
+
+\item{type}{plot type (derived from possible_plots() and matches custom function)}
+}
+\value{
+ggplot2 object
+
+ggplot2 object
+
+ggplot2 object
+
+ggplot2 object
+
+ggplot2 object
+
+ggplot2 object
+}
+\description{
+Title
+
+Wrapper to create plot based on provided type
+
+Nice horizontal stacked bars (Grotta bars)
+
+Beatiful violin plot
+
+Beautiful violin plot
+
+Beautiful sankey plot with option to split by a tertiary group
+}
+\examples{
+mtcars |>
+  default_parsing() |>
+  plot_ridge(x = "mpg", y = "cyl")
+mtcars |> plot_ridge(x = "mpg", y = "cyl", z = "gear")
+create_plot(mtcars, "plot_violin", "mpg", "cyl")
+mtcars |> plot_hbars(x = "carb", y = "cyl")
+mtcars |> plot_hbars(x = "carb", y = NULL)
+mtcars |> plot_violin(x = "mpg", y = "cyl", z = "gear")
+mtcars |> plot_scatter(x = "mpg", y = "wt")
+ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+ds |> plot_sankey("first", "last")
+ds |> plot_sankey("first", "last", color.group = "y")
+ds |> plot_sankey("first", "last", z = "g", color.group = "y")
+}

man/get_label.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{get_label}
+\alias{get_label}
+\title{Print label, and if missing print variable name}
+\usage{
+get_label(data, var = NULL)
+}
+\arguments{
+\item{data}{vector or data frame}
+}
+\value{
+character string
+}
+\description{
+Print label, and if missing print variable name
+}
+\examples{
+mtcars |> get_label(var = "mpg")
+mtcars |> get_label()
+mtcars$mpg |> get_label()
+gtsummary::trial |> get_label(var = "trt")
+1:10 |> get_label()
+}

man/get_plot_options.Rd

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

man/is_valid_redcap_url.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_read_shiny_module.R
+\name{is_valid_redcap_url}
+\alias{is_valid_redcap_url}
+\title{Title}
+\usage{
+is_valid_redcap_url(url)
+}
+\arguments{
+\item{url}{}
+}
+\description{
+Title
+}
+\examples{
+url <- c(
+  "www.example.com",
+  "http://example.com",
+  "https://redcap.your.inst/api/"
+)
+is_valid_redcap_url(url)
+}

man/is_valid_token.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_read_shiny_module.R
+\name{is_valid_token}
+\alias{is_valid_token}
+\title{Validate REDCap token}
+\usage{
+is_valid_token(token, pattern_env = NULL, nchar = 32)
+}
+\arguments{
+\item{token}{token}
+
+\item{pattern_env}{pattern}
+}
+\description{
+Validate REDCap token
+}
+\examples{
+token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
+is_valid_token(token)
+}

man/launch_freesearcheR.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/shiny_freesearcheR.R
-\name{launch}
+\name{launch_freesearcheR}
-\alias{launch}
+\alias{launch_freesearcheR}
 \title{Easily launch the freesearcheR app}
 \usage{
-launch(...)
+launch_freesearcheR(...)
 }
 \arguments{
 \item{...}{passed on to \code{shiny::runApp()}}

man/line_break.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{line_break}
+\alias{line_break}
+\title{Line breaking at given number of characters for nicely plotting labels}
+\usage{
+line_break(data, lineLength = 20)
+}
+\arguments{
+\item{lineLength}{}
+}
+\description{
+Line breaking at given number of characters for nicely plotting labels
+}

man/plot_sankey_single.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{plot_sankey_single}
+\alias{plot_sankey_single}
+\title{Beautiful sankey plot}
+\usage{
+plot_sankey_single(data, x, y, color.group = "x", colors = NULL)
+}
+\arguments{
+\item{colors}{}
+}
+\value{
+ggplot2 object
+}
+\description{
+Beautiful sankey plot
+}
+\examples{
+ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)))
+ds |> plot_sankey_single("first", "last")
+ds |> plot_sankey_single("first", "last", color.group = "y")
+}

man/possible_plots.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{possible_plots}
+\alias{possible_plots}
+\title{Get possible regression models}
+\usage{
+possible_plots(data)
+}
+\arguments{
+\item{data}{data}
+}
+\value{
+character vector
+}
+\description{
+Get possible regression models
+}
+\examples{
+mtcars |>
+  default_parsing() |>
+  dplyr::pull("cyl") |>
+  possible_plots()
+
+mtcars |>
+  default_parsing() |>
+  dplyr::select("mpg") |>
+  possible_plots()
+}

man/redcap_read_shiny_module.Rd

@@ -1,30 +1,21 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/redcap_read_shiny_module.R
-\docType{data}
 \name{m_redcap_readUI}
 \alias{m_redcap_readUI}
 \alias{m_redcap_readServer}
-\alias{tdm_redcap_read}
+\alias{redcap_demo_app}
-\alias{redcap_app}
 \title{Shiny module to browser and export REDCap data}
-\format{
-An object of class \code{teal_data_module} of length 2.
-}
 \usage{
 m_redcap_readUI(id, include_title = TRUE)
 
-m_redcap_readServer(id, output.format = c("df", "teal", "list"))
+m_redcap_readServer(id)
 
-tdm_redcap_read
+redcap_demo_app()
-
-redcap_app()
 }
 \arguments{
 \item{id}{Namespace id}
 
 \item{include_title}{logical to include title}
-
-\item{output.format}{data.frame ("df") or teal data object ("teal")}
 }
 \value{
 shiny ui element
@@ -34,13 +25,10 @@ shiny server module
 \description{
 Shiny module to browser and export REDCap data
 
-REDCap import teal data module
-
 Test app for the redcap_read_shiny_module
 }
 \examples{
 \dontrun{
-redcap_app()
+redcap_demo_app()
 }
 }
-\keyword{datasets}

man/sankey_ready.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{sankey_ready}
+\alias{sankey_ready}
+\title{Readying data for sankey plot}
+\usage{
+sankey_ready(data, x, y, z = NULL, numbers = "count")
+}
+\arguments{
+\item{z}{}
+}
+\description{
+Readying data for sankey plot
+}
+\examples{
+ds <- data.frame(g = sample(LETTERS[1:2], 100, TRUE), first = REDCapCAST::as_factor(sample(letters[1:4], 100, TRUE)), last = sample(c(letters[1:4], NA), 100, TRUE, prob = c(rep(.23, 4), .08)))
+ds |> sankey_ready("first", "last")
+ds |> sankey_ready("first", "last", numbers = "percentage")
+}

man/subset_types.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{subset_types}
+\alias{subset_types}
+\title{Easily subset by data type function}
+\usage{
+subset_types(data, types, type.fun = outcome_type)
+}
+\arguments{
+\item{data}{data}
+
+\item{types}{desired types}
+
+\item{type.fun}{function to get type. Default is outcome_type}
+}
+\value{
+vector
+}
+\description{
+Easily subset by data type function
+}
+\examples{
+default_parsing(mtcars) |> subset_types("ordinal")
+default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal"))
+#' default_parsing(mtcars) |> subset_types("factor",class)
+}

man/supported_plots.Rd

@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{supported_plots}
+\alias{supported_plots}
+\title{Implemented functions}
+\usage{
+supported_plots()
+}
+\value{
+list
+}
+\description{
+Library of supported functions. The list name and "descr" element should be
+unique for each element on list.
+\itemize{
+\item descr: Plot description
+\item primary.type: Primary variable data type (continuous, dichotomous or ordinal)
+\item secondary.type: Secondary variable data type (continuous, dichotomous or ordinal)
+\item secondary.extra: "none" or NULL to have option to choose none.
+\item tertiary.type: Tertiary variable data type (continuous, dichotomous or ordinal)
+}
+}
+\examples{
+supported_plots() |> str()
+}

man/update-factor.Rd

@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/update-factor-ext.R
+\name{update-factor}
+\alias{update-factor}
+\alias{update_factor_ui}
+\alias{update_factor_server}
+\alias{modal_update_factor}
+\title{Module to Reorder the Levels of a Factor Variable}
+\usage{
+update_factor_ui(id)
+
+update_factor_server(id, data_r = reactive(NULL))
+
+modal_update_factor(
+  id,
+  title = i18n("Update levels of a factor"),
+  easyClose = TRUE,
+  size = "l",
+  footer = NULL
+)
+}
+\arguments{
+\item{id}{Module ID.}
+
+\item{data_r}{A \code{\link[shiny:reactive]{shiny::reactive()}} function returning a \code{data.frame}.}
+
+\item{title}{An optional title for the dialog.}
+
+\item{easyClose}{If \code{TRUE}, the modal dialog can be dismissed by
+clicking outside the dialog box, or be pressing the Escape key. If
+\code{FALSE} (the default), the modal dialog can't be dismissed in those
+ways; instead it must be dismissed by clicking on a \code{modalButton()}, or
+from a call to \code{\link[shiny:removeModal]{removeModal()}} on the server.}
+
+\item{size}{One of \code{"s"} for small, \code{"m"} (the default) for medium,
+\code{"l"} for large, or \code{"xl"} for extra large. Note that \code{"xl"} only
+works with Bootstrap 4 and above (to opt-in to Bootstrap 4+,
+pass \code{\link[bslib:bs_theme]{bslib::bs_theme()}} to the \code{theme} argument of a page container
+like \code{\link[shiny:fluidPage]{fluidPage()}}).}
+
+\item{footer}{UI for footer. Use \code{NULL} for no footer.}
+}
+\value{
+A \code{\link[shiny:reactive]{shiny::reactive()}} function returning the data.
+}
+\description{
+This module contain an interface to reorder the levels of a factor variable.
+}

man/vertical_stacked_bars.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data_plots.R
+\name{vertical_stacked_bars}
+\alias{vertical_stacked_bars}
+\title{Vertical stacked bar plot wrapper}
+\usage{
+vertical_stacked_bars(
+  data,
+  score = "full_score",
+  group = "pase_0_q",
+  strata = NULL,
+  t.size = 10,
+  l.color = "black",
+  l.size = 0.5,
+  draw.lines = TRUE
+)
+}
+\arguments{
+\item{t.size}{}
+}
+\description{
+Vertical stacked bar plot wrapper
+}