additional redcap_wider function

DESCRIPTION

@@ -32,9 +32,11 @@ RoxygenNote: 7.2.3
 URL: https://github.com/agdamsbo/REDCapRITS
 BugReports: https://github.com/agdamsbo/REDCapRITS/issues
 Imports: 
-    REDCapR
+    REDCapR,
+    tidyr
 Collate: 
     'utils.r'
     'process_user_input.r'
     'REDCap_split.r'
     'read_redcap_tables.R'
+    'redcap_wider.R'

NAMESPACE

@@ -2,5 +2,7 @@
 
 export(REDCap_split)
 export(read_redcap_tables)
+export(redcap_wider)
 importFrom(REDCapR,redcap_metadata_read)
 importFrom(REDCapR,redcap_read)
+importFrom(tidyr,pivot_wider)

R/read_redcap_tables.R

@@ -12,7 +12,7 @@
 #' @param raw_or_label raw or label tags
 #' @param generics vector of auto-generated generic variable names to
 #' ignore when discarding empty rows
-#' @param ... ekstra parameters for REDCapR::redcap_read_oneshot
+#' @param ... extra parameters for internal REDCapR::redcap_read
 #'
 #' @return list of instruments
 #' @importFrom REDCapR redcap_metadata_read redcap_read
@@ -39,7 +39,7 @@ read_redcap_tables <- function(uri,
   #
   # This does not handle repeated instruments!! This should be implemented.
 
-  d <- REDCapR::redcap_read_oneshot(
+  d <- REDCapR::redcap_read(
     redcap_uri = uri,
     token = token,
     fields = fields,

R/redcap_wider.R

@@ -0,0 +1,42 @@
+
+
+#' @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 list A list of data frames.
+#' @param names.glud A string to glue the column names together.
+#' @return The list of data frames in wide format.
+#' @export
+#' @importFrom tidyr pivot_wider
+#'
+#' @examples
+#' list <- 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(list)
+redcap_wider <- function(list,names.glud="{.value}_{redcap_event_name}_long") {
+  l <- lapply(list,function(i){
+    incl <- any(duplicated(i[["record_id"]]))
+
+    cname <- colnames(i)
+    vals <- cname[!cname%in%c("record_id","redcap_event_name")]
+
+    i$redcap_event_name <- tolower(gsub(" ","_",i$redcap_event_name))
+
+    if (incl){
+      s <- tidyr::pivot_wider(i,
+                              names_from = redcap_event_name,
+                              values_from = all_of(vals),
+                              names_glue = names.glud)
+      s[colnames(s)!="redcap_event_name"]
+    } else (i[colnames(i)!="redcap_event_name"])
+
+  })
+
+  ## Additional conditioning is needed to handle repeated instruments.
+
+  data.frame(Reduce(f = dplyr::full_join, x = l))
+  }

man/redcap_wider.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/redcap_wider.R
+\name{redcap_wider}
+\alias{redcap_wider}
+\title{Redcap Wider}
+\usage{
+redcap_wider(list, names.glud = "{.value}_{redcap_event_name}_long")
+}
+\arguments{
+\item{list}{A list of data frames.}
+
+\item{names.glud}{A string to glue the column names together.}
+}
+\value{
+The list of data frames in wide format.
+}
+\description{
+Converts a list of REDCap data frames from long to wide format.
+}
+\examples{
+list <- 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(list)
+}

tests/testthat/test-redcap_wider.R

@@ -0,0 +1,10 @@
+test_that("redcap_wider() returns expected output", {
+  list <- 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")))
+
+  expect_equal(redcap_wider(list),
+               data.frame(record_id = c(1,2),
+                          age_baseline_long = c(25,26),
+                          age_followup_long = c(27,28),
+                          gender = c("male","female")))
+})