cleaning and fixes for a minor release

R/REDCap_split.r

@@ -80,7 +80,7 @@
 #'     \item \code{'all'}: a data.frame for each instrument, regardless of
 #'     whether it is a repeating instrument or not.
 #'   }
-#' @include process_user_input.r utils.r
+#' @include process_user_input.R utils.R
 #' @export
 REDCap_split <- function(records,
                          metadata,

R/ds2dd_detailed.R

@@ -1,5 +1,4 @@
 utils::globalVariables(c(
-  "stats::setNames",
   "field_name",
   "field_type",
   "select_choices_or_calculations",
@@ -247,7 +246,7 @@ 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 |> numchar2fct() |> ds2dd_detailed(add.auto.id = TRUE)
 #'
 #' ## Using column name suffix to carry form name
 #' data <- iris |>
@@ -269,6 +268,10 @@ ds2dd_detailed <- function(data,
                            metadata = names(REDCapCAST::redcapcast_meta),
                            convert.logicals = TRUE) {
 
+  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
@@ -294,7 +297,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 +315,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"
@@ -425,7 +430,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
   )
 

R/easy_redcap.R

@@ -28,6 +28,9 @@ get_api_key <- function(key.name, ...) {
 #' \link[keyring]{key_set}, using the default keyring)
 #' @param widen.data argument to widen the exported data
 #' @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 ... arguments passed on to \link[REDCapCAST]{read_redcap_tables}.
 #'
 #' @return data.frame or list depending on widen.data
@@ -35,16 +38,22 @@ 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,
+                        widen.data = TRUE,
+                        uri,
+                        raw_or_label = "both",
+                        ...) {
+  key <- get_api_key(
+    key.name = paste0(project.name, "_REDCAP_API"),
+    prompt = "Provide REDCap API key:"
+  )
 
   out <- read_redcap_tables(
     uri = uri,
     token = key,
-    raw_or_label = "both",
+    raw_or_label = raw_or_label,
     ...
   )
 

R/read_redcap_tables.R

@@ -31,7 +31,7 @@
 #'
 #' @return list of instruments
 #' @importFrom REDCapR redcap_metadata_read redcap_read redcap_event_instruments
-#' @include utils.r
+#' @include utils.R
 #' @export
 #'
 #' @examples

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