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: 25.1.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")), 
@@ -72,6 +72,7 @@ Collate:
     'process_user_input.r'
     'REDCap_split.r'
     'as_factor.R'
+    'as_logical.R'
     'doc2dd.R'
     'ds2dd_detailed.R'
     'easy_redcap.R'

NAMESPACE

@@ -7,6 +7,8 @@ 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)
@@ -18,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)

NEWS.md

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

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

@@ -127,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",
@@ -136,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
 
@@ -178,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
+    }
   }
 
 
@@ -246,7 +247,10 @@ ds2dd <-
 #'     form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
 #'   ) |>
 #'   purrr::pluck("meta")
-#' mtcars |> numchar2fct() |> 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 |>
@@ -266,16 +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)
 
-  short_names <- colnames(data) |> lapply(\(.x) cut_string_length(.x,l=90)) |> purrr::reduce(c)
-
-  data <- stats::setNames(data,short_names)
+  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
@@ -369,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
@@ -432,7 +446,7 @@ ds2dd_detailed <- function(data,
       hms2character() |>
       stats::setNames(dd$field_name) |>
       lapply(\(.x){
-        if (identical("factor",class(.x))){
+        if (identical("factor", class(.x))) {
           as.numeric(.x)
         } else {
           .x
@@ -679,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,11 +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
@@ -41,27 +43,54 @@ get_api_key <- function(key.name, ...) {
 #' easy_redcap("My_new_project", fields = c("record_id", "age", "hypertension"))
 #' }
 easy_redcap <- function(project.name,
-                        widen.data = TRUE,
                         uri,
                         raw_or_label = "both",
+                        data_format = c("wide", "list", "redcap", "long"),
+                        widen.data = NULL,
                         ...) {
+  data_format <- match.arg(data_format)
+
+  # 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:"
   )
 
-  out <- read_redcap_tables(
+  redcap_data <- read_redcap_tables(
     uri = uri,
     token = key,
     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/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,8 +226,8 @@ apply_field_label <- function(data,meta){
 #' @return data.frame
 #' @export
 #'
-apply_factor_labels <- function(data,meta=NULL){
-  if (is.list(data) && !is.data.frame(data)){
+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)) {
@@ -234,5 +241,3 @@ apply_factor_labels <- function(data,meta=NULL){
     }
   }) |> dplyr::bind_cols()
 }
-
-

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",

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

cran-comments.md

@@ -1,5 +1,6 @@
-── R CMD check results ─────────────────────────────────────────────────────────────────────── REDCapCAST 25.1.1 ────
-Duration: 31.2s
+
+── R CMD check results ───────────────────────────────────────────────────────────────────────────────── REDCapCAST 25.3.2 ────
+Duration: 37.1s
 
 0 errors ✔ | 0 warnings ✔ | 0 notes ✔
 

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

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/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 |> numchar2fct() |> 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,20 +4,30 @@
 \alias{easy_redcap}
 \title{Secure API key storage and data acquisition in one}
 \usage{
-easy_redcap(project.name, widen.data = TRUE, uri, raw_or_label = "both", ...)
+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{

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