Add option to use import IDs as column names instead of Qualtrics que…

…stion IDs. Addresses #116.

R/assertions.R

@@ -3,7 +3,7 @@ assert_api_key <- function() { # nolint start
 
   # Check if API key is set in environment
   assertthat::assert_that(Sys.getenv("QUALTRICS_API_KEY") != "",
-    msg = "You need to register your Qualtrics API key and base URL using the\n'qualtrics_api_credentials()' function."
+                          msg = "You need to register your Qualtrics API key and base URL using the\n'qualtrics_api_credentials()' function."
   )
 }
 
@@ -12,24 +12,24 @@ assert_base_url <- function() {
 
   # Check if base URL is set in environment
   assertthat::assert_that(Sys.getenv("QUALTRICS_BASE_URL") != "",
-    msg = "You need to register your Qualtrics API key and base URL using the\n'qualtrics_api_credentials()' function."
+                          msg = "You need to register your Qualtrics API key and base URL using the\n'qualtrics_api_credentials()' function."
   )
 
   # Test if root URL ends with '.qualtrics.com'
   assertthat::assert_that(endsWith(Sys.getenv("QUALTRICS_BASE_URL"), ".qualtrics.com"),
-    msg = paste0(
-      "The Qualtrics base URL must end with '.qualtrics.com'. Your base URL looks like this: '",
-      Sys.getenv("QUALTRICS_BASE_URL"),
-      "'.\nPlease visit https://api.qualtrics.com/docs/root-url for instructions about the Qualtrics base URL."
-    )
+                          msg = paste0(
+                            "The Qualtrics base URL must end with '.qualtrics.com'. Your base URL looks like this: '",
+                            Sys.getenv("QUALTRICS_BASE_URL"),
+                            "'.\nPlease visit https://api.qualtrics.com/docs/root-url for instructions about the Qualtrics base URL."
+                          )
   )
 }
 
 # Check if save directory exists
 assert_saveDir_exists <- function(save_dir) {
   assertthat::assert_that(ifelse((!file.info(save_dir)$isdir |
-    is.na(file.info(save_dir)$isdir) == TRUE),
-  FALSE, TRUE
+                                    is.na(file.info(save_dir)$isdir) == TRUE),
+                                 FALSE, TRUE
   ),
   msg = paste0("The directory ", save_dir, " does not exist.")
   )
@@ -59,44 +59,51 @@ assert_endDate_string <- function(end_date) {
 # Check if include_questions are string(s)
 assert_includedQuestionIds_string <- function(include_questions) {
   assertthat::assert_that(mode(include_questions) == "character",
-    msg = "'include_questions' must be a character vector."
+                          msg = "'include_questions' must be a character vector."
   )
 }
 
 # Check if limit > 0
 assert_limit_abovezero <- function(limit) {
   assertthat::assert_that(limit > 0,
-    msg = "Limit parameter should be at least 1."
+                          msg = "Limit parameter should be at least 1."
   )
 }
 
 # Check if survey file exists
 assert_surveyFile_exists <- function(file_name) {
   assertthat::assert_that(file.exists(file_name),
-    msg = paste0(
-      "File ",
-      file_name,
-      " does not exist. Please check if you passed the right file path."
-    )
+                          msg = paste0(
+                            "File ",
+                            file_name,
+                            " does not exist. Please check if you passed the right file path."
+                          )
   )
 }
 
 # Check if these arguments are logical
-assert_options_logical <- function(verbose, convert,
-                                   local_time, label) {
+assert_options_logical <- function(verbose,
+                                   convert,
+                                   import_id,
+                                   local_time,
+                                   label) {
   assertthat::assert_that(assertthat::is.flag(verbose),
-    msg = "'verbose' must be TRUE or FALSE."
+                          msg = "'verbose' must be TRUE or FALSE."
   )
 
   assertthat::assert_that(assertthat::is.flag(convert),
-    msg = "'convert' must be TRUE or FALSE."
+                          msg = "'convert' must be TRUE or FALSE."
+  )
+
+  assertthat::assert_that(assertthat::is.flag(import_id),
+                          msg = "'import_id' must be TRUE or FALSE."
   )
 
   assertthat::assert_that(assertthat::is.flag(local_time),
-    msg = "'local_time' must be TRUE or FALSE."
+                          msg = "'local_time' must be TRUE or FALSE."
   )
 
   assertthat::assert_that(assertthat::is.flag(label),
-    msg = "'label' must be TRUE or FALSE."
+                          msg = "'label' must be TRUE or FALSE."
   )
 } # nolint end

R/fetch_survey.R

@@ -48,6 +48,8 @@ getSurvey <- function(...) {
 #' @param convert Logical. If \code{TRUE}, then the
 #' \code{\link[qualtRics]{fetch_survey}} function will convert certain question
 #' types (e.g. multiple choice) to proper data type in R. Defaults to \code{TRUE}.
+#' @param import_id Logical. If \code{TRUE}, use Qualtrics import IDs instead of
+#' question IDs as column names. Defaults to \code{FALSE}.
 #' @param local_time Logical. Use local timezone to determine response date
 #' values? Defaults to \code{FALSE}. See
 #' \url{https://api.qualtrics.com/docs/dates-and-times} for more information.
@@ -96,6 +98,7 @@ fetch_survey <- function(surveyID,
                          verbose = TRUE,
                          label = TRUE,
                          convert = TRUE,
+                         import_id = FALSE,
                          local_time = FALSE,
                          ...) {
 
@@ -106,6 +109,7 @@ fetch_survey <- function(surveyID,
   check_params(
     verbose = verbose,
     convert = convert,
+    import_id = import_id,
     local_time = local_time,
     label = label,
     last_response = last_response,
@@ -170,7 +174,7 @@ fetch_survey <- function(surveyID,
   # READ DATA AND SET VARIABLES ----
 
   # Read data
-  data <- read_survey(survey.fpath)
+  data <- read_survey(survey.fpath, import_id = import_id)
 
   # Add types
   if (convert) {

R/read_survey.R

@@ -20,9 +20,12 @@ readSurvey <- function(...) {
 #' Variable labels are stored as attributes.
 #'
 #' @param file_name String. A CSV data file.
-#' @param strip_html Logical. If TRUE, then remove HTML tags. Defaults to TRUE.
-#' @param legacy Logical. If TRUE, then import "legacy" format CSV files
-#' (as of 2017). Defaults to FALSE.
+#' @param import_id Logical. If \code{TRUE}, use Qualtrics import IDs instead of
+#' question IDs as column names. Defaults to \code{FALSE}.
+#' @param strip_html Logical. If \code{TRUE}, then remove HTML tags. Defaults
+#' to \code{TRUE}.
+#' @param legacy Logical. If \code{TRUE}, then import "legacy" format CSV files
+#' (as of 2017). Defaults to \code{FALSE}.
 #'
 #' @importFrom utils read.csv
 #' @importFrom sjlabelled set_label
@@ -48,10 +51,16 @@ readSurvey <- function(...) {
 #'
 read_survey <- function(file_name,
                         strip_html = TRUE,
+                        import_id = FALSE,
                         legacy = FALSE) {
 
   # START UP: CHECK ARGUMENTS PASSED BY USER ----
 
+  if (import_id & legacy) {
+    stop("Import IDs as column names are not supported for legacy CSVs.\nSet import_id = FALSE.",
+         call. = FALSE)
+  }
+
   # check if file exists
   assert_surveyFile_exists(file_name)
   # skip 2 rows if legacy format, else 3 when loading the data
@@ -68,14 +77,14 @@ read_survey <- function(file_name,
   ))
   # Need contingency when 0 rows
   assertthat::assert_that(nrow(rawdata) > 0,
-    msg = "The survey you are trying to import has no responses."
+                          msg = "The survey you are trying to import has no responses."
   ) # nolint
   # Load headers
-  header <- suppressMessages(readr::read_csv(
+  header <- suppressWarnings(suppressMessages(readr::read_csv(
     file = file_name,
     col_names = TRUE,
     n_max = 1
-  ))
+  )))
 
   # MANIPULATE DATA ----
 
@@ -86,6 +95,18 @@ read_survey <- function(file_name,
   # Add names
   names(rawdata) <- names(header)
 
+  if (import_id) {
+    new_ids <- suppressMessages(readr::read_csv(
+      file = file_name,
+      col_names = FALSE,
+      skip = skipNr - 1,
+      n_max = 1
+    ))
+
+    names(rawdata) <- gsub("^\\{'ImportId': '(.*)'\\}$", "\\1",
+                           unlist(new_ids))
+  }
+
   # If Qualtrics adds an empty column at the end, remove it
   if (grepl(",$", readLines(file_name, n = 1))) {
     header <- header[, 1:(ncol(header) - 1)]

R/utils.R

@@ -102,12 +102,16 @@ check_params <- function(...) {
 
   ## options
   if (all(c(
-    "verbose", "convert",
-    "local_time", "label"
+    "verbose",
+    "convert",
+    "import_id",
+    "local_time",
+    "label"
   ) %in% names(args))) {
     assert_options_logical(
       args$verbose,
       args$convert,
+      args$import_id,
       args$local_time,
       args$label
     )