linting

.lintr

@@ -0,0 +1,7 @@
+linters: linters_with_defaults(
+    commented_code_linter = NULL
+  )
+encoding: "UTF-8"
+exclusions: list(
+    "drafting/"
+  )

R/REDCap_split.r

@@ -26,17 +26,17 @@
 #' records <- postForm(
 #'   uri = api_url, # Supply your site-specific URI
 #'   token = api_token, # Supply your own API token
-#'   content = 'record',
+#'   content = "record",
-#'   format = 'json',
+#'   format = "json",
-#'   returnFormat = 'json'
+#'   returnFormat = "json"
 #' )
 #'
 #' # Get the metadata
 #' metadata <- postForm(
 #'   uri = api_url, # Supply your site-specific URI
 #'   token = api_token, # Supply your own API token
-#'   content = 'metadata',
+#'   content = "metadata",
-#'   format = 'json'
+#'   format = "json"
 #' )
 #'
 #' # Convert exported JSON strings into a list of data.frames
@@ -49,7 +49,8 @@
 #'
 #' # Get the metadata
 #' metadata <- read.csv(
-#' "/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv")
+#'   "/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv"
+#' )
 #'
 #' # Split the tables
 #' REDCapRITS::REDCap_split(records, metadata)
@@ -86,7 +87,6 @@ REDCap_split <- function(records,
                          metadata,
                          primary_table_name = "",
                          forms = c("repeating", "all")) {
-
   # Process user input
   records <- process_user_input(records)
   metadata <-
@@ -96,8 +96,9 @@ REDCap_split <- function(records,
   vars_in_data <- names(records)
 
   # Process repeat instrument names to match the redcap naming
-  if (is_repeated_longitudinal(records)){
+  if (is_repeated_longitudinal(records)) {
-  records$redcap_repeat_instrument <- clean_redcap_name(records$redcap_repeat_instrument)
+    records$redcap_repeat_instrument <-
+      clean_redcap_name(records$redcap_repeat_instrument)
 
     # Match arg for forms
     forms <- match.arg(forms, c("repeating", "all"))
@@ -145,7 +146,8 @@ REDCap_split <- function(records,
     # Variables to be at the beginning of each repeating instrument
     repeat_instrument_fields <- grep("^redcap_repeat.*",
       vars_in_data,
-                                     value = TRUE)
+      value = TRUE
+    )
 
     # Identify the subtables in the data
     subtables <- unique(records$redcap_repeat_instrument)
@@ -169,35 +171,36 @@ REDCap_split <- function(records,
     # Delete the variables that are not relevant
     for (i in names(out)) {
       if (i == primary_table_name) {
-        out_fields <- which(vars_in_data %in% c(universal_fields,
+        out_fields <- which(vars_in_data %in% c(
+          universal_fields,
           fields[!fields[, 2] %in%
-                                                         subtables, 1]))
+            subtables, 1]
+        ))
         out[[primary_table_index]] <-
           out[[primary_table_index]][out_fields]
-
       } else {
-        out_fields <- which(vars_in_data %in% c(universal_fields,
+        out_fields <- which(vars_in_data %in% c(
+          universal_fields,
           repeat_instrument_fields,
-                                                fields[fields[, 2] == i, 1]))
+          fields[fields[, 2] == i, 1]
+        ))
         out[[i]] <- out[[i]][out_fields]
-
       }
-
     }
 
     if (forms == "all") {
-      out <- c(split_non_repeating_forms(out[[primary_table_index]],
+      out <- c(
+        split_non_repeating_forms(
+          out[[primary_table_index]],
           universal_fields,
-                                         fields[!fields[, 2] %in% subtables, ]),
+          fields[!fields[, 2] %in% subtables, ]
-               out[-primary_table_index])
+        ),
-
+        out[-primary_table_index]
+      )
     }
-
   } else {
     out <- split_non_repeating_forms(records, universal_fields, fields)
-
   }
 
   out
 }
-

R/ds2dd.R

@@ -41,7 +41,7 @@ ds2dd <-
     dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds)))
     colnames(dd) <- metadata
 
-    if (is.character(record.id) & !record.id %in% colnames(ds)) {
+    if (is.character(record.id) && !record.id %in% colnames(ds)) {
       stop("Provided record.id is not a variable name in provided data set.")
     }
 
@@ -59,7 +59,7 @@ ds2dd <-
     dd[, "field_name"] <-
       c(field.name[colsel], field.name[!colsel])
 
-    if (length(form.name) > 1 & length(form.name) != ncol(ds)) {
+    if (length(form.name) > 1 && length(form.name) != ncol(ds)) {
       stop(
         "Provided form.name should be of length 1 (value is reused) or equal
         length as number of variables in data set."
@@ -67,7 +67,7 @@ ds2dd <-
     }
     dd[, "form_name"] <- form.name
 
-    if (length(field.type) > 1 & length(field.type) != ncol(ds)) {
+    if (length(field.type) > 1 && length(field.type) != ncol(ds)) {
       stop(
         "Provided field.type should be of length 1 (value is reused) or equal
         length as number of variables in data set."

R/ds2dd_detailed.R

@@ -1,4 +1,9 @@
-utils::globalVariables(c(  "stats::setNames",  "field_name",  "field_type",  "select_choices_or_calculations"))
+utils::globalVariables(c(
+  "stats::setNames",
+  "field_name",
+  "field_type",
+  "select_choices_or_calculations"
+))
 #' Try at determining which are true time only variables
 #'
 #' @description
@@ -18,10 +23,15 @@ utils::globalVariables(c(  "stats::setNames",  "field_name",  "field_type",  "se
 #' @examples
 #' data <- redcapcast_data
 #' data |> guess_time_only_filter()
-#' data |> guess_time_only_filter(validate = TRUE) |> lapply(head)
+#' data |>
-guess_time_only_filter <- function(data, validate = FALSE, sel.pos = "[Tt]i[d(me)]", sel.neg = "[Dd]at[eo]") {
+#'   guess_time_only_filter(validate = TRUE) |>
+#'   lapply(head)
+guess_time_only_filter <- function(data,
+                                   validate = FALSE,
+                                   sel.pos = "[Tt]i[d(me)]",
+                                   sel.neg = "[Dd]at[eo]") {
   datetime_nms <- data |>
-    lapply(\(x)any(c("POSIXct","hms") %in% class(x))) |>
+    lapply(\(x) any(c("POSIXct", "hms") %in% class(x))) |>
     (\(x) names(data)[do.call(c, x)])()
 
   time_only_log <- datetime_nms |> (\(x) {
@@ -42,12 +52,8 @@ guess_time_only_filter <- function(data, validate = FALSE, sel.pos = "[Tt]i[d(me
   }
 }
 
-#' Correction based on time_only_filter function. Introduces new class for easier
+#' Correction based on time_only_filter function
-#' validation labelling.
 #'
-#' @description
-#' Dependens on the data class "hms" introduced with
-#' `guess_time_only_filter()` and converts these
 #'
 #' @param data data set
 #' @param ... arguments passed on to `guess_time_only_filter()`
@@ -119,8 +125,8 @@ hms2character <- function(data) {
 #' data set (imported .dta file with `haven::read_dta()`. Default is "label"
 #' @param field.validation manually specify field validation(s). Vector of
 #' length 1 or ncol(data). Default is NULL and `levels()` are used for factors
-#' or attribute `factor.labels.attr` for haven_labelled data set (imported .dta file with
+#' or attribute `factor.labels.attr` for haven_labelled data set (imported .dta
-#' `haven::read_dta()`).
+#' file with `haven::read_dta()`).
 #' @param metadata redcap metadata headings. Default is
 #' REDCapCAST:::metadata_names.
 #' @param validate.time Flag to validate guessed time columns
@@ -144,7 +150,7 @@ ds2dd_detailed <- function(data,
                            form.name = NULL,
                            field.type = NULL,
                            field.label = NULL,
-                           field.label.attr ="label",
+                           field.label.attr = "label",
                            field.validation = NULL,
                            metadata = metadata_names,
                            validate.time = FALSE,
@@ -164,7 +170,8 @@ ds2dd_detailed <- function(data,
   }
 
   if (lapply(data, haven::is.labelled) |> (\(x)do.call(c, x))() |> any()) {
-    message("Data seems to be imported with haven from a Stata (.dta) file and will be treated as such.")
+    message("Data seems to be imported with haven from a Stata (.dta) file and
+            will be treated as such.")
     data.source <- "dta"
   } else {
     data.source <- ""
@@ -172,18 +179,25 @@ ds2dd_detailed <- function(data,
 
   ## data classes
 
-  ### Only keeps the first class, as time fields (POSIXct/POSIXt) has two classes
+  ### Only keeps the first class, as time fields (POSIXct/POSIXt) has two
+  ### classes
   if (data.source == "dta") {
     data_classes <-
       data |>
       haven::as_factor() |>
-      time_only_correction(sel.pos = time.var.sel.pos, sel.neg = time.var.sel.neg) |>
+      time_only_correction(
+        sel.pos = time.var.sel.pos,
+        sel.neg = time.var.sel.neg
+      ) |>
       lapply(\(x)class(x)[1]) |>
       (\(x)do.call(c, x))()
   } else {
     data_classes <-
       data |>
-      time_only_correction(sel.pos = time.var.sel.pos, sel.neg = time.var.sel.neg) |>
+      time_only_correction(
+        sel.pos = time.var.sel.pos,
+        sel.neg = time.var.sel.neg
+      ) |>
       lapply(\(x)class(x)[1]) |>
       (\(x)do.call(c, x))()
   }
@@ -204,7 +218,7 @@ ds2dd_detailed <- function(data,
   if (is.null(form.name)) {
     dd$form_name <- "data"
   } else {
-    if (length(form.name) == 1 | length(form.name) == nrow(dd)) {
+    if (length(form.name) == 1 || length(form.name) == nrow(dd)) {
       dd$form_name <- form.name
     } else {
       stop("Length of supplied 'form.name' has to be one (1) or ncol(data).")
@@ -229,9 +243,11 @@ ds2dd_detailed <- function(data,
     }
 
     dd <-
-      dd |> dplyr::mutate(field_label = dplyr::if_else(is.na(label), field_name, label))
+      dd |> dplyr::mutate(field_label = dplyr::if_else(is.na(label),
+        field_name, label
+      ))
   } else {
-    if (length(field.label) == 1 | length(field.label) == nrow(dd)) {
+    if (length(field.label) == 1 || length(field.label) == nrow(dd)) {
       dd$field_label <- field.label
     } else {
       stop("Length of supplied 'field.label' has to be one (1) or ncol(data).")
@@ -245,9 +261,11 @@ 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::if_else(data_classes == "factor",
+        "radio", field_type
+      ))
   } else {
-    if (length(field.type) == 1 | length(field.type) == nrow(dd)) {
+    if (length(field.type) == 1 || length(field.type) == nrow(dd)) {
       dd$field_type <- field.type
     } else {
       stop("Length of supplied 'field.type' has to be one (1) or ncol(data).")
@@ -271,10 +289,11 @@ ds2dd_detailed <- function(data,
         )
       )
   } else {
-    if (length(field.validation) == 1 | length(field.validation) == nrow(dd)) {
+    if (length(field.validation) == 1 || length(field.validation) == nrow(dd)) {
       dd$text_validation_type_or_show_slider_number <- field.validation
     } else {
-      stop("Length of supplied 'field.validation' has to be one (1) or ncol(data).")
+      stop("Length of supplied 'field.validation'
+           has to be one (1) or ncol(data).")
     }
   }
 
@@ -300,7 +319,13 @@ ds2dd_detailed <- function(data,
           ## Re-factors to avoid confusion with missing levels
           ## Assumes alle relevant levels are represented in the data
           re_fac <- factor(x)
-          paste(paste(unique(as.numeric(re_fac)), levels(re_fac), sep = ", "), collapse = " | ")
+          paste(
+            paste(unique(as.numeric(re_fac)),
+              levels(re_fac),
+              sep = ", "
+            ),
+            collapse = " | "
+          )
         } else {
           NA
         }
@@ -319,7 +344,10 @@ ds2dd_detailed <- function(data,
 
   list(
     data = data |>
-      time_only_correction(sel.pos = time.var.sel.pos, sel.neg = time.var.sel.neg) |>
+      time_only_correction(
+        sel.pos = time.var.sel.pos,
+        sel.neg = time.var.sel.neg
+      ) |>
       hms2character() |>
       (\(x)stats::setNames(x, tolower(names(x))))(),
     meta = dd
@@ -333,11 +361,16 @@ ds2dd_detailed <- function(data,
 #' @param ls output list from `ds2dd_detailed()`
 #'
 #' @return list with `REDCapR::redcap_write()` results
-mark_complete <- function(upload, ls){
+mark_complete <- function(upload, ls) {
   data <- ls$data
   meta <- ls$meta
   forms <- unique(meta$form_name)
-  cbind(data[[1]][data[[1]] %in% upload$affected_ids],
+  cbind(
-        data.frame(matrix(2,ncol=length(forms),nrow=upload$records_affected_count))) |>
+    data[[1]][data[[1]] %in% upload$affected_ids],
-    stats::setNames(c(names(data)[1],paste0(forms,"_complete")))
+    data.frame(matrix(2,
+      ncol = length(forms),
+      nrow = upload$records_affected_count
+    ))
+  ) |>
+    stats::setNames(c(names(data)[1], paste0(forms, "_complete")))
 }

R/easy_redcap.R

@@ -1,4 +1,3 @@
-
 #' Retrieve project API key if stored, if not, set and retrieve
 #'
 #' @param key.name character vector of key name
@@ -26,7 +25,7 @@ get_api_key <- function(key.name) {
 #'
 #' @return data.frame or list depending on widen.data
 #' @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(
@@ -35,7 +34,7 @@ easy_redcap <- function(project.name, widen.data=TRUE, uri, ...) {
     ...
   )
 
-  if (widen.data){
+  if (widen.data) {
     out <- out |> redcap_wider()
   }
 

R/mtcars_redcap.R

@@ -20,4 +20,3 @@
 #' }
 #' @usage data(mtcars_redcap)
 "mtcars_redcap"
-

R/process_user_input.r

@@ -1,4 +1,4 @@
-process_user_input <- function (x) {
+process_user_input <- function(x) {
   UseMethod("process_user_input", x)
 }
 
@@ -30,10 +30,8 @@ process_user_input.character <- function(x, ...) {
   }
 
   jsonlite::fromJSON(x)
-
 }
 
 process_user_input.response <- function(x, ...) {
   process_user_input(rawToChar(x$content))
-
 }

R/read_redcap_instrument.R

@@ -1,11 +1,13 @@
-#' Convenience function to download complete instrument, using token storage in keyring.
+#' Convenience function to download complete instrument, using token storage
+#' in keyring.
 #'
 #' @param key key name in standard keyring for token retrieval.
 #' @param uri REDCap database API uri
 #' @param instrument instrument name
 #' @param raw_or_label raw or label passed to `REDCapR::redcap_read()`
 #' @param id_name id variable name. Default is "record_id".
-#' @param records specify the records to download. Index numbers. Numeric vector.
+#' @param records specify the records to download. Index numbers.
+#' Numeric vector.
 #'
 #' @return data.frame
 #' @export

R/read_redcap_tables.R

@@ -38,7 +38,8 @@ read_redcap_tables <- function(uri,
     fields_test <- fields %in% unique(m$field_name)
 
     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")
     }
   }
@@ -48,7 +49,8 @@ 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")
     }
   }
@@ -62,7 +64,8 @@ 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")
     }
   }
@@ -97,7 +100,4 @@ read_redcap_tables <- function(uri,
   )
 
   sanitize_split(out)
-
 }
-
-

R/redcap_wider.R

@@ -1,6 +1,8 @@
-utils::globalVariables(c("redcap_wider",
+utils::globalVariables(c(
-"event.glue",
+  "redcap_wider",
-"inst.glue"))
+  "event.glue",
+  "inst.glue"
+))
 
 #' @title Redcap Wider
 #' @description Converts a list of REDCap data frames from long to wide format.
@@ -16,42 +18,65 @@ utils::globalVariables(c("redcap_wider",
 #'
 #' @examples
 #' # Longitudinal
-#' list1 <- 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)),
+#'     age = c(25, 26, 27, 28)
-#' data.frame(record_id = c(1,2),
+#'   ),
+#'   data.frame(
+#'     record_id = c(1, 2),
 #'     redcap_event_name = c("baseline", "baseline"),
-#' gender = c("male", "female")))
+#'     gender = c("male", "female")
+#'   )
+#' )
 #' redcap_wider(list1)
 #' # Simpel with two instruments
-#' list2 <- list(data.frame(record_id = c(1,2),
+#' list2 <- list(
-#' age = c(25,26)),
+#'   data.frame(
-#' data.frame(record_id = c(1,2),
+#'     record_id = c(1, 2),
-#' gender = c("male", "female")))
+#'     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),
+#' list3 <- list(data.frame(
-#' age = c(25,26)))
+#'   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),
+#' 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)),
+#'     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",
+#'   data.frame(
-#' "baseline", "baseline", "followup", "followup"),
+#'     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),
+#'     redcap_repeat_instance = c(1, 2, 1, 2, 1, 2, 1, 2),
-#' dist = c(40, 32, 25, 33, 28, 24, 23, 36)),
+#'     dist = c(40, 32, 25, 33, 28, 24, 23, 36)
-#' data.frame(record_id = c(1,2),
+#'   ),
+#'   data.frame(
+#'     record_id = c(1, 2),
 #'     redcap_event_name = c("baseline", "baseline"),
-#' gender = c("male", "female")))
+#'     gender = c("male", "female")
-#'redcap_wider(list4)
+#'   )
+#' )
+#' redcap_wider(list4)
 redcap_wider <-
   function(data,
            event.glue = "{.value}_{redcap_event_name}",
            inst.glue = "{.value}_{redcap_repeat_instance}") {
-
     if (!is_repeated_longitudinal(data)) {
       if (is.list(data)) {
         if (length(data) == 1) {
@@ -59,13 +84,10 @@ redcap_wider <-
         } else {
           out <- data |> purrr::reduce(dplyr::left_join)
         }
-      } else if (is.data.frame(data)){
+      } else if (is.data.frame(data)) {
         out <- data
       }
-
-
     } else {
-
       id.name <- do.call(c, lapply(data, names))[[1]]
 
       l <- lapply(data, function(i) {
@@ -124,4 +146,3 @@ redcap_wider <-
 
     out
   }
-

R/redcapcast_data.R

@@ -33,5 +33,3 @@
 #' }
 #' @usage data(redcapcast_data)
 "redcapcast_data"
-
-

R/redcapcast_meta.R

@@ -9,9 +9,11 @@
 #'   \item{section_header}{section_header, character}
 #'   \item{field_type}{field_type, character}
 #'   \item{field_label}{field_label, character}
-#'   \item{select_choices_or_calculations}{select_choices_or_calculations, character}
+#'   \item{select_choices_or_calculations}
+#'   {select_choices_or_calculations, character}
 #'   \item{field_note}{field_note, character}
-#'   \item{text_validation_type_or_show_slider_number}{text_validation_type_or_show_slider_number, character}
+#'   \item{text_validation_type_or_show_slider_number}
+#'   {text_validation_type_or_show_slider_number, character}
 #'   \item{text_validation_min}{text_validation_min, character}
 #'   \item{text_validation_max}{text_validation_max, character}
 #'   \item{identifier}{identifier, character}
@@ -25,5 +27,3 @@
 #' }
 #' @usage data(redcapcast_meta)
 "redcapcast_meta"
-
-

R/shiny_cast.R

@@ -14,8 +14,7 @@ server_factory <- function() {
 #' @export
 ui_factory <- function() {
   # require(ggplot2)
-source(here::here("app/ui.R"))
+  source(here::here("app/ui.R"))
-
 }
 
 #' Launch the included Shiny-app for database casting and upload
@@ -46,7 +45,7 @@ shiny_cast <- function() {
 #' @examples
 #' # deploy_shiny
 #'
-deploy_shiny <- function(path=here::here("app/"), name.app="shiny_cast"){
+deploy_shiny <- function(path = here::here("app/"), name.app = "shiny_cast") {
   # Connecting
   rsconnect::setAccountInfo(
     name = "cognitiveindex",
@@ -55,5 +54,5 @@ deploy_shiny <- function(path=here::here("app/"), name.app="shiny_cast"){
   )
 
   # Deploying
-  rsconnect::deployApp(appDir = path,lint = TRUE,appName = name.app,)
+  rsconnect::deployApp(appDir = path, lint = TRUE, appName = name.app, )
 }

R/utils.r

@@ -128,9 +128,11 @@ sanitize_split <- function(l,
                              "redcap_repeat_instrument",
                              "redcap_repeat_instance"
                            )) {
-  generic.names <- c(get_id_name(l),
+  generic.names <- c(
+    get_id_name(l),
     generic.names,
-                     paste0(names(l), "_complete"))
+    paste0(names(l), "_complete")
+  )
 
   lapply(l, function(i) {
     if (ncol(i) > 2) {
@@ -334,7 +336,8 @@ split_non_repeating_forms <-
 #' @export
 #'
 #' @examples
-#' test <- c("12 months follow-up", "3 steps", "mRS 6 weeks", "Counting to 231 now")
+#' test <- c("12 months follow-up", "3 steps", "mRS 6 weeks",
+#' "Counting to 231 now")
 #' strsplitx(test, "[0-9]", type = "around")
 strsplitx <- function(x,
                       split,
@@ -403,7 +406,8 @@ 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
+  # A sapply() call with nested lapply() to handle vectors, data.frames
+  # and lists
   convert <- function(x, lang, neutrum) {
     zero_nine <- data.frame(
       num = 0:9,
@@ -503,7 +507,9 @@ is_repeated_longitudinal <- function(data, generics = c(
 #' @examples
 #' file_extension(list.files(here::here(""))[[2]])[[1]]
 file_extension <- function(filenames) {
-  sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", filenames, perl = TRUE)
+  sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
+      filenames,
+      perl = TRUE)
 }
 
 #' Flexible file import based on extension
@@ -516,17 +522,16 @@ file_extension <- function(filenames) {
 #'
 #' @examples
 #' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv")
-read_input <- function(file, consider.na= c("NA", '""',"")){
+read_input <- function(file, consider.na = c("NA", '""', "")) {
-
   ext <- file_extension(file)
 
   tryCatch(
     {
       if (ext == "csv") {
-        df <- readr::read_csv(file = file,na = consider.na)
+        df <- readr::read_csv(file = file, na = consider.na)
       } else if (ext %in% c("xls", "xlsx")) {
         df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na)
-      } else if (ext == "dta"){
+      } else if (ext == "dta") {
         df <- haven::read_dta(file = file)
       } else {
         stop("Input file format has to be either '.csv', '.xls' or '.xlsx'")

data-raw/data-upload-examples.R

@@ -1,9 +1,11 @@
-mtcars_redcap <- mtcars |> dplyr::mutate(record_id=seq_len(dplyr::n()),
+mtcars_redcap <- mtcars |>
-                        name=rownames(mtcars)
+  dplyr::mutate(
+    record_id = seq_len(dplyr::n()),
+    name = rownames(mtcars)
   ) |>
-  dplyr::select(record_id,dplyr::everything())
+  dplyr::select(record_id, dplyr::everything())
 
 mtcars_redcap |>
-  write.csv(here::here("data/mtcars_redcap.csv"),row.names = FALSE)
+  write.csv(here::here("data/mtcars_redcap.csv"), row.names = FALSE)
 
 usethis::use_data(mtcars_redcap, overwrite = TRUE)

data-raw/metadata_names.R

@@ -3,11 +3,12 @@
 #   "field_label", "select_choices_or_calculations", "field_note",
 #   "text_validation_type_or_show_slider_number", "text_validation_min",
 #   "text_validation_max", "identifier", "branching_logic", "required_field",
-#   "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking",
+#   "custom_alignment", "question_number", "matrix_group_name",
-#   "field_annotation"
+#   "matrix_ranking", "field_annotation"
 # )
 
-metadata_names <- REDCapR::redcap_metadata_read(redcap_uri = keyring::key_get("DB_URI"),
+metadata_names <- REDCapR::redcap_metadata_read(
+  redcap_uri = keyring::key_get("DB_URI"),
   token = keyring::key_get("cast_api")
 )$data |> names()
 

data-raw/redcapcast_data.R

@@ -1,9 +1,10 @@
 ## code to prepare `redcapcast_data` dataset goes here
 
-redcapcast_data <- REDCapR::redcap_read(redcap_uri = keyring::key_get("DB_URI"),
+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 |> dplyr::tibble()
 
 # redcapcast_data <- easy_redcap(project.name = "redcapcast_pacakge",
 #                                uri = keyring::key_get("DB_URI"),

data-raw/redcapcast_meta.R

@@ -1,6 +1,7 @@
 ## code to prepare `redcapcast_meta` dataset goes here
-redcapcast_meta <- REDCapR::redcap_metadata_read(redcap_uri = keyring::key_get("DB_URI"),
+redcapcast_meta <- REDCapR::redcap_metadata_read(
+  redcap_uri = keyring::key_get("DB_URI"),
   token = keyring::key_get("cast_api")
-                                          )$data
+)$data
 
 usethis::use_data(redcapcast_meta, overwrite = TRUE)

man/REDCap_split.Rd

@@ -52,17 +52,17 @@ library(RCurl)
 records <- postForm(
   uri = api_url, # Supply your site-specific URI
   token = api_token, # Supply your own API token
-  content = 'record',
+  content = "record",
-  format = 'json',
+  format = "json",
-  returnFormat = 'json'
+  returnFormat = "json"
 )
 
 # Get the metadata
 metadata <- postForm(
   uri = api_url, # Supply your site-specific URI
   token = api_token, # Supply your own API token
-  content = 'metadata',
+  content = "metadata",
-  format = 'json'
+  format = "json"
 )
 
 # Convert exported JSON strings into a list of data.frames
@@ -75,7 +75,8 @@ records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv")
 
 # Get the metadata
 metadata <- read.csv(
-"/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv")
+  "/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv"
+)
 
 # Split the tables
 REDCapRITS::REDCap_split(records, metadata)

man/ds2dd_detailed.Rd

@@ -44,8 +44,8 @@ data set (imported .dta file with `haven::read_dta()`. Default is "label"}
 
 \item{field.validation}{manually specify field validation(s). Vector of
 length 1 or ncol(data). Default is NULL and `levels()` are used for factors
-or attribute `factor.labels.attr` for haven_labelled data set (imported .dta file with
+or attribute `factor.labels.attr` for haven_labelled data set (imported .dta
-`haven::read_dta()`).}
+file with `haven::read_dta()`).}
 
 \item{metadata}{redcap metadata headings. Default is
 REDCapCAST:::metadata_names.}

man/guess_time_only_filter.Rd

@@ -32,5 +32,7 @@ has to be converted to character class before REDCap upload.
 \examples{
 data <- redcapcast_data
 data |> guess_time_only_filter()
-data |> guess_time_only_filter(validate = TRUE) |> lapply(head)
+data |>
+  guess_time_only_filter(validate = TRUE) |>
+  lapply(head)
 }

man/read_redcap_instrument.Rd

@@ -2,7 +2,8 @@
 % Please edit documentation in R/read_redcap_instrument.R
 \name{read_redcap_instrument}
 \alias{read_redcap_instrument}
-\title{Convenience function to download complete instrument, using token storage in keyring.}
+\title{Convenience function to download complete instrument, using token storage
+in keyring.}
 \usage{
 read_redcap_instrument(
   key,
@@ -24,11 +25,13 @@ read_redcap_instrument(
 
 \item{id_name}{id variable name. Default is "record_id".}
 
-\item{records}{specify the records to download. Index numbers. Numeric vector.}
+\item{records}{specify the records to download. Index numbers.
+Numeric vector.}
 }
 \value{
 data.frame
 }
 \description{
-Convenience function to download complete instrument, using token storage in keyring.
+Convenience function to download complete instrument, using token storage
+in keyring.
 }

man/redcap_wider.Rd

@@ -26,35 +26,59 @@ Handles longitudinal projects, but not yet repeated instruments.
 }
 \examples{
 # Longitudinal
-list1 <- list(data.frame(record_id = c(1,2,1,2),
+list1 <- list(
-redcap_event_name = c("baseline", "baseline", "followup", "followup"),
+  data.frame(
-age = c(25,26,27,28)),
+    record_id = c(1, 2, 1, 2),
-data.frame(record_id = c(1,2),
+    redcap_event_name = c("baseline", "baseline", "followup", "followup"),
-redcap_event_name = c("baseline", "baseline"),
+    age = c(25, 26, 27, 28)
-gender = c("male", "female")))
+  ),
+  data.frame(
+    record_id = c(1, 2),
+    redcap_event_name = c("baseline", "baseline"),
+    gender = c("male", "female")
+  )
+)
 redcap_wider(list1)
 # Simpel with two instruments
-list2 <- list(data.frame(record_id = c(1,2),
+list2 <- list(
-age = c(25,26)),
+  data.frame(
-data.frame(record_id = c(1,2),
+    record_id = c(1, 2),
-gender = c("male", "female")))
+    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),
+list3 <- list(data.frame(
-age = c(25,26)))
+  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),
+list4 <- list(
-redcap_event_name = c("baseline", "baseline", "followup", "followup"),
+  data.frame(
-age = c(25,26,27,28)),
+    record_id = c(1, 2, 1, 2),
-data.frame(record_id = c(1,1,1,1,2,2,2,2),
+    redcap_event_name = c("baseline", "baseline", "followup", "followup"),
-redcap_event_name = c("baseline", "baseline", "followup", "followup",
+    age = c(25, 26, 27, 28)
-"baseline", "baseline", "followup", "followup"),
+  ),
-redcap_repeat_instrument = "walk",
+  data.frame(
-redcap_repeat_instance=c(1,2,1,2,1,2,1,2),
+    record_id = c(1, 1, 1, 1, 2, 2, 2, 2),
-dist = c(40, 32, 25, 33, 28, 24, 23, 36)),
+    redcap_event_name = c(
-data.frame(record_id = c(1,2),
+      "baseline", "baseline", "followup", "followup",
-redcap_event_name = c("baseline", "baseline"),
+      "baseline", "baseline", "followup", "followup"
-gender = c("male", "female")))
+    ),
+    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/redcapcast_meta.Rd

@@ -12,9 +12,11 @@ A data frame with 22 variables:
   \item{section_header}{section_header, character}
   \item{field_type}{field_type, character}
   \item{field_label}{field_label, character}
-  \item{select_choices_or_calculations}{select_choices_or_calculations, character}
+  \item{select_choices_or_calculations}
+  {select_choices_or_calculations, character}
   \item{field_note}{field_note, character}
-  \item{text_validation_type_or_show_slider_number}{text_validation_type_or_show_slider_number, character}
+  \item{text_validation_type_or_show_slider_number}
+  {text_validation_type_or_show_slider_number, character}
   \item{text_validation_min}{text_validation_min, character}
   \item{text_validation_max}{text_validation_max, character}
   \item{identifier}{identifier, character}

man/strsplitx.Rd

@@ -25,6 +25,7 @@ Can be used as a substitute of the base function. Main claim to fame is
 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")
+test <- c("12 months follow-up", "3 steps", "mRS 6 weeks",
+"Counting to 231 now")
 strsplitx(test, "[0-9]", type = "around")
 }

man/time_only_correction.Rd

@@ -2,8 +2,7 @@
 % Please edit documentation in R/ds2dd_detailed.R
 \name{time_only_correction}
 \alias{time_only_correction}
-\title{Correction based on time_only_filter function. Introduces new class for easier
+\title{Correction based on time_only_filter function}
-validation labelling.}
 \usage{
 time_only_correction(data, ...)
 }
@@ -16,8 +15,7 @@ time_only_correction(data, ...)
 tibble
 }
 \description{
-Dependens on the data class "hms" introduced with
+Correction based on time_only_filter function
-`guess_time_only_filter()` and converts these
 }
 \examples{
 data <- redcapcast_data

tests/testthat/data/create-ref-data.R

@@ -7,22 +7,23 @@ library(magrittr)
 library(jsonlite)
 
 
-ref_data_location <- function(x) file.path("tests","testthat","data", x)
+ref_data_location <- function(x) file.path("tests", "testthat", "data", x)
 
 # RCurl -------------------------------------------------------------------
 
 REDCap_split(
-  ref_data_location("ExampleProject_records.json") %>% fromJSON,
+  ref_data_location("ExampleProject_records.json") %>% fromJSON(),
-  ref_data_location("ExampleProject_metadata.json") %>% fromJSON
+  ref_data_location("ExampleProject_metadata.json") %>% fromJSON()
-  ) %>% digest
+) %>% digest()
 
 
 # Basic CSV ---------------------------------------------------------------
 
 REDCap_split(
-  ref_data_location("ExampleProject_DATA_2018-06-07_1129.csv") %>% read.csv,
+  ref_data_location("ExampleProject_DATA_2018-06-07_1129.csv") %>% read.csv(),
-  ref_data_location("ExampleProject_DataDictionary_2018-06-07.csv") %>% read.csv
+  ref_data_location("ExampleProject_DataDictionary_2018-06-07.csv") %>%
-  ) %>% digest
+    read.csv()
+) %>% digest()
 
 # REDCap R Export ---------------------------------------------------------
 
@@ -30,10 +31,11 @@ source("tests/testthat/helper-ExampleProject_R_2018-06-07_1129.r")
 
 REDCap_split(
   ref_data_location("ExampleProject_DATA_2018-06-07_1129.csv") %>%
-    read.csv %>%
+    read.csv() %>%
-    REDCap_process_csv,
+    REDCap_process_csv(),
-  ref_data_location("ExampleProject_DataDictionary_2018-06-07.csv") %>% read.csv
+  ref_data_location("ExampleProject_DataDictionary_2018-06-07.csv") %>%
-  ) %>% digest
+    read.csv()
+) %>% digest()
 
 # Longitudinal data from @pbchase; Issue #7 -------------------------------
 
@@ -41,9 +43,10 @@ file_paths <- vapply(
   c(
     records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
     metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"
-  ), FUN.VALUE = "character", ref_data_location
+  ),
+  FUN.VALUE = "character", ref_data_location
 )
 
 redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)
-redcap[["metadata"]] <- with(redcap, metadata[metadata[,1] > "",])
+redcap[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "", ])
-with(redcap, REDCap_split(records, metadata)) %>% digest
+with(redcap, REDCap_split(records, metadata)) %>% digest()

tests/testthat/helper-ExampleProject_R_2018-06-07_1129.r

@@ -1,5 +1,5 @@
 REDCap_process_csv <- function(data) {
-  #Load Hmisc library
+  # Load Hmisc library
   if (!requireNamespace("Hmisc", quietly = TRUE)) {
     stop("This test requires the 'Hmisc' package")
   }
@@ -36,10 +36,10 @@ REDCap_process_csv <- function(data) {
   Hmisc::label(data$color) <- "Color"
   Hmisc::label(data$customer) <- "Customer Name"
   Hmisc::label(data$sale_complete) <- "Complete?"
-  #Setting Units
+  # Setting Units
 
 
-  #Setting Factors(will create new variable for factors)
+  # Setting Factors(will create new variable for factors)
   data$redcap_repeat_instrument.factor <-
     factor(data$redcap_repeat_instrument, levels <-
       c("sale"))

tests/testthat/test-csv-exports.R

@@ -1,5 +1,3 @@
-
-
 # Set up the path and data -------------------------------------------------
 metadata <- read.csv(
   get_data_location("ExampleProject_DataDictionary_2018-06-07.csv"),
@@ -8,7 +6,8 @@ metadata <- read.csv(
 
 records <-
   read.csv(get_data_location("ExampleProject_DATA_2018-06-07_1129.csv"),
-           stringsAsFactors = TRUE)
+    stringsAsFactors = TRUE
+  )
 
 redcap_output_csv1 <- REDCap_split(records, metadata)
 
@@ -19,20 +18,21 @@ test_that("CSV export matches reference", {
 
 # Test that REDCap_split can handle a focused dataset
 
-records_red <- records[!records$redcap_repeat_instrument == "sale",
+records_red <- records[
+  !records$redcap_repeat_instrument == "sale",
   !names(records) %in%
     metadata$field_name[metadata$form_name == "sale"] &
-                         !names(records) == "sale_complete"]
+    !names(records) == "sale_complete"
+]
 records_red$redcap_repeat_instrument <-
   as.character(records_red$redcap_repeat_instrument)
 
 redcap_output_red <- REDCap_split(records_red, metadata)
 
 
-test_that("REDCap_split handles subset dataset",
+test_that("REDCap_split handles subset dataset", {
-          {
   testthat::expect_length(redcap_output_red, 1)
-          })
+})
 
 
 # Test that R code enhanced CSV export matches reference --------------------
@@ -47,35 +47,40 @@ if (requireNamespace("Hmisc", quietly = TRUE)) {
 
 
 if (requireNamespace("readr", quietly = TRUE)) {
-
   metadata <-
     readr::read_csv(get_data_location(
-      "ExampleProject_DataDictionary_2018-06-07.csv"))
+      "ExampleProject_DataDictionary_2018-06-07.csv"
+    ))
 
   records <-
     readr::read_csv(get_data_location(
-      "ExampleProject_DATA_2018-06-07_1129.csv"))
+      "ExampleProject_DATA_2018-06-07_1129.csv"
+    ))
 
   redcap_output_readr <- REDCap_split(records, metadata)
 
   expect_matching_elements <- function(FUN) {
     FUN <- match.fun(FUN)
-    expect_identical(lapply(redcap_output_readr, FUN),
+    expect_identical(
-                     lapply(redcap_output_csv1, FUN))
+      lapply(redcap_output_readr, FUN),
+      lapply(redcap_output_csv1, FUN)
+    )
   }
 
   test_that("Result of data read in with `readr` will
-            match result with `read.csv`",
+            match result with `read.csv`", {
-            {
     # The list itself
-              expect_identical(length(redcap_output_readr),
+    expect_identical(
-                               length(redcap_output_csv1))
+      length(redcap_output_readr),
-              expect_identical(names(redcap_output_readr),
+      length(redcap_output_csv1)
-                               names(redcap_output_csv1))
+    )
+    expect_identical(
+      names(redcap_output_readr),
+      names(redcap_output_csv1)
+    )
 
     # Each element of the list
     expect_matching_elements(names)
     expect_matching_elements(dim)
   })
-
 }

tests/testthat/test-utils.R

@@ -1,20 +1,22 @@
 test_that("strsplitx works", {
   expect_equal(2 * 2, 4)
-  test <- c("12 months follow-up", "3 steps", "mRS 6 weeks", "Counting to 231 now")
+  test <- c("12 months follow-up", "3 steps", "mRS 6 weeks",
-  expect_length(strsplitx(test,"[0-9]",type="around")[[1]],3)
+            "Counting to 231 now")
+  expect_length(strsplitx(test, "[0-9]", type = "around")[[1]], 3)
 
-  expect_equal(strsplitx(test,"[0-9]",type="classic")[[2]][1],"")
+  expect_equal(strsplitx(test, "[0-9]", type = "classic")[[2]][1], "")
-  expect_length(strsplitx(test,"[0-9]",type="classic")[[4]],4)
+  expect_length(strsplitx(test, "[0-9]", type = "classic")[[4]], 4)
 
-  expect_length(strsplitx(test,"[0-9]",type="classic")[[4]],4)
+  expect_length(strsplitx(test, "[0-9]", type = "classic")[[4]], 4)
 })
 
 test_that("d2w works", {
+  expect_length(d2w(c(2:8, 21)), 8)
 
-  expect_length(d2w(c(2:8,21)),8)
+  expect_equal(d2w(data.frame(2:7, 3:8, 1),
+    lang = "da",
+    neutrum = TRUE
+  )[1, 3], "et")
 
-  expect_equal(d2w(data.frame(2:7,3:8,1),lang="da",
+  expect_equal(d2w(list(2:8, c(2, 6, 4, 23), 2), everything = T)[[2]][4], "two three")
-                              neutrum=TRUE)[1,3],"et")
-
-  expect_equal(d2w(list(2:8,c(2,6,4,23),2), everything=T)[[2]][4],"two three")
 })

vignettes/Database-creation.Rmd

@@ -25,7 +25,8 @@ THe first iteration of a dataset to data dictionary function is the `ds2dd()`, w
 ```{r eval=FALSE}
 mtcars |>
   dplyr::mutate(record_id = seq_len(dplyr::n())) |>
-  ds2dd() |> str()
+  ds2dd() |>
+  str()
 ```
 
 The more advanced `ds2dd_detailed()` is a natural development. It will try to apply the most common data classes for data validation and will assume that the first column is the id number. It outputs a list with the dataset with modified variable names to comply with REDCap naming conventions and a data dictionary. 
@@ -37,7 +38,8 @@ dd_ls <- mtcars |>
   dplyr::mutate(record_id = seq_len(dplyr::n())) |>
   dplyr::select(record_id, dplyr::everything()) |>
   ds2dd_detailed()
-dd_ls |> str()
+dd_ls |> 
+  str()
 ```
 
 Additional specifications to the DataDictionary can be made manually, or it can be uploaded and modified manually in the graphical user interface on the web page.

vignettes/Introduction.Rmd

@@ -33,17 +33,23 @@ redcapcast_meta |> gt::gt()
 ```
 ```{r}
 list <-
-  REDCap_split(records = redcapcast_data,
+  REDCap_split(
+    records = redcapcast_data,
     metadata = redcapcast_meta,
-                           forms = "repeating")|> sanitize_split()
+    forms = "repeating"
+  ) |> 
+  sanitize_split()
 str(list)
 ```
 
 ```{r}
 list <-
-  REDCap_split(records = redcapcast_data,
+  REDCap_split(
+    records = redcapcast_data,
     metadata = redcapcast_meta,
-                           forms = "all") |> sanitize_split()
+    forms = "all"
+  ) |> 
+  sanitize_split()
 str(list)
 ```
 
@@ -62,5 +68,3 @@ The function works very similar to the `REDCapR::redcap_read()` in allowing to s
 ```{r}
 redcap_wider(list) |> str()
 ```
-
-