new comment on build

.github/workflows/test-coverage.yaml

@@ -4,9 +4,10 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
 
-name: test-coverage
+name: test-coverage.yaml
+
+permissions: read-all
 
 jobs:
   test-coverage:
@@ -15,38 +16,47 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 
-      # - uses: r-lib/actions/setup-renv@v2
-
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Test coverage
         run: |
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
-            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          print(cov)
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v4
+        with:
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |
           ## --------------------------------------------------------------------
-          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
         shell: bash
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: REDCapCAST
 Title: REDCap Metadata Casting and Castellated Data Handling
-Version: 24.12.1
+Version: 25.3.2
 Authors@R: c(
     person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", 
     role = c("aut", "cre"),comment = c(ORCID = "0000-0002-7559-1154")), 
@@ -21,7 +21,7 @@ Description: Casting metadata for REDCap database creation and handling of
     4) procedures for data integration and interoperability with external 
     sources (Harris et al (2009) <doi:10.1016/j.jbi.2008.08.010>; 
     Harris et al (2019) <doi:10.1016/j.jbi.2019.103208>).
-Depends: R (>= 3.4.0)
+Depends: R (>= 4.1.0)
 Suggests:
     httr,
     jsonlite,
@@ -34,7 +34,8 @@ Suggests:
     roxygen2,
     spelling,
     rhub,
-    rsconnect
+    rsconnect,
+    pkgconfig
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
@@ -50,25 +51,28 @@ Imports:
     purrr,
     readr,
     stats,
-    shiny,
-    haven,
     zip,
     assertthat,
-    openxlsx2,
-    readODS,
     forcats,
     vctrs,
     gt,
     bslib,
     here,
     glue,
-    gtsummary
+    gtsummary,
+    shiny,
+    haven,
+    openxlsx2,
+    readODS
+Language: en-US
+VignetteBuilder: knitr
 Collate: 
     'REDCapCAST-package.R'
     'utils.r'
     'process_user_input.r'
     'REDCap_split.r'
     'as_factor.R'
+    'as_logical.R'
     'doc2dd.R'
     'ds2dd_detailed.R'
     'easy_redcap.R'
@@ -82,5 +86,3 @@ Collate:
     'redcapcast_data.R'
     'redcapcast_meta.R'
     'shiny_cast.R'
-Language: en-US
-VignetteBuilder: knitr

NAMESPACE

@@ -7,6 +7,10 @@ S3method(as_factor,haven_labelled)
 S3method(as_factor,labelled)
 S3method(as_factor,logical)
 S3method(as_factor,numeric)
+S3method(as_logical,data.frame)
+S3method(as_logical,default)
+S3method(fct_drop,data.frame)
+S3method(fct_drop,factor)
 S3method(process_user_input,character)
 S3method(process_user_input,data.frame)
 S3method(process_user_input,default)
@@ -16,6 +20,7 @@ export(all_na)
 export(apply_factor_labels)
 export(apply_field_label)
 export(as_factor)
+export(as_logical)
 export(case_match_regex_list)
 export(cast_data_overview)
 export(cast_meta_overview)
@@ -26,6 +31,7 @@ export(clean_redcap_name)
 export(compact_vec)
 export(create_html_table)
 export(create_instrument_meta)
+export(cut_string_length)
 export(d2w)
 export(doc2dd)
 export(ds2dd)
@@ -34,7 +40,6 @@ export(easy_redcap)
 export(export_redcap_instrument)
 export(fct2num)
 export(fct_drop)
-export(fct_drop.data.frame)
 export(file_extension)
 export(focused_metadata)
 export(format_redcap_factor)
@@ -72,11 +77,15 @@ importFrom(REDCapR,redcap_metadata_read)
 importFrom(REDCapR,redcap_read)
 importFrom(forcats,as_factor)
 importFrom(forcats,fct_drop)
+importFrom(haven,read_dta)
 importFrom(keyring,key_get)
 importFrom(keyring,key_list)
 importFrom(keyring,key_set)
 importFrom(openxlsx2,read_xlsx)
 importFrom(purrr,reduce)
+importFrom(readODS,read_ods)
 importFrom(readr,parse_time)
+importFrom(readr,read_csv)
+importFrom(readr,read_rds)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyselect,all_of)

NEWS.md

@@ -1,14 +1,38 @@
-# REDCapCAST 24.11.4
+# REDCapCAST 25.3.2
+
+* BUG: The `redcap_wider()` function would attempt to pivot empty selection of columns from list, and failing, causing all functions relying on this to fail. Fixed by filtering out data.frames in list with no additional columns than the "generics". 
+
+# REDCapCAST 25.3.1
+
+* FIX: `as_factor()` now interprets empty variables with empty levels attribute as logicals to avoid returning factors with empty levels.
+
+* NEW: `as_logical()`: interprets vectors with two levels as logical if values matches supplied list of logical pairs like "TRUE"/"FALSE", "Yes"/"No" or 1/2. Eases interpretation of data from databases with minimal metadata. Works on vectors and for data.frames. Interprets vectors with single value also matching to any of supplied levels (Chooses first match pair if several matches).
+
+* NEW: `easy_redcap()`: new parameter `data_format` to specify data format as c("wide", "list", "redcap", "long"). For now "redcap" and "long" is treated equally. This was added to ease MMRM analyses. In that case, missing baseline values can be carried forward as "last observation carried forward" using the `tidyr::fill()` function specifying variables to fill. Interesting discussion on filling data [here on Stackoverflow](https://stackoverflow.com/a/13810615). `redcap_read_tables()` now has the option "none" for the `split_forms` parameter to allow not splitting the data.
+
+* FIX: `ds2dd_detailed()`: The `convert_logicals` parameter has been turned off by default and logicals are now interpreted as field type "truefalse". Converting logicals to factors would result in the numeric values being 1 for FALSE and 2 for TRUE, which is opposite of the traditional notation and could lead to serous problems if not handled correctly. This should solve it.
+
+# REDCapCAST 25.1.1
+
+The newly introduced extension of `forcats::fct_drop()` has been corrected to work as intended as a method.
+
+Conversion of column names to `field_names` are aligning better with REDCap naming.
+
+Shorten variable names above 100 characters (REDCap criteria; note recommended variable name length is <26)
+
+Fixed a params conflict in easy_redcap() when specifying raw_or_label.
+
+# REDCapCAST 24.12.1
 
 This release attempts to solve problems hosting the shiny_cast app, while also implementing functions to preserve as much meta data as possible from the REDCap database when exporting data.
 
 The hosting on shinyapps.io has given a lot of trouble recently. Modified package structure a little around the `shiny_cast()`, to accommodate an alternative hosting approach with all package functions included in a script instead of requiring the package.
 
-* NEW: A new option to `raw_or_label` in `read_readcap_tables()` has been added: "both". Get raw values with REDCap labels applied as labels. Use `as_factor()` to format factors with original labels and use the `gtsummary` package to easily get beautiful tables with original labels from REDCap. Use `fct_drop()` to drop empty levels.
+* NEW: A new option to `raw_or_label` in `read_redcap_tables()` has been added: "both". Get raw values with REDCap labels applied as labels. Use `as_factor()` to format factors with original labels and use the `gtsummary` package to easily get beautiful tables with original labels from REDCap. Use `fct_drop()` to drop empty levels.
 
 * NEW: fct_drop() has been added with an extension to `forcats::fct_drop()`, that works across data.frames. Use as `fct_drop()`.
 
-* CHANGE: the default data export method of `easy_redcap()` has been changed to use the new labelled data export with `read_readcap_tables()`.
+* CHANGE: the default data export method of `easy_redcap()` has been changed to use the new labelled data export with `read_redcap_tables()`.
 
 # REDCapCAST 24.11.3
 
@@ -161,7 +185,7 @@ The main goal this package is to keep the option to only export a defined subset
 
 ### Functions:
 
-* `read_redcap_tables()` **NEW**: this function is mainly an implementation of the combined use of `REDCapR::readcap_read()` and `REDCap_split()` to maintain the focused nature of `REDCapR::readcap_read()`, to only download the specified data. Also implements tests of valid form names and event names. The usual fall-back solution was to get all data.
+* `read_redcap_tables()` **NEW**: this function is mainly an implementation of the combined use of `REDCapR::redcap_read()` and `REDCap_split()` to maintain the focused nature of `REDCapR::redcap_read()`, to only download the specified data. Also implements tests of valid form names and event names. The usual fall-back solution was to get all data.
 
 * `redcap_wider()` **NEW**: this function pivots the long data frames from `read_redcap_tables()` using `tidyr::pivot_wider()`.
 

R/REDCap_split.r

@@ -86,6 +86,11 @@ REDCap_split <- function(records,
                          metadata,
                          primary_table_name = "",
                          forms = c("repeating", "all")) {
+
+  # Processing metadata to reflect focused dataset
+  # metadata <- focused_metadata(metadata, names(records))
+  # Requires new testing setup. Not doing that now.
+
   # Process user input
   records <- process_user_input(records)
   metadata <-

R/as_factor.R

@@ -7,6 +7,8 @@
 #' Please refer to parent functions for extended documentation.
 #' To avoid redundancy calls and errors, functions are copy-pasted here
 #'
+#' Empty variables with empty levels attribute are interpreted as logicals
+#'
 #' @param x Object to coerce to a factor.
 #' @param ... Other arguments passed down to method.
 #' @param only_labelled Only apply to labelled columns?
@@ -24,7 +26,14 @@
 #'   labels = c(Unknown = 9, Refused = 10),
 #'   class = "haven_labelled"
 #' ) |>
-#'   as_factor()
+#'   as_factor() |> class()
+#' structure(rep(NA,10),
+#'   class = c("labelled")
+#' ) |>
+#'   as_factor() |> summary()
+#'
+#' rep(NA,10) |> as_factor()
+#'
 #' @importFrom forcats as_factor
 #' @export
 #' @name as_factor
@@ -46,8 +55,6 @@ as_factor.logical <- function(x, ...) {
   set_attr(x, labels, overwrite = FALSE)
 }
 
-
-
 #' @rdname as_factor
 #' @export
 as_factor.numeric <- function(x, ...) {
@@ -121,7 +128,13 @@ as_factor.haven_labelled <- function(x, levels = c("default", "labels", "values"
 
   x <- structure(x, label = label)
 
-  set_attr(x, labels_all, overwrite = FALSE)
+  out <- set_attr(x, labels_all, overwrite = FALSE)
+
+  if (all_na(out) & length(levels(out))==0){
+    as_factor.logical(out)
+  } else {
+    out
+  }
 }
 
 #' @export

R/as_logical.R

@@ -0,0 +1,116 @@
+#' Interpret specific binary values as logicals
+#'
+#' @param x vector or data.frame
+#' @param values list of values to interpret as logicals. First value is
+#' @param ... ignored
+#' interpreted as TRUE.
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' c(sample(c("TRUE", "FALSE"), 20, TRUE), NA) |>
+#'   as_logical() |>
+#'   class()
+#' ds <- dplyr::tibble(
+#'   B = factor(sample(c(1, 2), 20, TRUE)),
+#'   A = factor(sample(c("TRUE", "FALSE"), 20, TRUE)),
+#'   C = sample(c(3, 4), 20, TRUE),
+#'   D = factor(sample(c("In", "Out"), 20, TRUE))
+#' )
+#' ds |>
+#'   as_logical() |>
+#'   sapply(class)
+#' ds$A |> class()
+#' sample(c("TRUE",NA), 20, TRUE) |>
+#'   as_logical()
+#' as_logical(0)
+#' @name as_logical
+as_logical <- function(x,
+                       values = list(
+                         c("TRUE", "FALSE"),
+                         c("Yes", "No"),
+                         c(1, 0),
+                         c(1, 2)
+                       ),
+                       ...) {
+  UseMethod("as_logical")
+}
+
+#' @rdname as_logical
+#' @export
+as_logical.data.frame <- function(x,
+                                  values = list(
+                                    c("TRUE", "FALSE"),
+                                    c("Yes", "No"),
+                                    c(1, 0),
+                                    c(1, 2)
+                                  ),
+                                  ...) {
+  as.data.frame(lapply(x, \(.x){
+    as_logical.default(x = .x, values = values)
+  }))
+}
+
+#' @rdname as_logical
+#' @export
+as_logical.default <- function(x,
+                               values = list(
+                                 c("TRUE", "FALSE"),
+                                 c("Yes", "No"),
+                                 c(1, 0),
+                                 c(1, 2)
+                               ),
+                               ...) {
+  label <- REDCapCAST::get_attr(x, "label")
+
+  # browser()
+  out <- c()
+  if (any(
+    c(
+      "character",
+      "factor",
+      "numeric"
+    ) %in% class(x)
+  )){
+   if (length(unique(x[!is.na(x)])) == 2) {
+     if (is.factor(x)) {
+       match_index <- which(sapply(values, \(.x){
+         all(.x %in% levels(x))
+       }))
+     } else {
+       match_index <- which(sapply(values, \(.x){
+         all(.x %in% x)
+       }))
+     }
+   } else if (length(unique(x[!is.na(x)])) == 1){
+     if (is.factor(x)) {
+       match_index <- which(sapply(values, \(.x){
+         any(.x %in% levels(x))
+       }))
+     } else {
+       match_index <- which(sapply(values, \(.x){
+         any(.x %in% x)
+       }))
+     }
+   } else {
+     match_index <- c()
+  }
+
+    if (length(match_index) == 1) {
+      out <- x == values[[match_index]][1]
+    } else if (length(match_index) > 1) {
+      # If matching several, the first match is used.
+      out <- x == values[[match_index[1]]][1]
+    }
+  }
+
+  if (length(out) == 0) {
+    out <- x
+  }
+
+  if (!is.na(label)) {
+    out <- REDCapCAST::set_attr(out, label = label, attr = "label")
+  }
+  out
+}

R/ds2dd_detailed.R

@@ -1,5 +1,4 @@
 utils::globalVariables(c(
-  "stats::setNames",
   "field_name",
   "field_type",
   "select_choices_or_calculations",
@@ -128,8 +127,7 @@ hms2character <- function(data) {
 #'
 #' @examples
 #' redcapcast_data$record_id <- seq_len(nrow(redcapcast_data))
-#' ds2dd(redcapcast_data, include.column.names=TRUE)
-
+#' ds2dd(redcapcast_data, include.column.names = TRUE)
 ds2dd <-
   function(ds,
            record.id = "record_id",
@@ -137,8 +135,7 @@ ds2dd <-
            field.type = "text",
            field.label = NULL,
            include.column.names = FALSE,
-           metadata = names(REDCapCAST::redcapcast_meta)
-           ) {
+           metadata = names(REDCapCAST::redcapcast_meta)) {
     dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds)))
     colnames(dd) <- metadata
 
@@ -179,12 +176,15 @@ ds2dd <-
 
     if (is.null(field.label)) {
       dd[, "field_label"] <- dd[, "field_name"]
-    } else
+    } else {
       dd[, "field_label"] <- field.label
+    }
 
-    if (include.column.names){
-      list("DataDictionary"=dd,"Column names"=field.name)
-    } else dd
+    if (include.column.names) {
+      list("DataDictionary" = dd, "Column names" = field.name)
+    } else {
+      dd
+    }
   }
 
 
@@ -247,7 +247,10 @@ ds2dd <-
 #'     form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
 #'   ) |>
 #'   purrr::pluck("meta")
-#' mtcars |> ds2dd_detailed(add.auto.id = TRUE)
+#' mtcars |>
+#'   dplyr::mutate(unknown = NA) |>
+#'   numchar2fct() |>
+#'   ds2dd_detailed(add.auto.id = TRUE)
 #'
 #' ## Using column name suffix to carry form name
 #' data <- iris |>
@@ -267,12 +270,21 @@ ds2dd_detailed <- function(data,
                            field.label.attr = "label",
                            field.validation = NULL,
                            metadata = names(REDCapCAST::redcapcast_meta),
-                           convert.logicals = TRUE) {
+                           convert.logicals = FALSE) {
+  short_names <- colnames(data) |>
+    lapply(\(.x) cut_string_length(.x, l = 90)) |>
+    purrr::reduce(c)
+
+  data <- stats::setNames(data, short_names)
 
   if (convert.logicals) {
     data <- data |>
       ## Converts logical to factor, which overwrites attributes
       dplyr::mutate(dplyr::across(dplyr::where(is.logical), as_factor))
+    ## Problematic example:
+    ## as.logical(sample(0:1,10,TRUE)) |> as.factor() |> as.numeric()
+    ## Possible solution would be to subtract values by 1, so
+    ## "0, FALSE | 1, TRUE" like native REDCap
   }
 
   ## Handles the odd case of no id column present
@@ -294,7 +306,6 @@ ds2dd_detailed <- function(data,
     dplyr::tibble()
 
   ## form_name and field_name
-
   if (!is.null(form.sep)) {
     if (form.sep != "") {
       parts <- strsplit(names(data), split = form.sep)
@@ -313,11 +324,14 @@ ds2dd_detailed <- function(data,
       dd$field_name <- tolower(dd$field_name)
     } else {
       dd$form_name <- "data"
-      dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+
+      # dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+      dd$field_name <- clean_redcap_name(colnames(data))
     }
   } else {
     ## if no form name prefix, the colnames are used as field_names
-    dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+    # dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
+    dd$field_name <- clean_redcap_name(colnames(data))
 
     if (is.null(form.name)) {
       dd$form_name <- "data"
@@ -364,9 +378,14 @@ ds2dd_detailed <- function(data,
     dd$field_type <- "text"
 
     dd <-
-      dd |> dplyr::mutate(field_type = dplyr::if_else(data_classes == "factor",
-        "radio", field_type
-      ))
+      dd |> dplyr::mutate(
+        field_type = dplyr::case_match(
+          data_classes,
+          "factor"~"radio",
+          "logical"~"truefalse",
+          .default = field_type
+        )
+        )
   } else {
     if (length(field.type) == 1 || length(field.type) == nrow(dd)) {
       dd$field_type <- field.type
@@ -425,7 +444,14 @@ ds2dd_detailed <- function(data,
   out <- list(
     data = data |>
       hms2character() |>
-      stats::setNames(dd$field_name),
+      stats::setNames(dd$field_name) |>
+      lapply(\(.x){
+        if (identical("factor", class(.x))) {
+          as.numeric(.x)
+        } else {
+          .x
+        }
+      }) |> dplyr::bind_cols(),
     meta = dd
   )
 
@@ -667,7 +693,6 @@ vec2choice <- function(data) {
 #' "test" |> compact_vec()
 #' sample(letters[1:9], 20, TRUE) |> compact_vec()
 compact_vec <- function(data, nm.sep = ": ", val.sep = "; ") {
-  # browser()
   if (all(is.na(data))) {
     return(data)
   }

R/easy_redcap.R

@@ -26,8 +26,13 @@ get_api_key <- function(key.name, ...) {
 #'
 #' @param project.name The name of the current project (for key storage with
 #' \link[keyring]{key_set}, using the default keyring)
-#' @param widen.data argument to widen the exported data
+#' @param widen.data argument to widen the exported data. [DEPRECATED], use
+#' `data_format`instead
 #' @param uri REDCap database API uri
+#' @param raw_or_label argument passed on to
+#' \link[REDCapCAST]{read_redcap_tables}. Default is "both" to get labelled
+#' data.
+#' @param data_format Choose the data
 #' @param ... arguments passed on to \link[REDCapCAST]{read_redcap_tables}.
 #'
 #' @return data.frame or list depending on widen.data
@@ -35,24 +40,57 @@ get_api_key <- function(key.name, ...) {
 #'
 #' @examples
 #' \dontrun{
-#' easy_redcap("My_new_project",fields=c("record_id","age","hypertension"))
+#' easy_redcap("My_new_project", fields = c("record_id", "age", "hypertension"))
 #' }
-easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
-  key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"),
-                     prompt = "Provide REDCap API key:")
+easy_redcap <- function(project.name,
+                        uri,
+                        raw_or_label = "both",
+                        data_format = c("wide", "list", "redcap", "long"),
+                        widen.data = NULL,
+                        ...) {
+  data_format <- match.arg(data_format)
 
-  out <- read_redcap_tables(
+  # Interpretation of "widen.data" is kept and will override "data_format"
+  # for legacy sake
+  if (isTRUE(widen.data)) {
+    data_format <- "wide"
+  }
+
+  if (data_format %in% c("wide", "list")) {
+    split_action <- "all"
+  } else {
+    split_action <- "none"
+  }
+
+  key <- get_api_key(
+    key.name = paste0(project.name, "_REDCAP_API"),
+    prompt = "Provide REDCap API key:"
+  )
+
+  redcap_data <- read_redcap_tables(
     uri = uri,
     token = key,
-    raw_or_label = "both",
+    raw_or_label = raw_or_label,
+    split_forms = split_action,
     ...
   )
 
-  if (widen.data) {
-    out <- out |>
+  # For now, long data format is just legacy REDCap
+  # All options are written out for future improvements
+  if (data_format == "wide") {
+    out <- redcap_data |>
       redcap_wider() |>
       suffix2label()
+  } else if (data_format == "list") {
+    # The read_redcap_tables() output is a list of tables (forms)
+    out <- redcap_data
+  } else if (data_format == "long") {
+    out <- redcap_data
+  } else if (data_format == "redcap") {
+    out <- redcap_data
   }
 
   out
 }
+
+

R/fct_drop.R

@@ -1,7 +1,7 @@
 #' Drop unused levels preserving label data
 #'
 #' This extends [forcats::fct_drop()] to natively work across a data.frame and
-#' replace [base::droplevels()].
+#' replaces [base::droplevels()].
 #'
 #' @param x Factor to drop unused levels
 #' @param ... Other arguments passed down to method.
@@ -10,13 +10,20 @@
 #' @importFrom forcats fct_drop
 #' @export
 #' @name fct_drop
-NULL
+fct_drop <- function(x, ...) {
+  UseMethod("fct_drop")
+}
 
 #' @rdname fct_drop
 #' @export
+#'
+#' @examples
+#' mtcars |>
+#'   numchar2fct() |>
+#'   fct_drop()
 fct_drop.data.frame <- function(x, ...) {
   purrr::map(x, \(.x){
-    if (is.factor(.x)){
+    if (is.factor(.x)) {
       forcats::fct_drop(.x)
     } else {
       .x
@@ -26,4 +33,13 @@ fct_drop.data.frame <- function(x, ...) {
 }
 
 
-
+#' @rdname fct_drop
+#' @export
+#'
+#' @examples
+#' mtcars |>
+#'   numchar2fct() |>
+#'   dplyr::mutate(vs = fct_drop(vs))
+fct_drop.factor <- function(x, ...) {
+  forcats::fct_drop(f = x, ...)
+}

R/read_redcap_tables.R

@@ -26,7 +26,7 @@
 #'   \link[REDCapCAST]{fct_drop} to drop empty levels.
 #'
 #' @param split_forms Whether to split "repeating" or "all" forms, default is
-#' all.
+#' all. Give "none" to export native semi-long REDCap format
 #' @param ... passed on to \link[REDCapR]{redcap_read}
 #'
 #' @return list of instruments
@@ -42,22 +42,24 @@ read_redcap_tables <- function(uri,
                                fields = NULL,
                                events = NULL,
                                forms = NULL,
-                               raw_or_label = c("raw","label","both"),
-                               split_forms = "all",
+                               raw_or_label = c("raw", "label", "both"),
+                               split_forms = c("all", "repeating", "none"),
                                ...) {
-
-  raw_or_label <- match.arg(raw_or_label, c("raw","label","both"))
+  raw_or_label <- match.arg(raw_or_label, c("raw", "label", "both"))
+  split_forms <- match.arg(split_forms)
 
   # Getting metadata
   m <-
     REDCapR::redcap_metadata_read(redcap_uri = uri, token = token)[["data"]]
 
   if (!is.null(fields)) {
-    fields_test <- fields %in% c(m$field_name,paste0(unique(m$form_name),"_complete"))
+    fields_test <- fields %in% c(m$field_name, paste0(unique(m$form_name), "_complete"))
 
     if (any(!fields_test)) {
-      print(paste0("The following field names are invalid: ",
-                   paste(fields[!fields_test], collapse = ", "), "."))
+      print(paste0(
+        "The following field names are invalid: ",
+        paste(fields[!fields_test], collapse = ", "), "."
+      ))
       stop("Not all supplied field names are valid")
     }
   }
@@ -67,8 +69,10 @@ read_redcap_tables <- function(uri,
     forms_test <- forms %in% unique(m$form_name)
 
     if (any(!forms_test)) {
-      print(paste0("The following form names are invalid: ",
-                   paste(forms[!forms_test], collapse = ", "), "."))
+      print(paste0(
+        "The following form names are invalid: ",
+        paste(forms[!forms_test], collapse = ", "), "."
+      ))
       stop("Not all supplied form names are valid")
     }
   }
@@ -82,13 +86,15 @@ read_redcap_tables <- function(uri,
     event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
 
     if (any(!event_test)) {
-      print(paste0("The following event names are invalid: ",
-                   paste(events[!event_test], collapse = ", "), "."))
+      print(paste0(
+        "The following event names are invalid: ",
+        paste(events[!event_test], collapse = ", "), "."
+      ))
       stop("Not all supplied event names are valid")
     }
   }
 
-  if (raw_or_label=="both"){
+  if (raw_or_label == "both") {
     rorl <- "raw"
   } else {
     rorl <- raw_or_label
@@ -106,10 +112,10 @@ read_redcap_tables <- function(uri,
     ...
   )[["data"]]
 
-  if (raw_or_label=="both"){
-    d <- apply_field_label(data=d,meta=m)
+  if (raw_or_label == "both") {
+    d <- apply_field_label(data = d, meta = m)
 
-    d <- apply_factor_labels(data=d,meta=m)
+    d <- apply_factor_labels(data = d, meta = m)
   }
 
 
@@ -123,15 +129,16 @@ read_redcap_tables <- function(uri,
   # Processing metadata to reflect focused dataset
   m <- focused_metadata(m, names(d))
 
-
   # Splitting
-  out <- REDCap_split(d,
-    m,
-    forms = split_forms,
-    primary_table_name = ""
-  )
-
-  sanitize_split(out)
+  if (split_forms != "none") {
+    REDCap_split(d,
+      m,
+      forms = split_forms,
+      primary_table_name = ""
+    ) |> sanitize_split()
+  } else {
+    d
+  }
 }
 
 
@@ -171,7 +178,7 @@ clean_field_label <- function(data) {
 #' @export
 #'
 #' @examples
-#' format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
+#' format_redcap_factor(sample(1:3, 20, TRUE), "1, First. | 2, second | 3, THIRD")
 format_redcap_factor <- function(data, meta) {
   lvls <- strsplit(meta, " | ", fixed = TRUE) |>
     unlist() |>
@@ -196,13 +203,13 @@ format_redcap_factor <- function(data, meta) {
 #' @return data.frame
 #' @export
 #'
-apply_field_label <- function(data,meta){
+apply_field_label <- function(data, meta) {
   purrr::imap(data, \(.x, .i){
     if (.i %in% meta$field_name) {
       # Does not handle checkboxes
       out <- set_attr(.x,
-                      label = clean_field_label(meta$field_label[meta$field_name == .i]),
-                      attr = "label"
+        label = clean_field_label(meta$field_label[meta$field_name == .i]),
+        attr = "label"
       )
       out
     } else {
@@ -219,9 +226,15 @@ apply_field_label <- function(data,meta){
 #' @return data.frame
 #' @export
 #'
-apply_factor_labels <- function(data,meta){
+apply_factor_labels <- function(data, meta = NULL) {
+  if (is.list(data) && !is.data.frame(data)) {
+    meta <- data$meta
+    data <- data$data
+  } else if (is.null(meta)) {
+    stop("Please provide a data frame for meta")
+  }
   purrr::imap(data, \(.x, .i){
-    if (any(c("radio", "dropdown") %in% meta$field_type[meta$field_name == .i])) {
+    if (any(c("radio", "dropdown") %in% meta$field_type[meta$field_name == .i]) || is.factor(.x)) {
       format_redcap_factor(.x, meta$select_choices_or_calculations[meta$field_name == .i])
     } else {
       .x

R/redcap_wider.R

@@ -79,11 +79,35 @@ utils::globalVariables(c(
 #'   )
 #' )
 #' redcap_wider(list4)
+#'
+#' list5 <- list(
+#'   data.frame(
+#'     record_id = c(1, 2, 1, 2),
+#'     redcap_event_name = c("baseline", "baseline", "followup", "followup")
+#'   ),
+#'   data.frame(
+#'     record_id = c(1, 1, 1, 1, 2, 2, 2, 2),
+#'     redcap_event_name = c(
+#'       "baseline", "baseline", "followup", "followup",
+#'       "baseline", "baseline", "followup", "followup"
+#'     ),
+#'     redcap_repeat_instrument = "walk",
+#'     redcap_repeat_instance = c(1, 2, 1, 2, 1, 2, 1, 2),
+#'     dist = c(40, 32, 25, 33, 28, 24, 23, 36)
+#'   ),
+#'   data.frame(
+#'     record_id = c(1, 2),
+#'     redcap_event_name = c("baseline", "baseline"),
+#'     gender = c("male", "female")
+#'   )
+#' )
+#' redcap_wider(list5)
 redcap_wider <-
   function(data,
            event.glue = "{.value}____{redcap_event_name}",
            inst.glue = "{.value}____{redcap_repeat_instance}") {
-    # browser()
+
+
     if (!is_repeated_longitudinal(data)) {
       if (is.list(data)) {
         if (length(data) == 1) {
@@ -95,22 +119,37 @@ redcap_wider <-
         out <- data
       }
     } else {
-      id.name <- do.call(c, lapply(data, names))[[1]]
+
+      ## Cleaning instrument list to only include instruments holding other data
+      ## than ID and generic columns
+      ## This is to mitigate an issue when not exporting fields from the first
+      ## instrument.
+      ## Not taking this step would throw an error when pivoting.
+      instrument_names <- lapply(data, names)
+
+      id.name <- do.call(c, instrument_names)[[1]]
+
+      generic_names <- c(
+        id.name,
+        "redcap_event_name",
+        "redcap_repeat_instrument",
+        "redcap_repeat_instance"
+      )
+
+      semi_empty <- lapply(instrument_names,\(.x){
+        all(.x %in% generic_names)
+      }) |> unlist()
+
+      data <- data[!semi_empty]
 
       l <- lapply(data, function(i) {
-        # browser()
         rep_inst <- "redcap_repeat_instrument" %in% names(i)
 
         if (rep_inst) {
           k <- lapply(split(i, f = i[[id.name]]), function(j) {
             cname <- colnames(j)
             vals <-
-              cname[!cname %in% c(
-                id.name,
-                "redcap_event_name",
-                "redcap_repeat_instrument",
-                "redcap_repeat_instance"
-              )]
+              cname[!cname %in% generic_names]
             s <- tidyr::pivot_wider(
               j,
               names_from = "redcap_repeat_instance",

R/shiny_cast.R

@@ -47,6 +47,12 @@ file_extension <- function(filenames) {
 #' @return tibble
 #' @export
 #'
+#' @importFrom openxlsx2 read_xlsx
+#' @importFrom haven read_dta
+#' @importFrom readODS read_ods
+#' @importFrom readr read_csv read_rds
+#'
+#'
 #' @examples
 #' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv")
 read_input <- function(file, consider.na = c("NA", '""', "")) {
@@ -55,15 +61,15 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
   tryCatch(
     {
       if (ext == "csv") {
-        df <- readr::read_csv(file = file, na = consider.na)
+        df <- read_csv(file = file, na = consider.na)
       } else if (ext %in% c("xls", "xlsx")) {
-        df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na)
+        df <- read_xlsx(file = file, na.strings = consider.na)
       } else if (ext == "dta") {
-        df <- haven::read_dta(file = file)
+        df <- read_dta(file = file)
       } else if (ext == "ods") {
-        df <- readODS::read_ods(path = file)
+        df <- read_ods(path = file)
       } else if (ext == "rds") {
-        df <- readr::read_rds(file = file)
+        df <- read_rds(file = file)
       }else {
         stop("Input file format has to be on of:
              '.csv', '.xls', '.xlsx', '.dta', '.ods' or '.rds'")

R/utils.r

@@ -97,7 +97,10 @@ focused_metadata <- function(metadata, vars_in_data) {
 #' @return vector or data frame, same format as input
 #' @export
 #'
+#' @examples
+#' "Research!, ne:ws? and c;l-.ls" |> clean_redcap_name()
 clean_redcap_name <- function(x) {
+  gsub("[,.;:?!@]","",
   gsub(
     " ", "_",
     gsub(
@@ -108,6 +111,7 @@ clean_redcap_name <- function(x) {
       )
     )
   )
+  )
 }
 
 
@@ -518,3 +522,22 @@ dummy_fun <- function(...){
     gtsummary::add_difference()
   )
 }
+
+
+#' Cut string to desired length
+#'
+#' @param data data
+#' @param l length
+#'
+#' @returns character string of length l
+#' @export
+#'
+#' @examples
+#' "length" |> cut_string_length(l=3)
+cut_string_length <- function(data,l=100){
+  if (nchar(data)>=l){
+    substr(data,1,l)
+  } else {
+    data
+  }
+}

README.md

@@ -1,7 +1,6 @@
 <!-- badges: start -->
 
-[![GitHub R package version](https://img.shields.io/github/r-package/v/agdamsbo/REDCapCAST)](https://github.com/agdamsbo/REDCapCAST) [![CRAN/METACRAN](https://img.shields.io/cran/v/REDCapCAST)](https://CRAN.R-project.org/package=REDCapCAST) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.8013984.svg)](https://doi.org/10.5281/zenodo.8013984) [![R-hub](https://github.com/agdamsbo/REDCapCAST/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/rhub.yaml) [![R-CMD-check](https://github.com/agdamsbo/REDCapCAST/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/R-CMD-check.yaml) [![Page deployed](https://github.com/agdamsbo/REDCapCAST/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/pages/pages-build-deployment) [![Codecov test coverage](https://codecov.io/gh/agdamsbo/REDCapCAST/branch/master/graph/badge.svg)](https://app.codecov.io/gh/agdamsbo/REDCapCAST?branch=master) [![CRAN downloads](https://cranlogs.r-pkg.org/badges/grand-total/REDCapCAST)](https://cran.r-project.org/package=REDCapCAST) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html)
-
+[![GitHub R package version](https://img.shields.io/github/r-package/v/agdamsbo/REDCapCAST)](https://github.com/agdamsbo/REDCapCAST) [![CRAN/METACRAN](https://img.shields.io/cran/v/REDCapCAST)](https://CRAN.R-project.org/package=REDCapCAST) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.8013984.svg)](https://doi.org/10.5281/zenodo.8013984) [![R-hub](https://github.com/agdamsbo/REDCapCAST/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/rhub.yaml) [![R-CMD-check](https://github.com/agdamsbo/REDCapCAST/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/R-CMD-check.yaml) [![Page deployed](https://github.com/agdamsbo/REDCapCAST/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/agdamsbo/REDCapCAST/actions/workflows/pages/pages-build-deployment) [![CRAN downloads](https://cranlogs.r-pkg.org/badges/grand-total/REDCapCAST)](https://cran.r-project.org/package=REDCapCAST) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html) [![Codecov test coverage](https://codecov.io/gh/agdamsbo/REDCapCAST/graph/badge.svg)](https://app.codecov.io/gh/agdamsbo/REDCapCAST)
 <!-- badges: end -->
 
 # REDCapCAST package <img src="man/figures/logo.png" align="right"/>

REDCapCAST.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: d97cf790-0785-4be6-9651-e02a4867726b
 
 RestoreWorkspace: No
 SaveWorkspace: No
@@ -18,4 +19,5 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageCheckArgs: --as-cran
 PackageRoxygenize: rd,collate,namespace,vignette

cran-comments.md

@@ -1,8 +1,10 @@
-── R CMD check results ─────────────────────────────────────────────────────────────────────────────── REDCapCAST 24.11.1 ────
-Duration: 23.8s
+
+── R CMD check results ───────────────────────────────────────────────────────────────────────────────── REDCapCAST 25.3.2 ────
+Duration: 37.1s
 
 0 errors ✔ | 0 warnings ✔ | 0 notes ✔
 
 R CMD check succeeded
+
 ## Test environments
 Rhubv2 runs and checks out.

inst/WORDLIST

@@ -11,6 +11,7 @@ GithubActions
 JSON
 Lifecycle
 METACRAN
+MMRM
 Nav
 ORCID
 POSIXct
@@ -18,6 +19,7 @@ REDCap
 REDCapR
 REDCapRITS
 REDCapTidieR
+Stackoverflow
 WD
 al
 api
@@ -68,6 +70,7 @@ natively
 ncol
 og
 param
+params
 pegeler
 perl
 pos

inst/shiny-examples/casting/app.R

@@ -50,9 +50,21 @@ server <- function(input, output, session) {
         )
     }
 
+    if (input$factorize == "yes") {
+      out <- out |>
+        (\(.x){
+          suppressWarnings(
+            numchar2fct(.x)
+          )
+        })()
+    }
     out
   })
 
+  shiny::eventReactive(input$load_data, {
+    v$file <- "loaded"
+  })
+
   # getData <- reactive({
   #   if(is.null(input$ds$datapath)) return(NULL)
   # })
@@ -62,7 +74,7 @@ server <- function(input, output, session) {
 
   dd <- shiny::reactive({
     shiny::req(input$ds)
-    v$file <- "loaded"
+    # v$file <- "loaded"
     ds2dd_detailed(
       data = dat(),
       add.auto.id = input$add_id == "yes",
@@ -77,16 +89,6 @@ server <- function(input, output, session) {
     )
   })
 
-  output$uploaded <- shiny::reactive({
-    if (is.null(v$file)) {
-      "no"
-    } else {
-      "yes"
-    }
-  })
-
-  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
-
   output$factor_vars <- shiny::renderUI({
     shiny::req(input$ds)
     selectizeInput(
@@ -176,17 +178,31 @@ server <- function(input, output, session) {
 
     shiny::req(input$api)
 
-    output_staging$data <- REDCapR::redcap_write(
-      ds = purrr::pluck(dd(), "data"),
-      redcap_uri = input$uri,
-      token = input$api
-    ) |> purrr::pluck("success")
+    output_staging$data <- dd() |>
+      apply_factor_labels() |>
+      REDCapR::redcap_write(
+        redcap_uri = input$uri,
+        token = input$api
+      ) |>
+      purrr::pluck("success")
   }
 
   output$upload.meta.print <- renderText(output_staging$meta)
 
   output$upload.data.print <- renderText(output_staging$data)
 
+  output$uploaded <- shiny::reactive({
+    if (is.null(v$file)) {
+      "no"
+    } else {
+      "yes"
+    }
+  })
+
+  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
+
+  output$data.load <- shiny::renderText(expr = nrow(dat()))
+
   # session$onSessionEnded(function() {
   #   # cat("Session Ended\n")
   #   unlink("www",recursive = TRUE)
@@ -216,16 +232,17 @@ ui <-
             ".ods"
           )
         ),
-        # shiny::actionButton(
-        #   inputId = "load_data",
-        #   label = "Load data",
-        #   icon = shiny::icon("circle-down")
-        # ),
-        shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
+        shiny::actionButton(
+          inputId = "options",
+          label = "Show options",
+          icon = shiny::icon("wrench")
+        ),
+        shiny::helpText("Choose and upload a dataset, then press the button for data modification and options for data download or upload."),
         # For some odd reason this only unfolds when the preview panel is shown..
         # This has been solved by adding an arbitrary button to load data - which was abandoned again
         shiny::conditionalPanel(
-          condition = "output.uploaded=='yes'",
+          # condition = "output.uploaded=='yes'",
+          condition = "input.options > 0",
           shiny::radioButtons(
             inputId = "add_id",
             label = "Add ID, or use first column?",
@@ -237,14 +254,24 @@ ui <-
               "No ID" = "none"
             )
           ),
+          shiny::radioButtons(
+            inputId = "factorize",
+            label = "Factorize variables with few levels?",
+            selected = "yes",
+            inline = TRUE,
+            choices = list(
+              "Yes" = "yes",
+              "No" = "no"
+            )
+          ),
           shiny::radioButtons(
             inputId = "specify_factors",
             label = "Specify categorical variables?",
             selected = "no",
             inline = TRUE,
             choices = list(
-              "No" = "no",
-              "Yes" = "yes"
+              "Yes" = "yes",
+              "No" = "no"
             )
           ),
           shiny::conditionalPanel(
@@ -254,25 +281,27 @@ ui <-
           # condition = "input.load_data",
           #  shiny::helpText("Below you can download the dataset formatted for upload and the
           # corresponding data dictionary for a new data base, if you want to upload manually."),
+          shiny::tags$hr(),
+          shiny::h4("Download data for manual upload"),
+          shiny::helpText("Look further down for direct upload option"),
           # Button
           shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
-
+          shiny::em("and then"),
           # Button
           shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
-
-          # Button
+          shiny::em("or"),
           shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
 
           # Horizontal line ----
           shiny::tags$hr(),
           shiny::radioButtons(
             inputId = "upload_redcap",
-            label = "Upload directly to REDCap server?",
+            label = "Upload directly to a REDCap server?",
             selected = "no",
             inline = TRUE,
             choices = list(
-              "No" = "no",
-              "Yes" = "yes"
+              "Yes" = "yes",
+              "No" = "no"
             )
           ),
           shiny::conditionalPanel(
@@ -315,7 +344,8 @@ ui <-
       bslib::nav_panel(
         title = "Intro",
         shiny::markdown(readLines("www/SHINYCAST.md")),
-        shiny::br()
+        shiny::br(),
+        shiny::textOutput(outputId = "data.load")
       ),
       # bslib::nav_spacer(),
       bslib::nav_panel(

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 11351429
-bundleId: 9425139
+bundleId: 9642648
 url: https://agdamsbo.shinyapps.io/redcapcast/
 version: 1

man/REDCapCAST-package.Rd

@@ -6,8 +6,6 @@
 \alias{REDCapCAST-package}
 \title{REDCapCAST: REDCap Metadata Casting and Castellated Data Handling}
 \description{
-\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
-
 Casting metadata for REDCap database creation and handling of castellated data using repeated instruments and longitudinal projects in 'REDCap'. Keeps a focused data export approach, by allowing to only export required data from the database. Also for casting new REDCap databases based on datasets from other sources. Originally forked from the R part of 'REDCapRITS' by Paul Egeler. See \url{https://github.com/pegeler/REDCapRITS}. 'REDCap' (Research Electronic Data Capture) is a secure, web-based software platform designed to support data capture for research studies, providing 1) an intuitive interface for validated data capture; 2) audit trails for tracking data manipulation and export procedures; 3) automated export procedures for seamless data downloads to common statistical packages; and 4) procedures for data integration and interoperability with external sources (Harris et al (2009) \doi{10.1016/j.jbi.2008.08.010}; Harris et al (2019) \doi{10.1016/j.jbi.2019.103208}).
 }
 \seealso{

man/apply_factor_labels.Rd

@@ -4,7 +4,7 @@
 \alias{apply_factor_labels}
 \title{Preserve all factor levels from REDCap data dictionary in data export}
 \usage{
-apply_factor_labels(data, meta)
+apply_factor_labels(data, meta = NULL)
 }
 \arguments{
 \item{data}{REDCap exported data set}

man/as_factor.Rd

@@ -63,6 +63,8 @@ ta loss in case of rich formatted and labelled data.
 \details{
 Please refer to parent functions for extended documentation.
 To avoid redundancy calls and errors, functions are copy-pasted here
+
+Empty variables with empty levels attribute are interpreted as logicals
 }
 \examples{
 # will preserve all attributes
@@ -77,5 +79,12 @@ structure(c(1, 2, 3, 2, 10, 9),
   labels = c(Unknown = 9, Refused = 10),
   class = "haven_labelled"
 ) |>
-  as_factor()
+  as_factor() |> class()
+structure(rep(NA,10),
+  class = c("labelled")
+) |>
+  as_factor() |> summary()
+
+rep(NA,10) |> as_factor()
+
 }

man/as_logical.Rd

@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/as_logical.R
+\name{as_logical}
+\alias{as_logical}
+\alias{as_logical.data.frame}
+\alias{as_logical.default}
+\title{Interpret specific binary values as logicals}
+\usage{
+as_logical(
+  x,
+  values = list(c("TRUE", "FALSE"), c("Yes", "No"), c(1, 0), c(1, 2)),
+  ...
+)
+
+\method{as_logical}{data.frame}(
+  x,
+  values = list(c("TRUE", "FALSE"), c("Yes", "No"), c(1, 0), c(1, 2)),
+  ...
+)
+
+\method{as_logical}{default}(
+  x,
+  values = list(c("TRUE", "FALSE"), c("Yes", "No"), c(1, 0), c(1, 2)),
+  ...
+)
+}
+\arguments{
+\item{x}{vector or data.frame}
+
+\item{values}{list of values to interpret as logicals. First value is}
+
+\item{...}{ignored
+interpreted as TRUE.}
+}
+\value{
+vector
+}
+\description{
+Interpret specific binary values as logicals
+}
+\examples{
+c(sample(c("TRUE", "FALSE"), 20, TRUE), NA) |>
+  as_logical() |>
+  class()
+ds <- dplyr::tibble(
+  B = factor(sample(c(1, 2), 20, TRUE)),
+  A = factor(sample(c("TRUE", "FALSE"), 20, TRUE)),
+  C = sample(c(3, 4), 20, TRUE),
+  D = factor(sample(c("In", "Out"), 20, TRUE))
+)
+ds |>
+  as_logical() |>
+  sapply(class)
+ds$A |> class()
+sample(c("TRUE",NA), 20, TRUE) |>
+  as_logical()
+as_logical(0)
+}

man/clean_redcap_name.Rd

@@ -17,3 +17,6 @@ Stepwise removal on non-alphanumeric characters, trailing white space,
 substitutes spaces for underscores and converts to lower case.
 Trying to make up for different naming conventions.
 }
+\examples{
+"Research!, ne:ws? and c;l-.ls" |> clean_redcap_name()
+}

man/cut_string_length.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.r
+\name{cut_string_length}
+\alias{cut_string_length}
+\title{Cut string to desired length}
+\usage{
+cut_string_length(data, l = 100)
+}
+\arguments{
+\item{data}{data}
+
+\item{l}{length}
+}
+\value{
+character string of length l
+}
+\description{
+Cut string to desired length
+}
+\examples{
+"length" |> cut_string_length(l=3)
+}

man/ds2dd.Rd

@@ -49,5 +49,5 @@ Migrated from stRoke ds2dd(). Fits better with the functionality of
 }
 \examples{
 redcapcast_data$record_id <- seq_len(nrow(redcapcast_data))
-ds2dd(redcapcast_data, include.column.names=TRUE)
+ds2dd(redcapcast_data, include.column.names = TRUE)
 }

man/ds2dd_detailed.Rd

@@ -16,7 +16,7 @@ ds2dd_detailed(
   field.label.attr = "label",
   field.validation = NULL,
   metadata = names(REDCapCAST::redcapcast_meta),
-  convert.logicals = TRUE
+  convert.logicals = FALSE
 )
 }
 \arguments{
@@ -91,7 +91,10 @@ iris |>
     form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
   ) |>
   purrr::pluck("meta")
-mtcars |> ds2dd_detailed(add.auto.id = TRUE)
+mtcars |>
+  dplyr::mutate(unknown = NA) |>
+  numchar2fct() |>
+  ds2dd_detailed(add.auto.id = TRUE)
 
 ## Using column name suffix to carry form name
 data <- iris |>

man/easy_redcap.Rd

@@ -4,16 +4,30 @@
 \alias{easy_redcap}
 \title{Secure API key storage and data acquisition in one}
 \usage{
-easy_redcap(project.name, widen.data = TRUE, uri, ...)
+easy_redcap(
+  project.name,
+  uri,
+  raw_or_label = "both",
+  data_format = c("wide", "list", "redcap", "long"),
+  widen.data = NULL,
+  ...
+)
 }
 \arguments{
 \item{project.name}{The name of the current project (for key storage with
 \link[keyring]{key_set}, using the default keyring)}
 
-\item{widen.data}{argument to widen the exported data}
-
 \item{uri}{REDCap database API uri}
 
+\item{raw_or_label}{argument passed on to
+\link[REDCapCAST]{read_redcap_tables}. Default is "both" to get labelled
+data.}
+
+\item{data_format}{Choose the data}
+
+\item{widen.data}{argument to widen the exported data. [DEPRECATED], use
+`data_format`instead}
+
 \item{...}{arguments passed on to \link[REDCapCAST]{read_redcap_tables}.}
 }
 \value{
@@ -24,6 +38,6 @@ Secure API key storage and data acquisition in one
 }
 \examples{
 \dontrun{
-easy_redcap("My_new_project",fields=c("record_id","age","hypertension"))
+easy_redcap("My_new_project", fields = c("record_id", "age", "hypertension"))
 }
 }

man/fct_drop.Rd

@@ -3,9 +3,14 @@
 \name{fct_drop}
 \alias{fct_drop}
 \alias{fct_drop.data.frame}
+\alias{fct_drop.factor}
 \title{Drop unused levels preserving label data}
 \usage{
-fct_drop.data.frame(x, ...)
+fct_drop(x, ...)
+
+\method{fct_drop}{data.frame}(x, ...)
+
+\method{fct_drop}{factor}(x, ...)
 }
 \arguments{
 \item{x}{Factor to drop unused levels}
@@ -14,5 +19,13 @@ fct_drop.data.frame(x, ...)
 }
 \description{
 This extends [forcats::fct_drop()] to natively work across a data.frame and
-replace [base::droplevels()].
+replaces [base::droplevels()].
+}
+\examples{
+mtcars |>
+  numchar2fct() |>
+  fct_drop()
+mtcars |>
+  numchar2fct() |>
+  dplyr::mutate(vs = fct_drop(vs))
 }

man/format_redcap_factor.Rd

@@ -19,5 +19,5 @@ Applying \link[REDCapCAST]{as_factor} to the data.frame or variable, will
 coerce to a factor.
 }
 \examples{
-format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
+format_redcap_factor(sample(1:3, 20, TRUE), "1, First. | 2, second | 3, THIRD")
 }

man/read_redcap_tables.Rd

@@ -12,7 +12,7 @@ read_redcap_tables(
   events = NULL,
   forms = NULL,
   raw_or_label = c("raw", "label", "both"),
-  split_forms = "all",
+  split_forms = c("all", "repeating", "none"),
   ...
 )
 }
@@ -40,7 +40,7 @@ read_redcap_tables(
   \link[REDCapCAST]{fct_drop} to drop empty levels.}
 
 \item{split_forms}{Whether to split "repeating" or "all" forms, default is
-all.}
+all. Give "none" to export native semi-long REDCap format}
 
 \item{...}{passed on to \link[REDCapR]{redcap_read}}
 }

man/redcap_wider.Rd

@@ -83,4 +83,27 @@ list4 <- list(
   )
 )
 redcap_wider(list4)
+
+list5 <- list(
+  data.frame(
+    record_id = c(1, 2, 1, 2),
+    redcap_event_name = c("baseline", "baseline", "followup", "followup")
+  ),
+  data.frame(
+    record_id = c(1, 1, 1, 1, 2, 2, 2, 2),
+    redcap_event_name = c(
+      "baseline", "baseline", "followup", "followup",
+      "baseline", "baseline", "followup", "followup"
+    ),
+    redcap_repeat_instrument = "walk",
+    redcap_repeat_instance = c(1, 2, 1, 2, 1, 2, 1, 2),
+    dist = c(40, 32, 25, 33, 28, 24, 23, 36)
+  ),
+  data.frame(
+    record_id = c(1, 2),
+    redcap_event_name = c("baseline", "baseline"),
+    gender = c("male", "female")
+  )
+)
+redcap_wider(list5)
 }

renv.lock

@@ -187,6 +187,22 @@
       ],
       "Hash": "cd9a672193789068eb5a2aad65a0dedf"
     },
+    "cards": {
+      "Package": "cards",
+      "Version": "0.4.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cli",
+        "dplyr",
+        "glue",
+        "rlang",
+        "tidyr",
+        "tidyselect"
+      ],
+      "Hash": "2cd0d1966092de416f9b7fa1e88b6132"
+    },
     "cellranger": {
       "Package": "cellranger",
       "Version": "1.1.0",
@@ -456,6 +472,25 @@
       ],
       "Hash": "3170d1f0f45e531c241179ab57cd30bd"
     },
+    "gtsummary": {
+      "Package": "gtsummary",
+      "Version": "2.0.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cards",
+        "cli",
+        "dplyr",
+        "glue",
+        "gt",
+        "lifecycle",
+        "rlang",
+        "tidyr",
+        "vctrs"
+      ],
+      "Hash": "cd4d593e8ce0ad4e5c2c0acc50ce7330"
+    },
     "haven": {
       "Package": "haven",
       "Version": "2.5.4",

vignettes/REDCapCAST.Rmd

@@ -37,7 +37,7 @@ shiny_cast()
 
 To get you started, the easiest way possible, you can use the `easy_redcap()` function (example below).
 
-You will need an API-key for your REDCap server, the uri/URL/address for the API connection (usually the adress used for accessing your institutions REDCap servar, with an appended "/api/").
+You will need an API-key for your REDCap server, the uri/URL/address for the API connection (usually the address used for accessing your institutions REDCap server, with an appended "/api/").
 
 This function includes a few convenience features to ease your further work.
 
@@ -110,7 +110,8 @@ wide_data_suffixes <- wide_data |> suffix2label()
 ## Creating a nice table
 
 ```{r}
-wide_data_suffixes |>
+wide_data_suffixes |> 
+  as_factor()|>
   dplyr::select(sex, hypertension, diabetes,mrs_score____follow2) |>
-  gtsummary::tbl_summary()
+  gtsummary::tbl_summary(type = gtsummary::all_dichotomous() ~ "categorical")
 ```