updated data import

DESCRIPTION

@@ -22,7 +22,6 @@ Imports:
     readr,
     shiny,
     MASS,
-    REDCapCAST,
     purrr,
     broom,
     broom.helpers,
@@ -65,7 +64,8 @@ Imports:
     ggstats,
     rempsyc,
     ggridges,
-    ggalluvial
+    ggalluvial,
+    REDCapCAST
 Suggests: 
     styler,
     devtools,

NAMESPACE

@@ -9,6 +9,7 @@ export(argsstring2list)
 export(baseline_table)
 export(clean_date)
 export(clean_sep)
+export(columnSelectInput)
 export(contrast_text)
 export(create_overview_datagrid)
 export(create_plot)
@@ -23,6 +24,7 @@ export(data_visuals_server)
 export(data_visuals_ui)
 export(default_format_arguments)
 export(default_parsing)
+export(drop_empty_event)
 export(factorize)
 export(file_export)
 export(format_writer)
@@ -32,6 +34,10 @@ export(get_plot_options)
 export(getfun)
 export(gg_theme_export)
 export(gg_theme_shiny)
+export(grepl_fix)
+export(import_delim)
+export(import_file_server)
+export(import_file_ui)
 export(index_embed)
 export(is_any_class)
 export(is_consecutive)
@@ -65,7 +71,9 @@ export(regression_model_uv_list)
 export(regression_table)
 export(remove_empty_cols)
 export(remove_na_attr)
+export(repeated_instruments)
 export(sankey_ready)
+export(selectInputIcon)
 export(shiny_freesearcheR)
 export(specify_qmd_format)
 export(subset_types)
@@ -76,7 +84,9 @@ export(update_factor_server)
 export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_ui)
+export(vectorSelectInput)
 export(vertical_stacked_bars)
+export(wide2long)
 export(winbox_cut_variable)
 export(winbox_update_factor)
 export(write_quarto)
@@ -90,11 +100,22 @@ importFrom(graphics,hist)
 importFrom(graphics,par)
 importFrom(graphics,plot.new)
 importFrom(graphics,plot.window)
+importFrom(htmltools,css)
+importFrom(htmltools,tagAppendAttributes)
+importFrom(htmltools,tagAppendChild)
 importFrom(htmltools,tagList)
 importFrom(htmltools,tags)
+importFrom(htmltools,validateCssUnit)
+importFrom(phosphoricons,ph)
+importFrom(readxl,excel_sheets)
+importFrom(rio,import)
 importFrom(rlang,"%||%")
 importFrom(rlang,call2)
+importFrom(rlang,exec)
 importFrom(rlang,expr)
+importFrom(rlang,fn_fmls_names)
+importFrom(rlang,is_function)
+importFrom(rlang,is_named)
 importFrom(rlang,set_names)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
@@ -103,6 +124,7 @@ importFrom(shiny,actionButton)
 importFrom(shiny,bindEvent)
 importFrom(shiny,checkboxInput)
 importFrom(shiny,column)
+importFrom(shiny,fileInput)
 importFrom(shiny,fluidRow)
 importFrom(shiny,getDefaultReactiveDomain)
 importFrom(shiny,icon)
@@ -114,8 +136,10 @@ importFrom(shiny,observeEvent)
 importFrom(shiny,plotOutput)
 importFrom(shiny,reactive)
 importFrom(shiny,reactiveValues)
+importFrom(shiny,removeUI)
 importFrom(shiny,renderPlot)
 importFrom(shiny,req)
+importFrom(shiny,restoreInput)
 importFrom(shiny,selectizeInput)
 importFrom(shiny,showModal)
 importFrom(shiny,tagList)
@@ -123,8 +147,13 @@ importFrom(shiny,textInput)
 importFrom(shiny,uiOutput)
 importFrom(shiny,updateActionButton)
 importFrom(shinyWidgets,WinBox)
+importFrom(shinyWidgets,dropMenu)
 importFrom(shinyWidgets,noUiSliderInput)
+importFrom(shinyWidgets,numericInputIcon)
+importFrom(shinyWidgets,pickerInput)
 importFrom(shinyWidgets,prettyCheckbox)
+importFrom(shinyWidgets,textInputIcon)
+importFrom(shinyWidgets,updatePickerInput)
 importFrom(shinyWidgets,updateVirtualSelect)
 importFrom(shinyWidgets,virtualSelectInput)
 importFrom(shinyWidgets,wbControls)
@@ -137,4 +166,6 @@ importFrom(toastui,grid_colorbar)
 importFrom(toastui,grid_columns)
 importFrom(toastui,renderDatagrid)
 importFrom(toastui,renderDatagrid2)
+importFrom(tools,file_ext)
+importFrom(utils,head)
 importFrom(utils,type.convert)

NEWS.md

@@ -2,6 +2,9 @@
 
 Focus is on polish and improved ui/ux.
 
+First steps towards an updated name (will be FreesearchR), with renamed repository. Also, the repo will move to an organisation (named FreesearchR).
+
+Testing file upload conducted and improved.
 
 # freesearcheR 25.3.1
 

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250307_1453'
+app_version <- function()'250311_1338'

R/custom_SelectInput.R

@@ -87,7 +87,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ...,
 #'
 #' @param inputId passed to \code{\link[shiny]{selectizeInput}}
 #' @param label passed to \code{\link[shiny]{selectizeInput}}
-#' @param data A named \code{vector} object from which fields should be populated
+#' @param choices A named \code{vector} from which fields should be populated
 #' @param selected default selection
 #' @param ... passed to \code{\link[shiny]{selectizeInput}}
 #' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options
@@ -126,12 +126,12 @@ columnSelectInput <- function(inputId, label, data, selected = "", ...,
 #' }
 vectorSelectInput <- function(inputId,
                               label,
-                              data,
+                              choices,
                               selected = "",
                               ...,
                               placeholder = "",
                               onInitialize) {
-  datar <- if (shiny::is.reactive(data)) data else shiny::reactive(data)
+  datar <- if (shiny::is.reactive(choices)) data else shiny::reactive(choices)
 
   labels <- sprintf(
     IDEAFilter:::strip_leading_ws('
@@ -143,12 +143,12 @@ vectorSelectInput <- function(inputId,
     names(datar()) %||% ""
   )
 
-  choices <- stats::setNames(datar(), labels)
+  choices_new <- stats::setNames(datar(), labels)
 
   shiny::selectizeInput(
     inputId = inputId,
     label = label,
-    choices = choices,
+    choices = choices_new,
     selected = selected,
     ...,
     options = c(

R/data-summary.R

@@ -84,6 +84,11 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
         s <- summary(data)
         ds <- data.frame(x = names(s), y = s)
         horizontal <- FALSE
+      } else if (identical(data_cl, "logical")) {
+        type <- "column"
+        s <- table(data)
+        ds <- data.frame(x = names(s), y = as.vector(s))
+        horizontal <- FALSE
       } else if (any(c("numeric", "integer") %in% data_cl)) {
         if (is_consecutive(data)) {
           type <- "line"

R/data_plots.R

@@ -306,14 +306,14 @@ supported_plots <- function() {
       tertiary.type = c("dichotomous", "ordinal"),
       secondary.extra = "none"
     ),
-    plot_ridge = list(
+    # plot_ridge = list(
-      descr = "Ridge plot",
+    #   descr = "Ridge plot",
-      note = "An alternative option to visualise data distribution",
+    #   note = "An alternative option to visualise data distribution",
-      primary.type = "continuous",
+    #   primary.type = "continuous",
-      secondary.type = c("dichotomous", "ordinal"),
+    #   secondary.type = c("dichotomous", "ordinal"),
-      tertiary.type = c("dichotomous", "ordinal"),
+    #   tertiary.type = c("dichotomous", "ordinal"),
-      secondary.extra = NULL
+    #   secondary.extra = NULL
-    ),
+    # ),
     plot_sankey = list(
       descr = "Sankey plot",
       note = "A way of visualising change between groups",
@@ -434,6 +434,10 @@ get_plot_options <- function(data) {
 
 #' Wrapper to create plot based on provided type
 #'
+#' @param data data.frame
+#' @param x primary variable
+#' @param y secondary variable
+#' @param z tertiary variable
 #' @param type plot type (derived from possible_plots() and matches custom function)
 #' @param ... ignored for now
 #'
@@ -479,13 +483,13 @@ plot_hbars <- function(data, x, y, z = NULL) {
 
 #' Vertical stacked bar plot wrapper
 #'
-#' @param data
+#' @param data data.frame
-#' @param score
+#' @param score outcome variable
-#' @param group
+#' @param group grouping variable
-#' @param strata
+#' @param strata stratifying variable
-#' @param t.size
+#' @param t.size text size
 #'
-#' @return
+#' @return ggplot2 object
 #' @export
 #'
 vertical_stacked_bars <- function(data,
@@ -560,6 +564,7 @@ vertical_stacked_bars <- function(data,
 #' Print label, and if missing print variable name
 #'
 #' @param data vector or data frame
+#' @param var variable name. Optional.
 #'
 #' @returns character string
 #' @export
@@ -571,7 +576,7 @@ vertical_stacked_bars <- function(data,
 #' gtsummary::trial |> get_label(var = "trt")
 #' 1:10 |> get_label()
 get_label <- function(data, var = NULL) {
-  if (!is.null(var)) {
+  if (!is.null(var) & is.data.frame(data)) {
     data <- data[[var]]
   }
   out <- REDCapCAST::get_attr(data = data, attr = "label")
@@ -610,7 +615,7 @@ plot_violin <- function(data, x, y, z = NULL) {
     rempsyc::nice_violin(
       data = .ds,
       group = y,
-      response = x, xtitle = get_label(data, var = x), ytitle = get_label(data, var = y)
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
     )
   })
 
@@ -632,26 +637,23 @@ plot_scatter <- function(data, x, y, z = NULL) {
     rempsyc::nice_scatter(
       data = data,
       predictor = y,
-      response = x, xtitle = get_label(data, var = x), ytitle = get_label(data, var = y)
+      response = x, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
     )
   } else {
     rempsyc::nice_scatter(
       data = data,
       predictor = y,
       response = x,
-      group = z
+      group = z, xtitle = get_label(data, var = y), ytitle = get_label(data, var = x)
     )
   }
 }
 
 #' Readying data for sankey plot
 #'
-#' @param data
+#' @name data-plots
-#' @param x
-#' @param y
-#' @param z
 #'
-#' @returns
+#' @returns data.frame
 #' @export
 #'
 #' @examples
@@ -686,37 +688,44 @@ sankey_ready <- function(data, x, y, z = NULL, numbers = "count") {
     )
   }
 
-  if (is.factor(data[[x]])){
+  if (is.factor(data[[x]])) {
-    index <- match(levels(data[[x]]),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])
+    out$lx <- factor(out$lx, levels = levels(out$lx)[index])
   }
 
-  if (is.factor(data[[y]])){
+  if (is.factor(data[[y]])) {
-    index <- match(levels(data[[y]]),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])
+    out$ly <- factor(out$ly, levels = levels(out$ly)[index])
   }
 
   out
 }
 
-str_remove_last <- function(data,pattern="\n"){
+str_remove_last <- function(data, pattern = "\n") {
-  strsplit(data,split = pattern) |>
+  strsplit(data, split = pattern) |>
-    lapply(\(.x)paste(unlist(.x[[-length(.x)]]),collapse=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 data string
-#' @param lineLength
+#' @param lineLength maximum line length
+#' @param fixed flag to force split at exactly the value given in lineLength.
+#' Default is FALSE, only splitting at spaces.
 #'
-#' @returns
+#' @returns character string
 #' @export
 #'
 #' @examples
-line_break <- function(data, lineLength = 20) {
+#' "Lorem ipsum... you know the routine" |> line_break()
-  # gsub(paste0('(.{1,',lineLength,'})(\\s)'), '\\1\n', data)
+#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(fixed=TRUE)
-  paste(strwrap(data, lineLength), collapse = "\n")
+line_break <- function(data, lineLength = 20, fixed = FALSE) {
+  if (isTRUE(force)) {
+    gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"), "\\1\n", data)
+  } else {
+    paste(strwrap(data, lineLength), collapse = "\n")
+  }
   ## https://stackoverflow.com/a/29847221
 }
 
@@ -740,7 +749,7 @@ plot_sankey <- function(data, x, y, z = NULL, color.group = "x", colors = NULL)
   }
 
   out <- lapply(ds, \(.ds){
-    plot_sankey_single(.ds,x = x, y = y,color.group = color.group, colors = colors)
+    plot_sankey_single(.ds, x = x, y = y, color.group = color.group, colors = colors)
   })
 
   patchwork::wrap_plots(out)
@@ -752,8 +761,9 @@ default_theme <- function() {
 
 #' Beautiful sankey plot
 #'
-#' @param color.group
+#' @param color.group set group to colour by. "x" or "y".
-#' @param colors
+#' @param colors optinally specify colors. Give NA color, color for each level
+#' in primary group and color for each level in secondary group.
 #' @param ... passed to sankey_ready()
 #'
 #' @returns ggplot2 object
@@ -763,9 +773,10 @@ default_theme <- function() {
 #' 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,...){
+plot_sankey_single <- function(data, x, y, color.group = c("x","y"), colors = NULL, ...) {
-  data <- data |> sankey_ready(x = x, y = y,...)
+  color.group <- match.arg(color.group)
-# browser()
+  data <- data |> sankey_ready(x = x, y = y, ...)
+  # browser()
   library(ggalluvial)
 
   na.color <- "#2986cc"
@@ -781,7 +792,7 @@ plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL,...){
       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)
+    colors <- c(na.color, main.colors, secondary.colors)
   } else {
     label.colors <- contrast_text(colors)
   }
@@ -801,8 +812,8 @@ plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL,...){
         knot.pos = 0.4,
         curve_type = "sigmoid"
       ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(y)),
-                                   size = 2,
+        size = 2,
-                                   width = 1 / 3.4
+        width = 1 / 3.4
       )
   } else {
     p <- p +
@@ -813,8 +824,8 @@ plot_sankey_single <- function(data,x,y, color.group = "x", colors = NULL,...){
         knot.pos = 0.4,
         curve_type = "sigmoid"
       ) + ggalluvial::geom_stratum(ggplot2::aes(fill = !!dplyr::sym(x)),
-                                   size = 2,
+        size = 2,
-                                   width = 1 / 3.4
+        width = 1 / 3.4
       )
   }
 

R/import-file-ext.R

@@ -0,0 +1,528 @@
+
+#' @title Import data from a file
+#'
+#' @description Let user upload a file and import data
+#'
+#' @param preview_data Show or not a preview of the data under the file input.
+#' @param file_extensions File extensions accepted by [shiny::fileInput()], can also be MIME type.
+#' @param layout_params How to display import parameters : in a dropdown button or inline below file input.
+#'
+#' @export
+#'
+#' @name import-file
+#'
+#' @importFrom shiny NS fileInput actionButton icon
+#' @importFrom htmltools tags tagAppendAttributes css tagAppendChild
+#' @importFrom shinyWidgets pickerInput numericInputIcon textInputIcon dropMenu
+#' @importFrom phosphoricons ph
+#' @importFrom toastui datagridOutput2
+#'
+#' @example examples/from-file.R
+import_file_ui <- function(id,
+                           title = TRUE,
+                           preview_data = TRUE,
+                           file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav"),
+                           layout_params = c("dropdown", "inline")) {
+
+  ns <- NS(id)
+
+  if (!is.null(layout_params)) {
+    layout_params <- match.arg(layout_params)
+  }
+
+  if (isTRUE(title)) {
+    title <- tags$h4(
+      datamods:::i18n("Import a file"),
+      class = "datamods-title"
+    )
+  }
+
+
+  params_ui <- shiny::fluidRow(
+    shiny::column(
+      width = 6,
+      shinyWidgets::numericInputIcon(
+        inputId = ns("skip_rows"),
+        label = datamods:::i18n("Rows to skip before reading data:"),
+        value = 0,
+        min = 0,
+        icon = list("n ="),
+        size = "sm",
+        width = "100%"
+      ),
+      shiny::tagAppendChild(
+        shinyWidgets::textInputIcon(
+          inputId = ns("na_label"),
+          label = datamods:::i18n("Missing values character(s):"),
+          value = "NA,,'',na",
+          icon = list("NA"),
+          size = "sm",
+          width = "100%"
+        ),
+        shiny::helpText(ph("info"), datamods:::i18n("if several use a comma (',') to separate them"))
+      )
+    ),
+    shiny::column(
+      width = 6,
+      shinyWidgets::textInputIcon(
+        inputId = ns("dec"),
+        label = datamods:::i18n("Decimal separator:"),
+        value = ".",
+        icon = list("0.00"),
+        size = "sm",
+        width = "100%"
+      ),
+      selectInputIcon(
+        inputId = ns("encoding"),
+        label = datamods:::i18n("Encoding:"),
+        choices = c("UTF-8"="UTF-8",
+                    "Latin1"="latin1"),
+        icon = phosphoricons::ph("text-aa"),
+        size = "sm",
+        width = "100%"
+      )
+    )
+  )
+
+  file_ui <- shiny::tagAppendAttributes(
+    shiny::fileInput(
+      inputId = ns("file"),
+      label = datamods:::i18n("Upload a file:"),
+      buttonLabel = datamods:::i18n("Browse..."),
+      placeholder = datamods:::i18n("No file selected"),
+      accept = file_extensions,
+      width = "100%"
+    ),
+    class = "mb-0"
+  )
+  if (identical(layout_params, "dropdown")) {
+    file_ui <- shiny::tags$div(
+      style = htmltools::css(
+        display = "grid",
+        gridTemplateColumns = "1fr 50px",
+        gridColumnGap = "10px"
+      ),
+      file_ui,
+      shiny::tags$div(
+        class = "shiny-input-container",
+        shiny::tags$label(
+          class = "control-label",
+          `for` = ns("dropdown_params"),
+          "...",
+          style = htmltools::css(visibility = "hidden")
+        ),
+        shinyWidgets::dropMenu(
+          shiny::actionButton(
+            inputId = ns("dropdown_params"),
+            label = ph("gear", title = "Parameters"),
+            width = "50px",
+            class = "px-1"
+          ),
+          params_ui
+        )
+      )
+    )
+  }
+  tags$div(
+    class = "datamods-import",
+    datamods:::html_dependency_datamods(),
+    title,
+    file_ui,
+    if (identical(layout_params, "inline")) params_ui,
+    tags$div(
+      class = "hidden",
+      id = ns("sheet-container"),
+      shinyWidgets::pickerInput(
+        inputId = ns("sheet"),
+        label = datamods:::i18n("Select sheet to import:"),
+        choices = NULL,
+        width = "100%"
+      )
+    ),
+    tags$div(
+      id = ns("import-placeholder"),
+      shinyWidgets::alert(
+        id = ns("import-result"),
+        status = "info",
+        shiny::tags$b(datamods:::i18n("No file selected:")),
+        sprintf(datamods:::i18n("You can import %s files"), paste(file_extensions, collapse = ", ")),
+        dismissible = TRUE
+      )
+    ),
+    if (isTRUE(preview_data)) {
+      toastui::datagridOutput2(outputId = ns("table"))
+    },
+    uiOutput(
+      outputId = ns("container_confirm_btn"),
+      style = "margin-top: 20px;"
+    ),
+    tags$div(
+      style = htmltools::css(display = "none"),
+      shiny::checkboxInput(
+        inputId = ns("preview_data"),
+        label = NULL,
+        value = isTRUE(preview_data)
+      )
+    )
+  )
+}
+
+
+#' @param read_fns Named list with custom function(s) to read data:
+#'  * the name must be the extension of the files to which the function will be applied
+#'  * the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names),
+#'    passed by user through the interface:
+#'    + `file`: path to the file
+#'    + `sheet`: for Excel files, sheet to read
+#'    + `skip`: number of row to skip
+#'    + `dec`: decimal separator
+#'    + `encoding`: file encoding
+#'    + `na.strings`: character(s) to interpret as missing values.
+#'
+#' @export
+#'
+#' @importFrom shiny moduleServer
+#' @importFrom htmltools tags tagList
+#' @importFrom shiny reactiveValues reactive observeEvent removeUI req
+#' @importFrom shinyWidgets updatePickerInput
+#' @importFrom readxl excel_sheets
+#' @importFrom rio import
+#' @importFrom rlang exec fn_fmls_names is_named is_function
+#' @importFrom tools file_ext
+#' @importFrom utils head
+#' @importFrom toastui renderDatagrid2 datagrid
+#'
+#' @rdname import-file
+import_file_server <- function(id,
+                               btn_show_data = TRUE,
+                               show_data_in = c("popup", "modal"),
+                               trigger_return = c("button", "change"),
+                               return_class = c("data.frame", "data.table", "tbl_df", "raw"),
+                               reset = reactive(NULL),
+                               read_fns = list()) {
+
+  if (length(read_fns) > 0) {
+    if (!is_named(read_fns))
+      stop("import_file_server: `read_fns` must be a named list.", call. = FALSE)
+    if (!all(vapply(read_fns, is_function, logical(1))))
+      stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE)
+  }
+
+  trigger_return <- match.arg(trigger_return)
+  return_class <- match.arg(return_class)
+
+  module <- function(input, output, session) {
+
+    ns <- session$ns
+    imported_rv <- reactiveValues(data = NULL, name = NULL)
+    temporary_rv <- reactiveValues(data = NULL, name = NULL, status = NULL)
+
+    observeEvent(reset(), {
+      temporary_rv$data <- NULL
+      temporary_rv$name <- NULL
+      temporary_rv$status <- NULL
+    })
+
+    output$container_confirm_btn <- renderUI({
+      if (identical(trigger_return, "button")) {
+        datamods:::button_import()
+      }
+    })
+
+    observeEvent(input$file, {
+      if (isTRUE(is_excel(input$file$datapath))) {
+        shinyWidgets::updatePickerInput(
+          session = session,
+          inputId = "sheet",
+          choices = readxl::excel_sheets(input$file$datapath)
+        )
+        datamods:::showUI(paste0("#", ns("sheet-container")))
+      } else if (isTRUE(is_ods(input$file$datapath))) {
+        shinyWidgets::updatePickerInput(
+          session = session,
+          inputId = "sheet",
+          choices = readODS::ods_sheets(input$file$datapath)
+        )
+        datamods:::showUI(paste0("#", ns("sheet-container")))
+      } else {
+        datamods:::hideUI(paste0("#", ns("sheet-container")))
+      }
+    })
+
+    observeEvent(list(
+      input$file,
+      input$sheet,
+      input$skip_rows,
+      input$dec,
+      input$encoding,
+      input$na_label
+    ), {
+      req(input$file)
+      # req(input$skip_rows)
+      extension <- tools::file_ext(input$file$datapath)
+      if (isTRUE(extension %in% names(read_fns))) {
+        parameters <- list(
+          file = input$file$datapath,
+          sheet = input$sheet,
+          skip = input$skip_rows,
+          dec = input$dec,
+          encoding = input$encoding,
+          na.strings = datamods:::split_char(input$na_label)
+        )
+        parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
+        imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
+        code <- call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)))
+      } else {
+        if (is_excel(input$file$datapath) || is_ods(input$file$datapath)) {
+          req(input$sheet)
+          parameters <- list(
+            file = input$file$datapath,
+            which = input$sheet,
+            skip = input$skip_rows,
+            na = datamods:::split_char(input$na_label)
+          )
+        } else if (is_sas(input$file$datapath)) {
+          parameters <- list(
+            file = input$file$datapath,
+            skip = input$skip_rows,
+            encoding = input$encoding
+          )
+        } else {
+          parameters <- list(
+            file = input$file$datapath,
+            skip = input$skip_rows,
+            dec = input$dec,
+            encoding = input$encoding,
+            na.strings = datamods:::split_char(input$na_label)
+          )
+        }
+        imported <- try(rlang::exec(rio::import, !!!parameters), silent = TRUE)
+        code <- rlang::call2("import", !!!utils::modifyList(parameters, list(file = input$file$name)), .ns = "rio")
+      }
+
+      if (inherits(imported, "try-error")) {
+        imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
+        code <- rlang::call2("import", !!!list(file = input$file$name), .ns = "rio")
+      }
+
+      if (inherits(imported, "try-error") || NROW(imported) < 1) {
+
+        datamods:::toggle_widget(inputId = "confirm", enable = FALSE)
+        datamods:::insert_error(mssg = datamods:::i18n(attr(imported, "condition")$message))
+        temporary_rv$status <- "error"
+        temporary_rv$data <- NULL
+        temporary_rv$name <- NULL
+        temporary_rv$code <- NULL
+
+      } else {
+
+        datamods:::toggle_widget(inputId = "confirm", enable = TRUE)
+
+        datamods:::insert_alert(
+          selector = ns("import"),
+          status = "success",
+          datamods:::make_success_alert(
+            imported,
+            trigger_return = trigger_return,
+            btn_show_data = btn_show_data,
+            extra = if (isTRUE(input$preview_data)) datamods:::i18n("First five rows are shown below:")
+          )
+        )
+        temporary_rv$status <- "success"
+        temporary_rv$data <- imported
+        temporary_rv$name <- input$file$name
+        temporary_rv$code <- code
+      }
+    }, ignoreInit = TRUE)
+
+    observeEvent(input$see_data, {
+      datamods:::show_data(temporary_rv$data, title = datamods:::i18n("Imported data"), type = show_data_in)
+    })
+
+    output$table <- toastui::renderDatagrid2({
+      req(temporary_rv$data)
+      toastui::datagrid(
+        data = head(temporary_rv$data, 5),
+        theme = "striped",
+        colwidths = "guess",
+        minBodyHeight = 250
+      )
+    })
+
+    observeEvent(input$confirm, {
+      imported_rv$data <- temporary_rv$data
+      imported_rv$name <- temporary_rv$name
+      imported_rv$code <- temporary_rv$code
+    })
+
+    if (identical(trigger_return, "button")) {
+      return(list(
+        status = reactive(temporary_rv$status),
+        name = reactive(imported_rv$name),
+        code = reactive(imported_rv$code),
+        data = reactive(datamods:::as_out(imported_rv$data, return_class))
+      ))
+    } else {
+      return(list(
+        status = reactive(temporary_rv$status),
+        name = reactive(temporary_rv$name),
+        code = reactive(temporary_rv$code),
+        data = reactive(datamods:::as_out(temporary_rv$data, return_class))
+      ))
+    }
+  }
+
+  moduleServer(
+    id = id,
+    module = module
+  )
+}
+
+# utils -------------------------------------------------------------------
+
+is_excel <- function(path) {
+  isTRUE(tools::file_ext(path) %in% c("xls", "xlsx"))
+}
+
+is_ods <- function(path) {
+  isTRUE(tools::file_ext(path) %in% c("ods"))
+}
+
+is_sas <- function(path) {
+  isTRUE(tools::file_ext(path) %in% c("sas7bdat"))
+}
+
+#' Wrapper of data.table::fread to import delim files with few presets
+#'
+#' @param file file
+#' @param encoding encoding
+#' @param na.strings na.strings
+#'
+#' @returns data.frame
+#' @export
+#'
+import_delim <- function(file, skip, encoding, na.strings) {
+  data.table::fread(
+    file = file,
+    na.strings = na.strings,
+    skip = skip,
+    check.names	= TRUE,
+    encoding = encoding,
+    data.table = FALSE,
+    logical01 = TRUE,
+    logicalYN = TRUE,
+    keepLeadingZeros = TRUE
+  )
+}
+
+#' @title Create a select input control with icon(s)
+#'
+#' @description Extend form controls by adding text or icons before,
+#'  after, or on both sides of a classic `selectInput`.
+#'
+#' @inheritParams shiny::selectInput
+#'
+#' @return A numeric input control that can be added to a UI definition.
+#' @export
+#'
+#' @importFrom shiny restoreInput
+#' @importFrom htmltools tags validateCssUnit css
+#'
+selectInputIcon <- function(inputId,
+                            label,
+                            choices,
+                            selected = NULL,
+                            multiple = FALSE,
+                            selectize = TRUE,
+                            size = NULL,
+                            width = NULL,
+                            icon = NULL) {
+  selected <- shiny::restoreInput(id = inputId, default = selected)
+  tags$div(
+    class = "form-group shiny-input-container",
+    shinyWidgets:::label_input(inputId, label),
+    style = htmltools:::css(width = htmltools:::validateCssUnit(width)),
+    tags$div(
+      class = "input-group",
+      class = shinyWidgets:::validate_size(size),
+      shinyWidgets:::markup_input_group(icon, "left", theme_func = shiny::getCurrentTheme),
+      shiny::tags$select(
+        id = inputId,
+        class = "form-control select-input-icon",
+        shiny:::selectOptions(choices, selected, inputId, selectize)
+      ),
+      shinyWidgets:::markup_input_group(icon, "right", theme_func = shiny::getCurrentTheme)
+    ),
+    shinyWidgets:::html_dependency_input_icons()
+  )
+}
+
+
+
+
+
+# library(shiny)
+# library(datamods)
+
+ui <- fluidPage(
+  # theme = bslib::bs_theme(version = 5L),
+  # theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
+  tags$h3("Import data from a file"),
+  fluidRow(
+    column(
+      width = 4,
+      import_file_ui(
+        id = "myid",
+        file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".json"),
+        layout_params = "dropdown" #"inline" # or "dropdown"
+      )
+    ),
+    column(
+      width = 8,
+      tags$b("Import status:"),
+      verbatimTextOutput(outputId = "status"),
+      tags$b("Name:"),
+      verbatimTextOutput(outputId = "name"),
+      tags$b("Code:"),
+      verbatimTextOutput(outputId = "code"),
+      tags$b("Data:"),
+      verbatimTextOutput(outputId = "data")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  imported <- import_file_server(
+    id = "myid",
+    # Custom functions to read data
+    read_fns = list(
+      xls = function(file, sheet, skip, encoding) {
+        readxl::read_xls(path = file, sheet = sheet, skip = skip)
+      },
+      json = function(file) {
+        jsonlite::read_json(file, simplifyVector = TRUE)
+      }
+    ),
+    show_data_in = "modal"
+  )
+
+  output$status <- renderPrint({
+    imported$status()
+  })
+  output$name <- renderPrint({
+    imported$name()
+  })
+  output$code <- renderPrint({
+    imported$code()
+  })
+  output$data <- renderPrint({
+    imported$data()
+  })
+
+}
+
+if (interactive())
+  shinyApp(ui, server)
+
+

R/redcap_read_shiny_module.R

@@ -53,6 +53,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
       shiny::tags$h4("Data import parameters"),
       shiny::helpText("Options here will show, when API and uri are typed"),
       shiny::uiOutput(outputId = ns("fields")),
+      shiny::uiOutput(outputId = ns("data_type")),
+      shiny::uiOutput(outputId = ns("fill")),
       shinyWidgets::switchInput(
         inputId = "do_filter",
         label = "Apply filter?",
@@ -132,7 +134,9 @@ m_redcap_readServer <- function(id) {
       info = NULL,
       arms = NULL,
       dd_list = NULL,
-      data = NULL
+      data = NULL,
+      rep_fields = NULL,
+      imported = NULL
     )
 
     shiny::observeEvent(list(input$api, input$uri), {
@@ -179,17 +183,17 @@ m_redcap_readServer <- function(id) {
             } else if (isTRUE(imported$success)) {
               data_rv$dd_status <- "success"
 
-              data_rv$project_name <- REDCapR::redcap_project_info_read(
+              data_rv$info <- REDCapR::redcap_project_info_read(
                 redcap_uri = data_rv$uri,
                 token = input$api
-              )$data$project_title
+              )$data
 
               datamods:::insert_alert(
                 selector = ns("connect"),
                 status = "success",
-                include_data_alert(
+                include_data_alert(see_data_text = "Click to see data dictionary",
                   dataIdName = "see_data",
-                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$project_name, " loaded."))),
+                  extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
                   btn_show_data = TRUE
                 )
               )
@@ -236,7 +240,7 @@ m_redcap_readServer <- function(id) {
         choices = purrr::pluck(data_rv$dd_list, "data") |>
           dplyr::select(field_name, form_name) |>
           (\(.x){
-            split(.x$field_name, .x$form_name)
+            split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
           })(),
         updateOn = "change",
         multiple = TRUE,
@@ -245,6 +249,48 @@ m_redcap_readServer <- function(id) {
       )
     })
 
+    output$data_type <- shiny::renderUI({
+      shiny::req(data_rv$info)
+      if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
+        vectorSelectInput(
+          inputId = ns("data_type"),
+          label = "Select the data format to import",
+          choices = c(
+            "Wide data (One row for each subject)" = "wide",
+            "Long data for project with repeating instruments (default REDCap)" = "long"
+          ),
+          selected = "wide",
+          multiple = FALSE
+        )
+      }
+    })
+
+    output$fill <- shiny::renderUI({
+      shiny::req(data_rv$info)
+      shiny::req(input$data_type)
+
+      ## Get repeated field
+      data_rv$rep_fields <- data_rv$dd_list$data$field_name[
+        data_rv$dd_list$data$form_name %in% repeated_instruments(
+          uri = data_rv$uri,
+          token = input$api
+        )
+      ]
+
+      if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
+        vectorSelectInput(
+          inputId = ns("fill"),
+          label = "Fill missing values?",
+          choices = c(
+            "Yes, fill missing, non-repeated values" = "yes",
+            "No, leave the data as is" = "no"
+          ),
+          selected = "yes",
+          multiple = FALSE
+        )
+      }
+    })
+
     shiny::observeEvent(input$fields, {
       if (is.null(input$fields) | length(input$fields) == 0) {
         shiny::updateActionButton(inputId = "data_import", disabled = TRUE)
@@ -258,7 +304,7 @@ m_redcap_readServer <- function(id) {
         inputId = ns("arms"),
         selected = NULL,
         label = "Filter by events/arms",
-        data = stats::setNames(arms()[[3]],arms()[[1]]),
+        choices = stats::setNames(arms()[[3]], arms()[[1]]),
         multiple = TRUE
       )
     })
@@ -267,13 +313,15 @@ m_redcap_readServer <- function(id) {
       shiny::req(input$fields)
       record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
 
+
       parameters <- list(
         uri = data_rv$uri,
         token = input$api,
         fields = unique(c(record_id, input$fields)),
         events = input$arms,
         raw_or_label = "both",
-        filter_logic = input$filter
+        filter_logic = input$filter,
+        split_forms = if (input$data_type == "long") "none" else "all"
       )
 
       shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
@@ -287,14 +335,48 @@ m_redcap_readServer <- function(id) {
         data_rv$data_list <- NULL
       } else {
         data_rv$data_status <- "success"
-        data_rv$data <- imported |>
+
-          REDCapCAST::redcap_wider() |>
+        ## The data management below should be separated to allow for changing
+        ## "wide"/"long" without re-importing data
+        if (input$data_type != "long") {
+          # browser()
+          out <- imported |>
+            # redcap_wider()
+            REDCapCAST::redcap_wider()
+        } else {
+          if (input$fill == "yes") {
+            ## Repeated fields
+
+
+            ## Non-repeated fields in current dataset
+            inc_non_rep <- names(imported)[!names(imported) %in% data_rv$rep_fields]
+
+            out <- imported |>
+              drop_empty_event() |>
+              dplyr::group_by(!!dplyr::sym(names(imported)[1])) |>
+              tidyr::fill(inc_non_rep) |>
+              dplyr::ungroup()
+          } else {
+            out <- imported |>
+              drop_empty_event()
+          }
+        }
+
+        data_rv$data <- out |>
           dplyr::select(-dplyr::ends_with("_complete")) |>
-          dplyr::select(-dplyr::any_of(record_id)) |>
+          # dplyr::select(-dplyr::any_of(record_id)) |>
           REDCapCAST::suffix2label()
       }
     })
 
+    # shiny::observe({
+    #   shiny::req(data_rv$imported)
+    #
+    #   imported <- data_rv$imported
+    #
+    #
+    # })
+
     return(shiny::reactive(data_rv$data))
   }
 
@@ -317,7 +399,7 @@ include_data_alert <- function(dataIdName = "see_data",
       tags$br(),
       shiny::actionLink(
         inputId = session$ns(dataIdName),
-        label = tagList(phosphoricons::ph("table"), see_data_text)
+        label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
       )
     )
   }
@@ -339,18 +421,20 @@ include_data_alert <- function(dataIdName = "see_data",
 # )
 
 
-#' Title
+#' Test if url is valid format for REDCap API
 #'
-#' @param url
+#' @param url url
 #'
-#' @returns
+#' @returns logical
 #' @export
 #'
 #' @examples
 #' url <- c(
 #'   "www.example.com",
-#'   "http://example.com",
+#'   "redcap.your.inst/api/",
-#'   "https://redcap.your.inst/api/"
+#'   "https://redcap.your.inst/api/",
+#'   "https://your.inst/redcap/api/",
+#'   "https://www.your.inst/redcap/api/"
 #' )
 #' is_valid_redcap_url(url)
 is_valid_redcap_url <- function(url) {
@@ -363,7 +447,7 @@ is_valid_redcap_url <- function(url) {
 #' @param token token
 #' @param pattern_env pattern
 #'
-#' @returns
+#' @returns logical
 #' @export
 #'
 #' @examples
@@ -399,6 +483,41 @@ is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
   out
 }
 
+#' Get names of repeated instruments
+#'
+#' @param uri REDCap database uri
+#' @param token database token
+#'
+#' @returns vector
+#' @export
+#'
+repeated_instruments <- function(uri, token) {
+  instruments <- REDCapR::redcap_event_instruments(redcap_uri = uri, token = token)
+  unique(instruments$data$form[duplicated(instruments$data$form)])
+}
+
+#' Drop empty events from REDCap export
+#'
+#' @param data data
+#' @param event "redcap_event_name", "redcap_repeat_instrument" or
+#' "redcap_repeat_instance"
+#'
+#' @returns data.frame
+#' @export
+#'
+drop_empty_event <- function(data, event = "redcap_event_name") {
+  generics <- c(names(data)[1], "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
+
+  filt <- split(data, data[[event]]) |>
+    lapply(\(.x){
+      dplyr::select(.x, -tidyselect::all_of(generics)) |>
+        REDCapCAST::all_na()
+    }) |>
+    unlist()
+
+  data[data[[event]] %in% names(filt)[!filt], ]
+}
+
 
 #' Test app for the redcap_read_shiny_module
 #'
@@ -411,7 +530,6 @@ is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
 redcap_demo_app <- function() {
   ui <- shiny::fluidPage(
     m_redcap_readUI("data"),
-    toastui::datagridOutput2(outputId = "redcap_prev"),
     DT::DTOutput("data_summary")
   )
   server <- function(input, output, session) {

R/wide2long.R

@@ -0,0 +1,153 @@
+#' Alternative pivoting method for easily pivoting based on name pattern
+#'
+#' @description
+#' This function requires and assumes a systematic naming of variables.
+#' For now only supports one level pivoting. Adding more levels would require
+#' an added "ignore" string pattern or similarly. Example 2.
+#'
+#'
+#' @param data data
+#' @param pattern pattern(s) to match. Character vector of length 1 or more.
+#' @param type type of match. can be one of "prefix","infix" or "suffix".
+#' @param id.col ID column. Will fill ID for all. Column name or numeric index.
+#' Default is "1", first column.
+#' @param instance.name
+#'
+#' @returns data.frame
+#' @export
+#'
+#' @examples
+#' data.frame(
+#'   1:20, sample(70:80, 20, TRUE),
+#'   sample(70:100, 20, TRUE),
+#'   sample(70:100, 20, TRUE),
+#'   sample(170:200, 20, TRUE)
+#' ) |>
+#'   setNames(c("id", "age", "weight_0", "weight_1", "height_1")) |>
+#'   wide2long(pattern = c("_0", "_1"), type = "suffix")
+#' data.frame(
+#'   1:20, sample(70:80, 20, TRUE),
+#'   sample(70:100, 20, TRUE),
+#'   sample(70:100, 20, TRUE),
+#'   sample(170:200, 20, TRUE)
+#' ) |>
+#'   setNames(c("id", "age", "weight_0", "weight_a_1", "height_b_1")) |>
+#'   wide2long(pattern = c("_0", "_1"), type = "suffix")
+#' # Optional filling of missing values by last observation carried forward
+#' # Needed for mmrm analyses
+#' long_missings |>
+#'   # Fills record ID assuming none are missing
+#'   tidyr::fill(record_id) |>
+#'   # Grouping by ID for the last step
+#'   dplyr::group_by(record_id) |>
+#'   # Filling missing data by ID
+#'   tidyr::fill(names(long_missings)[!names(long_missings) %in% new_names]) |>
+#'   # Remove grouping
+#'   dplyr::ungroup()
+wide2long <- function(
+    data,
+    pattern,
+    type = c("prefix", "infix", "suffix"),
+    id.col = 1,
+    instance.name = "instance") {
+  type <- match.arg(type)
+
+  ## Give the unique suffix names to use for identifying repeated measures
+  # suffixes <- c("_0", "_1")
+
+  ## If no ID column is present, one is added
+  if (id.col == "none" | is.null(id.col)) {
+    data <- stats::setNames(
+      data.frame(seq_len(nrow(data)), data),
+      make.names(c("id", names(data)), unique = TRUE)
+    )
+    id.col <- 1
+  }
+# browser()
+  ## Relevant columns are determined based on suffixes
+  cols <- names(data)[grepl_fix(names(data), pattern = pattern, type = type)]
+
+  ## New colnames are created by removing suffixes
+  new_names <- unique(gsub(paste(pattern, collapse = "|"), "", cols))
+
+  out <- split(data, seq_len(nrow(data))) |> # Splits dataset by row
+    # Starts data modifications for each subject
+    lapply(\(.x){
+      ## Pivots data with repeated measures as determined by the defined suffixes
+      long_ls <- split.default(
+        # Subset only repeated data
+        .x[cols],
+        # ... and split by meassure
+        gsub(paste(new_names, collapse = "|"), "", cols)
+      ) |>
+        # Sort data by order of given suffixes to ensure chronology
+        sort_by(pattern) |>
+        # New colnames are applied
+        lapply(\(.y){
+          setNames(
+            .y,
+            gsub(paste(pattern, collapse = "|"), "", names(.y))
+          )
+        })
+
+      # Subsets non-pivotted data (this is assumed to belong to same )
+      single <- .x[-match(cols, names(.x))]
+
+      # Extends with empty rows to get same dimensions as long data
+      single[(nrow(single) + 1):length(long_ls), ] <- NA
+
+      # Fills ID col
+      single[id.col] <- single[1, id.col]
+
+      # Everything is merged together
+      merged <- dplyr::bind_cols(
+        single,
+        # Instance names are defined as suffixes without leading non-characters
+        REDCapCAST::as_factor(data.frame(gsub(
+          "^[^[:alnum:]]+", "",
+          names(long_ls)
+        ))),
+        dplyr::bind_rows(long_ls)
+      )
+
+      # Ensure unique new names based on supplied
+      colnames(merged) <- make.names(
+        c(
+          names(single),
+          instance.name,
+          names(merged)[(NCOL(single) + 2):NCOL(merged)]
+        ),
+        unique = TRUE
+      )
+
+      merged
+    }) |> dplyr::bind_rows()
+
+  rownames(out) <- NULL
+
+  out
+}
+
+
+#' Matches pattern to vector based on match type
+#'
+#' @param data vector
+#' @param pattern pattern(s) to match. Character vector of length 1 or more.
+#' @param type type of match. can be one of "prefix","infix" or "suffix".
+#'
+#' @returns logical vector
+#' @export
+#'
+#' @examples
+#' c("id", "age", "weight_0", "weight_1") |> grepl_fix(pattern = c("_0", "_1"), type = "suffix")
+grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
+  type <- match.arg(type)
+
+  if (type == "prefix") {
+    grepl(paste0("^(", paste(pattern, collapse = "|"), ")*"), data)
+  } else if (type == "suffix") {
+    grepl(paste0("*(", paste(pattern, collapse = "|"), ")$"), data)
+  } else if (type == "infix") {
+    grepl(paste0("*(", paste(pattern, collapse = "|"), ")*"), data)
+  }
+}

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: 9899914
+bundleId: 9925506
 url: https://agdamsbo.shinyapps.io/freesearcheR/
 version: 1

inst/apps/freesearcheR/server.R

@@ -94,19 +94,19 @@ server <- function(input, output, session) {
 
   consider.na <- c("NA", "\"\"", "", "\'\'", "na")
 
-  data_file <- datamods::import_file_server(
+  data_file <- import_file_server(
     id = "file_import",
     show_data_in = "popup",
     trigger_return = "change",
     return_class = "data.frame",
     read_fns = list(
-      ods = function(file) {
+      ods = function(file, which, skip, na) {
         readODS::read_ods(
           path = file,
           # Sheet and skip not implemented for .ods in the original implementation
-          # sheet = sheet,
+          sheet = which,
-          # skip = skip,
+          skip = skip,
-          na = consider.na
+          na = na
         )
       },
       dta = function(file) {
@@ -115,29 +115,32 @@ server <- function(input, output, session) {
           .name_repair = "unique_quiet"
           )
       },
-      csv = function(file) {
+      # csv = function(file) {
-        readr::read_csv(
+      #   readr::read_csv(
+      #     file = file,
+      #     na = consider.na,
+      #     name_repair = "unique_quiet"
+      #     )
+      # },
+      csv = import_delim,
+      tsv = import_delim,
+      txt = import_delim,
+      xls = function(file, which, skip, na) {
+        openxlsx2::read_xlsx(
           file = file,
-          na = consider.na,
+          sheet = which,
-          name_repair = "unique_quiet"
+          skip_empty_rows = TRUE,
+          start_row = skip - 1,
+          na.strings = na
           )
       },
-      xls = function(file) {
+      xlsx = function(file, which, skip, na) {
         openxlsx2::read_xlsx(
           file = file,
           sheet = sheet,
           skip_empty_rows = TRUE,
           start_row = skip - 1,
-          na.strings = consider.na
+          na.strings = na)
-          )
-      },
-      xlsx = function(file) {
-        openxlsx2::read_xlsx(
-          file = file,
-          sheet = sheet,
-          skip_empty_rows = TRUE,
-          start_row = skip - 1,
-          na.strings = consider.na)
       },
       rds = function(file) {
         readr::read_rds(
@@ -304,7 +307,7 @@ server <- function(input, output, session) {
 
   shiny::observeEvent(
     input$modal_column,
-    datamods::modal_create_column(id = "modal_column")
+    datamods::modal_create_column(id = "modal_column",footer = "This is only for advanced users!")
   )
   data_modal_r <- datamods::create_column_server(
     id = "modal_column",

inst/apps/freesearcheR/ui.R

@@ -46,9 +46,11 @@ ui_elements <- list(
         shiny::br(),
         shiny::conditionalPanel(
           condition = "input.source=='file'",
-          datamods::import_file_ui("file_import",
+          import_file_ui(
+            id = "file_import",
+            layout_params = "dropdown",
             title = "Choose a datafile to upload",
-            file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta")
+            file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
           )
         ),
         shiny::conditionalPanel(
@@ -67,25 +69,27 @@ ui_elements <- list(
         shiny::br(),
         shiny::h5("Exclude in-complete variables"),
         shiny::fluidRow(
-          shiny::column(width=6,
+          shiny::column(
-                        shiny::br(),
+            width = 6,
-                        shiny::br(),
+            shiny::br(),
-                        shiny::p("Filter incomplete variables, by setting a completeness threshold:"),
+            shiny::br(),
-                        shiny::br()
+            shiny::p("Filter incomplete variables, by setting a completeness threshold:"),
-                        ),
+            shiny::br()
-          shiny::column(width=6,
+          ),
-                        shinyWidgets::noUiSliderInput(
+          shiny::column(
-                          inputId = "complete_cutoff",
+            width = 6,
-                          label = NULL,
+            shinyWidgets::noUiSliderInput(
-                          min = 0,
+              inputId = "complete_cutoff",
-                          max = 100,
+              label = NULL,
-                          step = 5,
+              min = 0,
-                          value = 70,
+              max = 100,
-                          format = shinyWidgets::wNumbFormat(decimals = 0),
+              step = 5,
-                          color = datamods:::get_primary_color()
+              value = 70,
-                        ),
+              format = shinyWidgets::wNumbFormat(decimals = 0),
-                        shiny::helpText("Include variables with completeness above the specified percentage.")
+              color = datamods:::get_primary_color()
-                        )
+            ),
+            shiny::helpText("Include variables with completeness above the specified percentage.")
+          )
         ),
         shiny::br(),
         shiny::br(),
@@ -167,6 +171,8 @@ ui_elements <- list(
                             On the right, you can create and modify factor/categorical variables as well as create new variables with *R* code."))
             )
           ),
+          shiny::tags$br(),
+          shiny::tags$br(),
           fluidRow(
             shiny::column(
               width = 2

man/columnSelectInput.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/columnSelectInput.R
+% Please edit documentation in R/custom_SelectInput.R
 \name{columnSelectInput}
 \alias{columnSelectInput}
 \title{A selectizeInput customized for data frames with column labels}
@@ -42,4 +42,3 @@ a \code{\link[shiny]{selectizeInput}} dropdown element
 Copied and modified from the IDEAFilter package
 Adds the option to select "none" which is handled later
 }
-\keyword{internal}

man/data-plots.Rd

@@ -7,6 +7,7 @@
 \alias{plot_hbars}
 \alias{plot_violin}
 \alias{plot_scatter}
+\alias{sankey_ready}
 \alias{plot_sankey}
 \title{Title}
 \usage{
@@ -20,9 +21,19 @@ plot_violin(data, x, y, z = NULL)
 
 plot_scatter(data, x, y, z = NULL)
 
+sankey_ready(data, x, y, z = NULL, numbers = "count")
+
 plot_sankey(data, x, y, z = NULL, color.group = "x", colors = NULL)
 }
 \arguments{
+\item{data}{data.frame}
+
+\item{x}{primary variable}
+
+\item{y}{secondary variable}
+
+\item{z}{tertiary variable}
+
 \item{...}{ignored for now}
 
 \item{type}{plot type (derived from possible_plots() and matches custom function)}
@@ -38,6 +49,8 @@ ggplot2 object
 
 ggplot2 object
 
+data.frame
+
 ggplot2 object
 }
 \description{
@@ -51,6 +64,8 @@ Beatiful violin plot
 
 Beautiful violin plot
 
+Readying data for sankey plot
+
 Beautiful sankey plot with option to split by a tertiary group
 }
 \examples{
@@ -63,6 +78,9 @@ 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 = 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")
 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")

man/drop_empty_event.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_read_shiny_module.R
+\name{drop_empty_event}
+\alias{drop_empty_event}
+\title{Drop empty events from REDCap export}
+\usage{
+drop_empty_event(data, event = "redcap_event_name")
+}
+\arguments{
+\item{data}{data}
+
+\item{event}{"redcap_event_name", "redcap_repeat_instrument" or
+"redcap_repeat_instance"}
+}
+\value{
+data.frame
+}
+\description{
+Drop empty events from REDCap export
+}

man/get_label.Rd

@@ -8,6 +8,8 @@ get_label(data, var = NULL)
 }
 \arguments{
 \item{data}{vector or data frame}
+
+\item{var}{variable name. Optional.}
 }
 \value{
 character string

man/grepl_fix.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/wide2long.R
+\name{grepl_fix}
+\alias{grepl_fix}
+\title{Matches pattern to vector based on match type}
+\usage{
+grepl_fix(data, pattern, type = c("prefix", "infix", "suffix"))
+}
+\arguments{
+\item{data}{vector}
+
+\item{pattern}{pattern(s) to match. Character vector of length 1 or more.}
+
+\item{type}{type of match. can be one of "prefix","infix" or "suffix".}
+}
+\value{
+logical vector
+}
+\description{
+Matches pattern to vector based on match type
+}
+\examples{
+c("id", "age", "weight_0", "weight_1") |> grepl_fix(pattern = c("_0", "_1"), type = "suffix")
+}

man/import-file.Rd

@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/import-file-ext.R
+\name{import-file}
+\alias{import-file}
+\alias{import_file_ui}
+\alias{import_file_server}
+\title{Import data from a file}
+\usage{
+import_file_ui(
+  id,
+  title = TRUE,
+  preview_data = TRUE,
+  file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat",
+    ".sav"),
+  layout_params = c("dropdown", "inline")
+)
+
+import_file_server(
+  id,
+  btn_show_data = TRUE,
+  show_data_in = c("popup", "modal"),
+  trigger_return = c("button", "change"),
+  return_class = c("data.frame", "data.table", "tbl_df", "raw"),
+  reset = reactive(NULL),
+  read_fns = list()
+)
+}
+\arguments{
+\item{preview_data}{Show or not a preview of the data under the file input.}
+
+\item{file_extensions}{File extensions accepted by \code{\link[shiny:fileInput]{shiny::fileInput()}}, can also be MIME type.}
+
+\item{layout_params}{How to display import parameters : in a dropdown button or inline below file input.}
+
+\item{read_fns}{Named list with custom function(s) to read data:
+\itemize{
+\item the name must be the extension of the files to which the function will be applied
+\item the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names),
+passed by user through the interface:
+\itemize{
+\item \code{file}: path to the file
+\item \code{sheet}: for Excel files, sheet to read
+\item \code{skip}: number of row to skip
+\item \code{dec}: decimal separator
+\item \code{encoding}: file encoding
+\item \code{na.strings}: character(s) to interpret as missing values.
+}
+}}
+}
+\description{
+Let user upload a file and import data
+}

man/import_delim.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/import-file-ext.R
+\name{import_delim}
+\alias{import_delim}
+\title{Wrapper of data.table::fread to import delim files with few presets}
+\usage{
+import_delim(file, skip, encoding, na.strings)
+}
+\arguments{
+\item{file}{file}
+
+\item{encoding}{encoding}
+
+\item{na.strings}{na.strings}
+}
+\value{
+data.frame
+}
+\description{
+Wrapper of data.table::fread to import delim files with few presets
+}

man/is_valid_redcap_url.Rd

@@ -2,21 +2,26 @@
 % Please edit documentation in R/redcap_read_shiny_module.R
 \name{is_valid_redcap_url}
 \alias{is_valid_redcap_url}
-\title{Title}
+\title{Test if url is valid format for REDCap API}
 \usage{
 is_valid_redcap_url(url)
 }
 \arguments{
-\item{url}{}
+\item{url}{url}
+}
+\value{
+logical
 }
 \description{
-Title
+Test if url is valid format for REDCap API
 }
 \examples{
 url <- c(
   "www.example.com",
-  "http://example.com",
+  "redcap.your.inst/api/",
-  "https://redcap.your.inst/api/"
+  "https://redcap.your.inst/api/",
+  "https://your.inst/redcap/api/",
+  "https://www.your.inst/redcap/api/"
 )
 is_valid_redcap_url(url)
 }

man/is_valid_token.Rd

@@ -11,6 +11,9 @@ is_valid_token(token, pattern_env = NULL, nchar = 32)
 
 \item{pattern_env}{pattern}
 }
+\value{
+logical
+}
 \description{
 Validate REDCap token
 }

man/line_break.Rd

@@ -4,11 +4,23 @@
 \alias{line_break}
 \title{Line breaking at given number of characters for nicely plotting labels}
 \usage{
-line_break(data, lineLength = 20)
+line_break(data, lineLength = 20, fixed = FALSE)
 }
 \arguments{
-\item{lineLength}{}
+\item{data}{string}
+
+\item{lineLength}{maximum line length}
+
+\item{fixed}{flag to force split at exactly the value given in lineLength.
+Default is FALSE, only splitting at spaces.}
+}
+\value{
+character string
 }
 \description{
 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(fixed=TRUE)
+}

man/plot_sankey_single.Rd

@@ -4,10 +4,15 @@
 \alias{plot_sankey_single}
 \title{Beautiful sankey plot}
 \usage{
-plot_sankey_single(data, x, y, color.group = "x", colors = NULL)
+plot_sankey_single(data, x, y, color.group = c("x", "y"), colors = NULL, ...)
 }
 \arguments{
-\item{colors}{}
+\item{color.group}{set group to colour by. "x" or "y".}
+
+\item{colors}{optinally specify colors. Give NA color, color for each level
+in primary group and color for each level in secondary group.}
+
+\item{...}{passed to sankey_ready()}
 }
 \value{
 ggplot2 object

man/repeated_instruments.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_read_shiny_module.R
+\name{repeated_instruments}
+\alias{repeated_instruments}
+\title{Get names of repeated instruments}
+\usage{
+repeated_instruments(uri, token)
+}
+\arguments{
+\item{uri}{REDCap database uri}
+
+\item{token}{database token}
+}
+\value{
+vector
+}
+\description{
+Get names of repeated instruments
+}

man/sankey_ready.Rd

@@ -1,19 +0,0 @@
-% 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/selectInputIcon.Rd

@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/import-file-ext.R
+\name{selectInputIcon}
+\alias{selectInputIcon}
+\title{Create a select input control with icon(s)}
+\usage{
+selectInputIcon(
+  inputId,
+  label,
+  choices,
+  selected = NULL,
+  multiple = FALSE,
+  selectize = TRUE,
+  size = NULL,
+  width = NULL,
+  icon = NULL
+)
+}
+\arguments{
+\item{inputId}{The \code{input} slot that will be used to access the value.}
+
+\item{label}{Display label for the control, or \code{NULL} for no label.}
+
+\item{choices}{List of values to select from. If elements of the list are
+named, then that name --- rather than the value --- is displayed to the
+user. It's also possible to group related inputs by providing a named list
+whose elements are (either named or unnamed) lists, vectors, or factors. In
+this case, the outermost names will be used as the group labels (leveraging
+the \verb{<optgroup>} HTML tag) for the elements in the respective sublist. See
+the example section for a small demo of this feature.}
+
+\item{selected}{The initially selected value (or multiple values if \code{multiple = TRUE}). If not specified then defaults to the first value for
+single-select lists and no values for multiple select lists.}
+
+\item{multiple}{Is selection of multiple items allowed?}
+
+\item{selectize}{Whether to use \pkg{selectize.js} or not.}
+
+\item{size}{Number of items to show in the selection box; a larger number
+will result in a taller box. Not compatible with \code{selectize=TRUE}.
+Normally, when \code{multiple=FALSE}, a select input will be a drop-down list,
+but when \code{size} is set, it will be a box instead.}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link[shiny:validateCssUnit]{validateCssUnit()}}.}
+}
+\value{
+A numeric input control that can be added to a UI definition.
+}
+\description{
+Extend form controls by adding text or icons before,
+after, or on both sides of a classic \code{selectInput}.
+}

man/vectorSelectInput.Rd

@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/custom_SelectInput.R
+\name{vectorSelectInput}
+\alias{vectorSelectInput}
+\title{A selectizeInput customized for named vectors}
+\usage{
+vectorSelectInput(
+  inputId,
+  label,
+  choices,
+  selected = "",
+  ...,
+  placeholder = "",
+  onInitialize
+)
+}
+\arguments{
+\item{inputId}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{label}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{choices}{A named \code{vector} from which fields should be populated}
+
+\item{selected}{default selection}
+
+\item{...}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{placeholder}{passed to \code{\link[shiny]{selectizeInput}} options}
+
+\item{onInitialize}{passed to \code{\link[shiny]{selectizeInput}} options}
+}
+\value{
+a \code{\link[shiny]{selectizeInput}} dropdown element
+}
+\description{
+A selectizeInput customized for named vectors
+}
+\examples{
+if (shiny::interactive()) {
+shinyApp(
+  ui = fluidPage(
+    shiny::uiOutput("select"),
+    tableOutput("data")
+  ),
+  server = function(input, output) {
+    output$select <- shiny::renderUI({
+      vectorSelectInput(
+        inputId = "variable", label = "Variable:",
+        data = c(
+          "Cylinders" = "cyl",
+          "Transmission" = "am",
+          "Gears" = "gear"
+        )
+      )
+    })
+
+    output$data <- renderTable(
+      {
+        mtcars[, c("mpg", input$variable), drop = FALSE]
+      },
+      rownames = TRUE
+    )
+  }
+)
+}
+}

man/vertical_stacked_bars.Rd

@@ -16,7 +16,18 @@ vertical_stacked_bars(
 )
 }
 \arguments{
-\item{t.size}{}
+\item{data}{data.frame}
+
+\item{score}{outcome variable}
+
+\item{group}{grouping variable}
+
+\item{strata}{stratifying variable}
+
+\item{t.size}{text size}
+}
+\value{
+ggplot2 object
 }
 \description{
 Vertical stacked bar plot wrapper

man/wide2long.Rd

@@ -0,0 +1,63 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/wide2long.R
+\name{wide2long}
+\alias{wide2long}
+\title{Alternative pivoting method for easily pivoting based on name pattern}
+\usage{
+wide2long(
+  data,
+  pattern,
+  type = c("prefix", "infix", "suffix"),
+  id.col = 1,
+  instance.name = "instance"
+)
+}
+\arguments{
+\item{data}{data}
+
+\item{pattern}{pattern(s) to match. Character vector of length 1 or more.}
+
+\item{type}{type of match. can be one of "prefix","infix" or "suffix".}
+
+\item{id.col}{ID column. Will fill ID for all. Column name or numeric index.
+Default is "1", first column.}
+
+\item{instance.name}{}
+}
+\value{
+data.frame
+}
+\description{
+This function requires and assumes a systematic naming of variables.
+For now only supports one level pivoting. Adding more levels would require
+an added "ignore" string pattern or similarly. Example 2.
+}
+\examples{
+data.frame(
+  1:20, sample(70:80, 20, TRUE),
+  sample(70:100, 20, TRUE),
+  sample(70:100, 20, TRUE),
+  sample(170:200, 20, TRUE)
+) |>
+  setNames(c("id", "age", "weight_0", "weight_1", "height_1")) |>
+  wide2long(pattern = c("_0", "_1"), type = "suffix")
+data.frame(
+  1:20, sample(70:80, 20, TRUE),
+  sample(70:100, 20, TRUE),
+  sample(70:100, 20, TRUE),
+  sample(170:200, 20, TRUE)
+) |>
+  setNames(c("id", "age", "weight_0", "weight_a_1", "height_b_1")) |>
+  wide2long(pattern = c("_0", "_1"), type = "suffix")
+# Optional filling of missing values by last observation carried forward
+# Needed for mmrm analyses
+long_missings |>
+  # Fills record ID assuming none are missing
+  tidyr::fill(record_id) |>
+  # Grouping by ID for the last step
+  dplyr::group_by(record_id) |>
+  # Filling missing data by ID
+  tidyr::fill(names(long_missings)[!names(long_missings) \%in\% new_names]) |>
+  # Remove grouping
+  dplyr::ungroup()
+}

renv.lock

@@ -345,10 +345,10 @@
     },
     "Matrix": {
       "Package": "Matrix",
-      "Version": "1.7-2",
+      "Version": "1.7-3",
       "Source": "Repository",
       "VersionNote": "do also bump src/version.h, inst/include/Matrix/version.h",
-      "Date": "2025-01-20",
+      "Date": "2025-03-05",
       "Priority": "recommended",
       "Title": "Sparse and Dense Matrix Classes and Methods",
       "Description": "A rich hierarchy of sparse and dense matrix classes, including general, symmetric, triangular, and diagonal matrices with numeric, logical, or pattern entries.  Efficient methods for operating on such matrices, often wrapping the 'BLAS', 'LAPACK', and 'SuiteSparse' libraries.",
@@ -515,7 +515,7 @@
     },
     "REDCapCAST": {
       "Package": "REDCapCAST",
-      "Version": "25.3.1",
+      "Version": "25.3.2",
       "Source": "Repository",
       "Title": "REDCap Metadata Casting and Castellated Data Handling",
       "Authors@R": "c( person(\"Andreas Gammelgaard\", \"Damsbo\", email = \"agdamsbo@clin.au.dk\",  role = c(\"aut\", \"cre\"),comment = c(ORCID = \"0000-0002-7559-1154\")),  person(\"Paul\", \"Egeler\", email = \"paulegeler@gmail.com\", role = c(\"aut\"),  comment = c(ORCID = \"0000-0001-6948-9498\")))",
@@ -2373,7 +2373,7 @@
     },
     "datawizard": {
       "Package": "datawizard",
-      "Version": "1.0.0",
+      "Version": "1.0.1",
       "Source": "Repository",
       "Type": "Package",
       "Title": "Easy Data Wrangling and Statistical Transformations",
@@ -2387,7 +2387,7 @@
         "R (>= 4.0)"
       ],
       "Imports": [
-        "insight (>= 1.0.0)",
+        "insight (>= 1.0.2)",
         "stats",
         "utils"
       ],
@@ -2973,7 +2973,7 @@
       "NeedsCompilation": "yes",
       "Author": "Gábor Csárdi [aut, cre], Posit Software, PBC [cph, fnd]",
       "Maintainer": "Gábor Csárdi <csardi.gabor@gmail.com>",
-      "Repository": "CRAN"
+      "Repository": "RSPM"
     },
     "flextable": {
       "Package": "flextable",
@@ -3852,11 +3852,11 @@
     },
     "ggstats": {
       "Package": "ggstats",
-      "Version": "0.8.0",
+      "Version": "0.9.0",
       "Source": "Repository",
       "Type": "Package",
       "Title": "Extension to 'ggplot2' for Plotting Stats",
-      "Authors@R": "c( person(\"Joseph\", \"Larmarange\", , \"joseph@larmarange.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7097-700X\")) )",
+      "Authors@R": "c( person( \"Joseph\", \"Larmarange\", , \"joseph@larmarange.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7097-700X\") ) )",
       "Description": "Provides new statistics, new geometries and new positions for  'ggplot2' and a suite of functions to facilitate the creation of  statistical plots.",
       "License": "GPL (>= 3)",
       "URL": "https://larmarange.github.io/ggstats/, https://github.com/larmarange/ggstats",
@@ -3882,7 +3882,7 @@
       "Suggests": [
         "betareg",
         "broom",
-        "broom.helpers (>= 1.17.0)",
+        "broom.helpers (>= 1.20.0)",
         "emmeans",
         "glue",
         "gtsummary",
@@ -5714,11 +5714,11 @@
     },
     "modelbased": {
       "Package": "modelbased",
-      "Version": "0.9.0",
+      "Version": "0.10.0",
       "Source": "Repository",
       "Type": "Package",
       "Title": "Estimation of Model-Based Predictions, Contrasts and Means",
-      "Authors@R": "c(person(given = \"Dominique\", family = \"Makowski\", role = c(\"aut\", \"cre\"), email = \"dom.makowski@gmail.com\", comment = c(ORCID = \"0000-0001-5375-9967\")), person(given = \"Daniel\", family = \"Lüdecke\", role = \"aut\", email = \"d.luedecke@uke.de\", comment = c(ORCID = \"0000-0002-8895-3206\")), person(given = \"Mattan S.\", family = \"Ben-Shachar\", role = \"aut\", email = \"matanshm@post.bgu.ac.il\", comment = c(ORCID = \"0000-0002-4287-4801\")), person(given = \"Indrajeet\", family = \"Patil\", role = \"aut\", email = \"patilindrajeet.science@gmail.com\", comment = c(ORCID = \"0000-0003-1995-6531\")))",
+      "Authors@R": "c(person(given = \"Dominique\", family = \"Makowski\", role = c(\"aut\", \"cre\"), email = \"dom.makowski@gmail.com\", comment = c(ORCID = \"0000-0001-5375-9967\")), person(given = \"Daniel\", family = \"Lüdecke\", role = \"aut\", email = \"d.luedecke@uke.de\", comment = c(ORCID = \"0000-0002-8895-3206\")), person(given = \"Mattan S.\", family = \"Ben-Shachar\", role = \"aut\", email = \"matanshm@post.bgu.ac.il\", comment = c(ORCID = \"0000-0002-4287-4801\")), person(given = \"Indrajeet\", family = \"Patil\", role = \"aut\", email = \"patilindrajeet.science@gmail.com\", comment = c(ORCID = \"0000-0003-1995-6531\")), person(given = \"Rémi\", family = \"Thériault\", role = \"aut\", email = \"remi.theriault@mail.mcgill.ca\", comment = c(ORCID = \"0000-0003-4315-6788\")))",
       "Maintainer": "Dominique Makowski <dom.makowski@gmail.com>",
       "Description": "Implements a general interface for model-based estimations for a wide variety of models, used in the computation of marginal means, contrast analysis and predictions. For a list of supported models, see 'insight::supported_models()'.",
       "License": "GPL-3",
@@ -5739,6 +5739,8 @@
       ],
       "Suggests": [
         "BH",
+        "betareg",
+        "bootES",
         "brms",
         "coda",
         "collapse",
@@ -5758,18 +5760,23 @@
         "lmerTest",
         "logspline",
         "MASS",
+        "Matrix",
         "marginaleffects (>= 0.25.0)",
+        "mice",
         "mgcv",
         "nanoparquet",
+        "ordinal",
         "performance (>= 0.13.0)",
         "patchwork",
         "pbkrtest",
         "poorman",
+        "pscl",
         "RcppEigen",
         "report",
         "rmarkdown",
         "rstanarm",
         "rtdists",
+        "sandwich",
         "see (>= 0.9.0)",
         "testthat (>= 3.2.1)",
         "vdiffr",
@@ -5785,7 +5792,7 @@
       "Config/Needs/website": "easystats/easystatstemplate",
       "LazyData": "true",
       "NeedsCompilation": "no",
-      "Author": "Dominique Makowski [aut, cre] (<https://orcid.org/0000-0001-5375-9967>), Daniel Lüdecke [aut] (<https://orcid.org/0000-0002-8895-3206>), Mattan S. Ben-Shachar [aut] (<https://orcid.org/0000-0002-4287-4801>), Indrajeet Patil [aut] (<https://orcid.org/0000-0003-1995-6531>)",
+      "Author": "Dominique Makowski [aut, cre] (<https://orcid.org/0000-0001-5375-9967>), Daniel Lüdecke [aut] (<https://orcid.org/0000-0002-8895-3206>), Mattan S. Ben-Shachar [aut] (<https://orcid.org/0000-0002-4287-4801>), Indrajeet Patil [aut] (<https://orcid.org/0000-0003-1995-6531>), Rémi Thériault [aut] (<https://orcid.org/0000-0003-4315-6788>)",
       "Repository": "CRAN"
     },
     "munsell": {
@@ -7478,7 +7485,7 @@
     },
     "readxl": {
       "Package": "readxl",
-      "Version": "1.4.4",
+      "Version": "1.4.5",
       "Source": "Repository",
       "Title": "Read Excel Files",
       "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\"), comment = \"Copyright holder of all R code and all C/C++ code without explicit copyright attribution\"), person(\"Marcin\", \"Kalicinski\", role = c(\"ctb\", \"cph\"), comment = \"Author of included RapidXML code\"), person(\"Komarov Valery\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Christophe Leitienne\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Bob Colbert\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"David Hoerl\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Evan Miller\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\") )",