NAMESPACE

@@ -20,6 +20,7 @@ export(strsplitx)
 importFrom(REDCapR,redcap_event_instruments)
 importFrom(REDCapR,redcap_metadata_read)
 importFrom(REDCapR,redcap_read)
+importFrom(dplyr,left_join)
 importFrom(keyring,key_get)
 importFrom(keyring,key_list)
 importFrom(keyring,key_set)

NEWS.md

@@ -4,9 +4,7 @@
 
 * Fix: `ds2dd()`: uses correct default dd column names. Will be deprecated.
 
-* Fix: `easy_redcap()`: fixed to actually allow project naming. also specifically asks for uri. widening updated to work.
+* Fix: `easy_redcap()`: fixed to actually allow project naming. also specifically asks for uri.
-
-* Fix: `redcap_wider()`: updated to accept more formats and allow handling of simple projects without repeating instruments and not longitudinal.
 
 * Fix: `read_redcap_tables()`: now handles non-longitudinal project without repeatable instruments.
 

R/REDCap_split.r

@@ -92,13 +92,13 @@ REDCap_split <- function(records,
   metadata <-
     as.data.frame(process_user_input(metadata))
 
+  # Process repeat instrument names to match the redcap naming
+  records$redcap_repeat_instrument <- clean_redcap_name(records$redcap_repeat_instrument)
+
+
   # Get the variable names in the dataset
   vars_in_data <- names(records)
 
-  # Process repeat instrument names to match the redcap naming
-  if (is.repeated_longitudinal(records)){
-  records$redcap_repeat_instrument <- clean_redcap_name(records$redcap_repeat_instrument)
-
   # Match arg for forms
   forms <- match.arg(forms, c("repeating", "all"))
 
@@ -116,7 +116,6 @@ REDCap_split <- function(records,
       as.character(records$redcap_repeat_instrument)
     )
   }
-  }
 
   # Standardize variable names for metadata
   # names(metadata) <- metadata_names
@@ -139,8 +138,6 @@ REDCap_split <- function(records,
     )
   )
 
-
-
   if ("redcap_repeat_instrument" %in% vars_in_data) {
     # Variables to be at the beginning of each repeating instrument
     repeat_instrument_fields <- grep("^redcap_repeat.*",
@@ -199,5 +196,5 @@ REDCap_split <- function(records,
   }
 
   out
-}
 
+}

R/easy_redcap.R

@@ -10,7 +10,7 @@ get_api_key <- function(key.name) {
   if (key.name %in% keyring::key_list()$service) {
     keyring::key_get(service = key.name)
   } else {
-    keyring::key_set(service = key.name, prompt = "Provide REDCap API key:")
+    keyring::key_set(service = key.name, prompt = "Write REDCap API key:")
     keyring::key_get(service = key.name)
   }
 }
@@ -19,24 +19,40 @@ get_api_key <- function(key.name) {
 #' Secure API key storage and data acquisition in one
 #'
 #' @param project.name The name of the current project (for key storage with
-#' `keyring::key_set()`, using the default keyring)
+#' `keyring::key_set()`)
 #' @param widen.data argument to widen the exported data
 #' @param uri REDCap database API uri
 #' @param ... arguments passed on to `REDCapCAST::read_redcap_tables()`
 #'
 #' @return data.frame or list depending on widen.data
+#' @importFrom purrr reduce
+#' @importFrom dplyr left_join
 #' @export
-easy_redcap <- function(project.name, widen.data=TRUE, uri, ...) {
+easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
   key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"))
 
   out <- read_redcap_tables(
-    uri = uri,
     token = key,
+    uri = uri,
     ...
   )
 
-  if (widen.data){
+  all_names <- out |>
-    out <- out |> redcap_wider()
+    lapply(names) |>
+    Reduce(c, x = _) |>
+    unique()
+
+  if (widen.data) {
+    if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
+      all_names)) {
+      if (length(out) == 1) {
+        out <- out[[1]]
+      } else {
+        out <- out |> purrr::reduce(dplyr::left_join)
+      }
+    } else {
+      out <- out |> redcap_wider()
+    }
   }
 
   out

R/read_redcap_tables.R

@@ -31,40 +31,47 @@ read_redcap_tables <- function(uri,
                                events = NULL,
                                forms = NULL,
                                raw_or_label = "label",
-                               split_forms = "all") {
+                               split_forms = "all",
+                               generics = c(
+                                 "redcap_event_name",
+                                 "redcap_repeat_instrument",
+                                 "redcap_repeat_instance"
+                               )) {
+
+
   # Getting metadata
   m <-
-    REDCapR::redcap_metadata_read(redcap_uri = uri, token = token)[["data"]]
+    REDCapR::redcap_metadata_read (redcap_uri = uri, token = token)[["data"]]
+
+  if (!is.null(fields)){
 
-  if (!is.null(fields)) {
     fields_test <- fields %in% unique(m$field_name)
 
-    if (any(!fields_test)) {
+    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")
     }
   }
 
 
-  if (!is.null(forms)) {
+  if (!is.null(forms)){
+
     forms_test <- forms %in% unique(m$form_name)
 
-    if (any(!forms_test)) {
+    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")
     }
   }
 
-  if (!is.null(events)) {
+  if (!is.null(events)){
-    arm_event_inst <- REDCapR::redcap_event_instruments(
+    arm_event_inst <- REDCapR::redcap_event_instruments(redcap_uri = uri,
-      redcap_uri = uri,
+                                                        token = token)
-      token = token
-    )
 
     event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
 
-    if (any(!event_test)) {
+    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")
     }
   }
@@ -88,17 +95,28 @@ read_redcap_tables <- function(uri,
   }
 
   # Processing metadata to reflect focused dataset
-  m <- focused_metadata(m, names(d))
+  if (!is.null(c(fields,forms,events))){
+    m <- focused_metadata(m,names(d))
+  }
 
 
-    # Splitting
-    out <- REDCap_split(d,
-      m,
-      forms = split_forms,
-      primary_table_name = ""
-    )
 
-    sanitize_split(out)
+  if (any(generics %in% names(d))){
+  # Splitting
+  l <- REDCap_split(d,
+                    m,
+                    forms = split_forms,
+                    primary_table_name = "")
+
+  # Sanitizing split list by removing completely empty rows apart from colnames
+  # in "generics"
+  sanitize_split(l,c(names(d)[1],generics))
+  } else {
+    # If none of generics are present, the data base is not longitudinal,
+    # and does not have repeatable events, and therefore splitting does not
+    # make sense. But now we handle that as well.
+    d
+  }
 
 }
 

R/redcap_wider.R

@@ -5,70 +5,40 @@ utils::globalVariables(c("redcap_wider",
 #' @title Redcap Wider
 #' @description Converts a list of REDCap data frames from long to wide format.
 #' Handles longitudinal projects, but not yet repeated instruments.
-#' @param data A list of data frames.
+#' @param list A list of data frames.
 #' @param event.glue A dplyr::glue string for repeated events naming
 #' @param inst.glue A dplyr::glue string for repeated instruments naming
 #' @return The list of data frames in wide format.
 #' @export
 #' @importFrom tidyr pivot_wider
 #' @importFrom tidyselect all_of
-#' @importFrom purrr reduce
 #'
 #' @examples
-#' # Longitudinal
+#' list <- list(data.frame(record_id = c(1,2,1,2),
-#' list1 <- list(data.frame(record_id = c(1,2,1,2),
 #' redcap_event_name = c("baseline", "baseline", "followup", "followup"),
 #' age = c(25,26,27,28)),
 #' data.frame(record_id = c(1,2),
 #' redcap_event_name = c("baseline", "baseline"),
 #' gender = c("male", "female")))
-#' redcap_wider(list1)
+#' redcap_wider(list)
-#' # Simpel with two instruments
-#' list2 <- list(data.frame(record_id = c(1,2),
-#' age = c(25,26)),
-#' data.frame(record_id = c(1,2),
-#' gender = c("male", "female")))
-#' redcap_wider(list2)
-#' # Simple with single instrument
-#' list3 <- list(data.frame(record_id = c(1,2),
-#' age = c(25,26)))
-#' redcap_wider(list3)
-#' # Longitudinal with repeatable instruments
-#' list4 <- list(data.frame(record_id = c(1,2,1,2),
-#' redcap_event_name = c("baseline", "baseline", "followup", "followup"),
-#' age = c(25,26,27,28)),
-#' 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(list4)
 redcap_wider <-
-  function(data,
+  function(list,
            event.glue = "{.value}_{redcap_event_name}",
            inst.glue = "{.value}_{redcap_repeat_instance}") {
+    all_names <- unique(do.call(c, lapply(list, names)))
 
-    if (!is.repeated_longitudinal(data)) {
+    if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
-      if (is.list(data)) {
+             all_names)) {
-        if (length(data) == 1) {
+      stop(
-          out <- data[[1]]
+        "The dataset does not include a 'redcap_event_name' variable.
-        } else {
+         redcap_wider only handles projects with repeating instruments or
-          out <- data |> purrr::reduce(dplyr::left_join)
+         longitudinal projects"
-        }
+      )
-      } else if (is.data.frame(data)){
+    }
-        out <- data
-      }
 
+    id.name <- all_names[1]
 
-    } else {
+    l <- lapply(list, function(i) {
-
-    id.name <- do.call(c, lapply(data, names))[[1]]
-
-    l <- lapply(data, function(i) {
       rep_inst <- "redcap_repeat_instrument" %in% names(i)
 
       if (rep_inst) {
@@ -111,17 +81,13 @@ redcap_wider <-
             names_glue = event.glue
           )
           s[colnames(s) != "redcap_event_name"]
-        } else {
+        } else
-          i[colnames(i) != "redcap_event_name"]
+          (i[colnames(i) != "redcap_event_name"])
-          }
+      } else
-      } else {
+        (i)
-        i
-        }
     })
 
-    out <- data.frame(Reduce(f = dplyr::full_join, x = l))
+    ## Additional conditioning is needed to handle repeated instruments.
-    }
 
-    out
+    data.frame(Reduce(f = dplyr::full_join, x = l))
   }
-

R/utils.r

@@ -1,3 +1,5 @@
+
+
 #' focused_metadata
 #' @description Extracts limited metadata for variables in a dataset
 #' @param metadata A dataframe containing metadata
@@ -6,6 +8,7 @@
 #' @export
 #'
 focused_metadata <- function(metadata, vars_in_data) {
+
   if (any(c("tbl_df", "tbl") %in% class(metadata))) {
     metadata <- data.frame(metadata)
   }
@@ -14,11 +17,9 @@ focused_metadata <- function(metadata, vars_in_data) {
   field_type <- grepl(".*[Ff]ield[._][Tt]ype$", names(metadata))
 
   fields <-
-    metadata[
+    metadata[!metadata[, field_type] %in% c("descriptive", "checkbox") &
-      !metadata[, field_type] %in% c("descriptive", "checkbox") &
+               metadata[, field_name] %in% vars_in_data,
-        metadata[, field_name] %in% vars_in_data,
+             field_name]
-      field_name
-    ]
 
   # Process checkbox fields
   if (any(metadata[, field_type] == "checkbox")) {
@@ -28,22 +29,19 @@ focused_metadata <- function(metadata, vars_in_data) {
 
     # Processing
     checkbox_basenames <-
-      metadata[
+      metadata[metadata[, field_type] == "checkbox" &
-        metadata[, field_type] == "checkbox" &
+                 metadata[, field_name] %in% vars_check,
-          metadata[, field_name] %in% vars_check,
+               field_name]
-        field_name
-      ]
 
     fields <- c(fields, checkbox_basenames)
+
   }
 
   # Process instrument status fields
   form_names <-
-    unique(metadata[, grepl(
+    unique(metadata[, grepl(".*[Ff]orm[._][Nn]ame$",
-      ".*[Ff]orm[._][Nn]ame$",
+                            names(metadata))][metadata[, field_name]
-      names(metadata)
+                                              %in% fields])
-    )][metadata[, field_name]
-    %in% fields])
 
   form_complete_fields <- paste0(form_names, "_complete")
 
@@ -56,34 +54,33 @@ focused_metadata <- function(metadata, vars_in_data) {
     timestamp_fields <- timestamps
 
     fields <- c(fields, timestamp_fields)
+
   }
 
   # Process ".*\\.factor" fields supplied by REDCap's export data R script
   if (any(grepl("\\.factor$", vars_in_data))) {
     factor_fields <-
-      do.call(
+      do.call("rbind",
-        "rbind",
+              apply(fields,
-        apply(fields,
+                    1,
-          1,
+                    function(x, y) {
-          function(x, y) {
+                      field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
-            field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
+                      if (any(field_indices))
-            if (any(field_indices)) {
+                        data.frame(
-              data.frame(
+                          field_name = y[field_indices],
-                field_name = y[field_indices],
+                          form_name = x[2],
-                form_name = x[2],
+                          stringsAsFactors = FALSE,
-                stringsAsFactors = FALSE,
+                          row.names = NULL
-                row.names = NULL
+                        )
-              )
+                    },
-            }
+                    y = vars_in_data))
-          },
-          y = vars_in_data
-        )
-      )
 
     fields <- c(fields, factor_fields[, 1])
+
   }
 
   metadata[metadata[, field_name] %in% fields, ]
+
 }
 
 #' clean_redcap_name
@@ -97,18 +94,13 @@ focused_metadata <- function(metadata, vars_in_data) {
 #' @return vector or data frame, same format as input
 #' @export
 #'
-clean_redcap_name <- function(x) {
+clean_redcap_name <- function(x){
-  gsub(
+
-    " ", "_",
+  gsub(" ", "_",
-    gsub(
+       gsub("[' ']$","",
-      "[' ']$", "",
+           gsub("[^a-z0-9' '_]", "",
-      gsub(
+                tolower(x)
-        "[^a-z0-9' '_]", "",
+       )))}
-        tolower(x)
-      )
-    )
-  )
-}
 
 
 #' Sanitize list of data frames
@@ -124,18 +116,15 @@ clean_redcap_name <- function(x) {
 #'
 sanitize_split <- function(l,
                            generic.names = c(
+                             "record_id",
                              "redcap_event_name",
                              "redcap_repeat_instrument",
                              "redcap_repeat_instance"
                            )) {
-  generic.names <- c(get_id_name(l),
-                     generic.names,
-                     paste0(names(l), "_complete"))
-
   lapply(l, function(i) {
     if (ncol(i) > 2) {
       s <- data.frame(i[, !colnames(i) %in% generic.names])
-      i[!apply(is.na(s), MARGIN = 1, FUN = all), ]
+      i[!apply(is.na(s), MARGIN = 1, FUN = all),]
     } else {
       i
     }
@@ -143,19 +132,6 @@ sanitize_split <- function(l,
 }
 
 
-#' Get the id name
-#'
-#' @param data data frame or list
-#'
-#' @return character vector
-get_id_name <- function(data) {
-  if ("list" %in% class(data)) {
-    do.call(c, lapply(data, names))[[1]]
-  } else {
-    names(data)[[1]]
-  }
-}
-
 #' Match fields to forms
 #'
 #' @param metadata A data frame containing field names and form names
@@ -167,23 +143,20 @@ get_id_name <- function(data) {
 #'
 #'
 match_fields_to_form <- function(metadata, vars_in_data) {
+
   metadata <- data.frame(metadata)
 
-  field_form_name <- grepl(".*([Ff]ield|[Ff]orm)[._][Nn]ame$", names(metadata))
+  field_form_name <- grepl(".*([Ff]ield|[Ff]orm)[._][Nn]ame$",names(metadata))
-  field_type <- grepl(".*[Ff]ield[._][Tt]ype$", names(metadata))
+  field_type <- grepl(".*[Ff]ield[._][Tt]ype$",names(metadata))
 
-  fields <- metadata[
+  fields <- metadata[!metadata[,field_type] %in% c("descriptive", "checkbox"),
-    !metadata[, field_type] %in% c("descriptive", "checkbox"),
+                     field_form_name]
-    field_form_name
-  ]
 
   names(fields) <- c("field_name", "form_name")
 
   # Process instrument status fields
-  form_names <- unique(metadata[, grepl(
+  form_names <- unique(metadata[,grepl(".*[Ff]orm[._][Nn]ame$",
-    ".*[Ff]orm[._][Nn]ame$",
+                                       names(metadata))])
-    names(metadata)
-  )])
   form_complete_fields <- data.frame(
     field_name = paste0(form_names, "_complete"),
     form_name = form_names,
@@ -203,65 +176,57 @@ match_fields_to_form <- function(metadata, vars_in_data) {
     )
 
     fields <- rbind(fields, timestamp_fields)
+
   }
 
   # Process checkbox fields
-  if (any(metadata[, field_type] == "checkbox")) {
+  if (any(metadata[,field_type] == "checkbox")) {
-    checkbox_basenames <- metadata[
+    checkbox_basenames <- metadata[metadata[,field_type] == "checkbox",
-      metadata[, field_type] == "checkbox",
+                                   field_form_name]
-      field_form_name
-    ]
 
     checkbox_fields <-
-      do.call(
+      do.call("rbind",
-        "rbind",
+              apply(checkbox_basenames,
-        apply(checkbox_basenames,
+                    1,
-          1,
+                    function(x, y)
-          function(x, y) {
+                      data.frame(
-            data.frame(
+                        field_name =
-              field_name =
+                          y[grepl(paste0("^", x[1], "___((?!\\.factor).)+$"),
-                y[grepl(paste0("^", x[1], "___((?!\\.factor).)+$"),
+                                  y, perl = TRUE)],
-                  y,
+                        form_name = x[2],
-                  perl = TRUE
+                        stringsAsFactors = FALSE,
-                )],
+                        row.names = NULL
-              form_name = x[2],
+                      ),
-              stringsAsFactors = FALSE,
+                    y = vars_in_data))
-              row.names = NULL
-            )
-          },
-          y = vars_in_data
-        )
-      )
 
     fields <- rbind(fields, checkbox_fields)
+
   }
 
   # Process ".*\\.factor" fields supplied by REDCap's export data R script
   if (any(grepl("\\.factor$", vars_in_data))) {
     factor_fields <-
-      do.call(
+      do.call("rbind",
-        "rbind",
+              apply(fields,
-        apply(fields,
+                    1,
-          1,
+                    function(x, y) {
-          function(x, y) {
+                      field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
-            field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
+                      if (any(field_indices))
-            if (any(field_indices)) {
+                        data.frame(
-              data.frame(
+                          field_name = y[field_indices],
-                field_name = y[field_indices],
+                          form_name = x[2],
-                form_name = x[2],
+                          stringsAsFactors = FALSE,
-                stringsAsFactors = FALSE,
+                          row.names = NULL
-                row.names = NULL
+                        )
-              )
+                    },
-            }
+                    y = vars_in_data))
-          },
-          y = vars_in_data
-        )
-      )
 
     fields <- rbind(fields, factor_fields)
+
   }
 
   fields
+
 }
 
 #' Split a data frame into separate tables for each form
@@ -291,12 +256,10 @@ match_fields_to_form <- function(metadata, vars_in_data) {
 #'
 #' # Create the fields
 #' fields <- matrix(
-#'   c(
+#'   c("form_a_name", "form_a",
-#'     "form_a_name", "form_a",
 #'     "form_a_age", "form_a",
 #'     "form_b_name", "form_b",
-#'     "form_b_gender", "form_b"
+#'     "form_b_gender", "form_b"),
-#'   ),
 #'   ncol = 2, byrow = TRUE
 #' )
 #'
@@ -306,17 +269,14 @@ split_non_repeating_forms <-
   function(table, universal_fields, fields) {
     forms <- unique(fields[[2]])
 
-    x <- lapply(
+    x <- lapply(forms,
-      forms,
+                function (x) {
-      function(x) {
+                  table[names(table) %in% union(universal_fields,
-        table[names(table) %in% union(
+                                                fields[fields[, 2] == x, 1])]
-          universal_fields,
+                })
-          fields[fields[, 2] == x, 1]
-        )]
-      }
-    )
 
     structure(x, names = forms)
+
   }
 
 
@@ -335,7 +295,7 @@ split_non_repeating_forms <-
 #'
 #' @examples
 #' test <- c("12 months follow-up", "3 steps", "mRS 6 weeks", "Counting to 231 now")
-#' strsplitx(test, "[0-9]", type = "around")
+#' strsplitx(test,"[0-9]",type="around")
 strsplitx <- function(x,
                       split,
                       type = "classic",
@@ -346,33 +306,26 @@ strsplitx <- function(x,
     out <- base::strsplit(x = x, split = split, perl = perl, ...)
   } else if (type == "before") {
     # split before the delimiter and keep it
-    out <- base::strsplit(
+    out <- base::strsplit(x = x,
-      x = x,
+                          split = paste0("(?<=.)(?=", split, ")"),
-      split = paste0("(?<=.)(?=", split, ")"),
+                          perl = TRUE,
-      perl = TRUE,
+                          ...)
-      ...
-    )
   } else if (type == "after") {
     # split after the delimiter and keep it
-    out <- base::strsplit(
+    out <- base::strsplit(x = x,
-      x = x,
+                          split = paste0("(?<=", split, ")"),
-      split = paste0("(?<=", split, ")"),
+                          perl = TRUE,
-      perl = TRUE,
+                          ...)
-      ...
-    )
   } else if (type == "around") {
     # split around the defined delimiter
 
-    out <- base::strsplit(gsub(
+    out <- base::strsplit(gsub("~~", "~", # Removes double ~
-      "~~", "~", # Removes double ~
+                               gsub("^~", "", # Removes leading ~
-      gsub(
+                                    gsub(
-        "^~", "", # Removes leading ~
+                                      # Splits and inserts ~ at all delimiters
-        gsub(
+                                      paste0("(", split, ")"), "~\\1~", x
-          # Splits and inserts ~ at all delimiters
+                                    ))), "~")
-          paste0("(", split, ")"), "~\\1~", x
+
-        )
-      )
-    ), "~")
   } else {
     # wrong type input
     stop("type must be 'classic', 'after', 'before' or 'around'!")
@@ -392,36 +345,37 @@ strsplitx <- function(x,
 #' @export
 #'
 #' @examples
-#' d2w(c(2:8, 21))
+#' d2w(c(2:8,21))
-#' d2w(data.frame(2:7, 3:8, 1), lang = "da", neutrum = TRUE)
+#' d2w(data.frame(2:7,3:8,1),lang="da",neutrum=TRUE)
 #'
 #' ## If everything=T, also larger numbers are reduced.
 #' ## Elements in the list are same length as input
-#' d2w(list(2:8, c(2, 6, 4, 23), 2), everything = TRUE)
+#' d2w(list(2:8,c(2,6,4,23),2), everything=TRUE)
 #'
-d2w <- function(x, lang = "en", neutrum = FALSE, everything = FALSE) {
+d2w <- function(x, lang = "en", neutrum=FALSE, everything=FALSE) {
+
   # In Danish the written 1 depends on the counted word
   if (neutrum) nt <- "t" else nt <- "n"
 
   # A sapply() call with nested lapply() to handle vectors, data.frames and lists
   convert <- function(x, lang, neutrum) {
-    zero_nine <- data.frame(
+    zero_nine = data.frame(
       num = 0:9,
       en = c(
-        "zero",
+        'zero',
-        "one",
+        'one',
-        "two",
+        'two',
-        "three",
+        'three',
-        "four",
+        'four',
-        "five",
+        'five',
-        "six",
+        'six',
-        "seven",
+        'seven',
-        "eight",
+        'eight',
-        "nine"
+        'nine'
       ),
       da = c(
         "nul",
-        paste0("e", nt),
+        paste0("e",nt),
         "to",
         "tre",
         "fire",
@@ -447,45 +401,18 @@ d2w <- function(x, lang = "en", neutrum = FALSE, everything = FALSE) {
   # Also converts numbers >9 to single digits and writes out
   # Uses strsplitx()
   if (everything) {
-    out <- sapply(x, function(y) {
+    out <- sapply(x,function(y){
-      do.call(c, lapply(y, function(z) {
+      do.call(c,lapply(y,function(z){
-        v <- strsplitx(z, "[0-9]", type = "around")
+        v <- strsplitx(z,"[0-9]",type="around")
-        Reduce(paste, sapply(v, convert, lang = lang, neutrum = neutrum))
+        Reduce(paste,sapply(v,convert,lang = lang, neutrum = neutrum))
       }))
+
     })
   } else {
-    out <- sapply(x, convert, lang = lang, neutrum = neutrum)
+  out <- sapply(x,convert,lang = lang, neutrum = neutrum)
   }
 
   if (is.data.frame(x)) out <- data.frame(out)
 
   out
 }
-
-#' Test if repeatable or longitudinal
-#'
-#' @param data data set
-#' @param generics default is "redcap_event_name", "redcap_repeat_instrument"
-#' and "redcap_repeat_instance"
-#'
-#' @return logical
-#' @examples
-#' is.repeated_longitudinal(c("record_id", "age", "record_id", "gender"))
-#' is.repeated_longitudinal(redcapcast_data)
-#' is.repeated_longitudinal(list(redcapcast_data))
-is.repeated_longitudinal <- function(data, generics = c(
-                                       "redcap_event_name",
-                                       "redcap_repeat_instrument",
-                                       "redcap_repeat_instance"
-                                     )) {
-  if ("list" %in% class(data)) {
-    names <- data |>
-      lapply(names) |>
-      purrr::list_c()
-  } else if ("data.frame" %in% class(data)) {
-    names <- names(data)
-  } else if ("character" %in% class(data)) {
-    names <- data
-  }
-  any(generics %in% names)
-}

data-raw/redcapcast_data.R

@@ -3,10 +3,6 @@
 redcapcast_data <- REDCapR::redcap_read(redcap_uri = keyring::key_get("DB_URI"),
                                         token = keyring::key_get("cast_api"),
                                         raw_or_label = "label"
-                                        )$data |> dplyr::tibble()
+                                        )$data
-
-# redcapcast_data <- easy_redcap(project.name = "redcapcast_pacakge",
-#                                uri = keyring::key_get("DB_URI"),
-#                                widen.data = FALSE)
 
 usethis::use_data(redcapcast_data, overwrite = TRUE)

man/d2w.Rd

@@ -22,11 +22,11 @@ returns characters in same format as input
 Convert single digits to words
 }
 \examples{
-d2w(c(2:8, 21))
+d2w(c(2:8,21))
-d2w(data.frame(2:7, 3:8, 1), lang = "da", neutrum = TRUE)
+d2w(data.frame(2:7,3:8,1),lang="da",neutrum=TRUE)
 
 ## If everything=T, also larger numbers are reduced.
 ## Elements in the list are same length as input
-d2w(list(2:8, c(2, 6, 4, 23), 2), everything = TRUE)
+d2w(list(2:8,c(2,6,4,23),2), everything=TRUE)
 
 }

man/easy_redcap.Rd

@@ -8,7 +8,7 @@ easy_redcap(project.name, widen.data = TRUE, uri, ...)
 }
 \arguments{
 \item{project.name}{The name of the current project (for key storage with
-`keyring::key_set()`, using the default keyring)}
+`keyring::key_set()`)}
 
 \item{widen.data}{argument to widen the exported data}
 

man/get_id_name.Rd

@@ -1,17 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.r
-\name{get_id_name}
-\alias{get_id_name}
-\title{Get the id name}
-\usage{
-get_id_name(data)
-}
-\arguments{
-\item{data}{data frame or list}
-}
-\value{
-character vector
-}
-\description{
-Get the id name
-}

man/is.repeated_longitudinal.Rd

@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.r
-\name{is.repeated_longitudinal}
-\alias{is.repeated_longitudinal}
-\title{Test if repeatable or longitudinal}
-\usage{
-is.repeated_longitudinal(
-  data,
-  generics = c("redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
-)
-}
-\arguments{
-\item{data}{data set}
-
-\item{generics}{default is "redcap_event_name", "redcap_repeat_instrument"
-and "redcap_repeat_instance"}
-}
-\value{
-logical
-}
-\description{
-Test if repeatable or longitudinal
-}
-\examples{
-is.repeated_longitudinal(c("record_id", "age", "record_id", "gender"))
-is.repeated_longitudinal(redcapcast_data)
-is.repeated_longitudinal(list(redcapcast_data))
-}

man/read_redcap_tables.Rd

@@ -12,7 +12,8 @@ read_redcap_tables(
   events = NULL,
   forms = NULL,
   raw_or_label = "label",
-  split_forms = "all"
+  split_forms = "all",
+  generics = c("redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
 )
 }
 \arguments{

man/redcap_wider.Rd

@@ -5,13 +5,13 @@
 \title{Redcap Wider}
 \usage{
 redcap_wider(
-  data,
+  list,
   event.glue = "{.value}_{redcap_event_name}",
   inst.glue = "{.value}_{redcap_repeat_instance}"
 )
 }
 \arguments{
-\item{data}{A list of data frames.}
+\item{list}{A list of data frames.}
 
 \item{event.glue}{A dplyr::glue string for repeated events naming}
 
@@ -25,36 +25,11 @@ Converts a list of REDCap data frames from long to wide format.
 Handles longitudinal projects, but not yet repeated instruments.
 }
 \examples{
-# Longitudinal
+list <- list(data.frame(record_id = c(1,2,1,2),
-list1 <- list(data.frame(record_id = c(1,2,1,2),
 redcap_event_name = c("baseline", "baseline", "followup", "followup"),
 age = c(25,26,27,28)),
 data.frame(record_id = c(1,2),
 redcap_event_name = c("baseline", "baseline"),
 gender = c("male", "female")))
-redcap_wider(list1)
+redcap_wider(list)
-# Simpel with two instruments
-list2 <- list(data.frame(record_id = c(1,2),
-age = c(25,26)),
-data.frame(record_id = c(1,2),
-gender = c("male", "female")))
-redcap_wider(list2)
-# Simple with single instrument
-list3 <- list(data.frame(record_id = c(1,2),
-age = c(25,26)))
-redcap_wider(list3)
-# Longitudinal with repeatable instruments
-list4 <- list(data.frame(record_id = c(1,2,1,2),
-redcap_event_name = c("baseline", "baseline", "followup", "followup"),
-age = c(25,26,27,28)),
-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(list4)
 }

man/sanitize_split.Rd

@@ -6,7 +6,7 @@
 \usage{
 sanitize_split(
   l,
-  generic.names = c("redcap_event_name", "redcap_repeat_instrument",
+  generic.names = c("record_id", "redcap_event_name", "redcap_repeat_instrument",
     "redcap_repeat_instance")
 )
 }

man/split_non_repeating_forms.Rd

@@ -36,12 +36,10 @@ universal_fields <- c("id")
 
 # Create the fields
 fields <- matrix(
-  c(
+  c("form_a_name", "form_a",
-    "form_a_name", "form_a",
     "form_a_age", "form_a",
     "form_b_name", "form_b",
-    "form_b_gender", "form_b"
+    "form_b_gender", "form_b"),
-  ),
   ncol = 2, byrow = TRUE
 )
 

man/strsplitx.Rd

@@ -26,5 +26,5 @@ easing the split around the defined delimiter, see example.
 }
 \examples{
 test <- c("12 months follow-up", "3 steps", "mRS 6 weeks", "Counting to 231 now")
-strsplitx(test, "[0-9]", type = "around")
+strsplitx(test,"[0-9]",type="around")
 }

test-data/test_splitr/debug.r

@@ -3,11 +3,10 @@
 #devtools::install_github("pegeler/REDCapRITS/R@longitudinal-data")
 
 # Debugging reading in longitudinal datasets ------------------------------
-# setwd(here::here(""))
 
 # Reading in the files
 file_paths <- file.path(
-  "test-data/test_splitr",
+  "../test-data/test_splitr/",
   c(
     records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
     metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"

vignettes/Introduction.Rmd

@@ -35,7 +35,7 @@ redcapcast_meta |> gt::gt()
 list <-
   REDCap_split(records = redcapcast_data,
                            metadata = redcapcast_meta,
-                           forms = "repeating")|> sanitize_split()
+                           forms = "repeating")
 str(list)
 ```
 
@@ -43,7 +43,7 @@ str(list)
 list <-
   REDCap_split(records = redcapcast_data,
                            metadata = redcapcast_meta,
-                           forms = "all") |> sanitize_split()
+                           forms = "all")
 str(list)
 ```
 
@@ -60,7 +60,7 @@ The function works very similar to the `REDCapR::redcap_read()` in allowing to s
 ## Pivotting to wider format
 
 ```{r}
-redcap_wider(list) |> str()
+# redcap_wider(ds)
 ```