Merge pull request #162 from jntrcs/ColTypesFix

Col_types argument

DESCRIPTION

@@ -4,21 +4,23 @@ Title: Download 'Qualtrics' Survey Data
 Version: 3.1.2
 Authors@R: c(person("Jasper", "Ginn", role = c("aut"),
              email = "[email protected]"),
+             person("Jackson", "Curtis", role = c("ctb"),
+             email = "[email protected]"),
+             person("Shaun", "Jackson", role = c("ctb"),
+             email = "[email protected]"),
              person("Samuel", "Kaminsky", role = c("ctb"),
              email = "[email protected]"),
              person("Eric", "Knudsen", role = c("ctb"),
              email = "[email protected]"),
+             person("Joseph", "O'Brien", role = c("ctb"),
+             email = "[email protected]"),
+             person("Daniel", "Seneca", role = c("ctb"),
+             email = "[email protected]"),
              person("Julia", "Silge", role = c("aut", "cre"),
              email = "[email protected]",
              comment = c(ORCID = "0000-0002-3671-836X")),
              person("Phoebe", "Wong", role = c("ctb"),
-             email = "[email protected]"),
-             person("O'Brien", "Joseph", role = c("ctb"),
-             email = "[email protected]"),
-             person("Seneca", "Daniel", role = c("ctb"),
-             email = "[email protected]"),
-             person("Shaun", "Jackson", role = c("ctb"),
-             email = "[email protected]")
+             email = "[email protected]")
              )
 Description: Provides functions to access survey results directly into R using 
     the 'Qualtrics' API. 'Qualtrics' <https://www.qualtrics.com/about/> is an 

NEWS.md

@@ -3,6 +3,7 @@
 - Update `include_questions` argument to use correct name in API request.
 - Build API payloads with jsonlite (#155) thanks to @jmobrien
 - Convert tests to webmockr and vcr (#140 and #161) thanks to @shaun-jacks and @dsen6644
+- Allow user to specify column types for both `fetch_survey()` and `read_survey()` (#162) thanks to @jntrcs 
 
 # qualtRics 3.1.2
 

R/fetch_survey.R

@@ -48,6 +48,10 @@
 #' \code{\link[qualtRics]{fetch_survey}} function will split multiple
 #' choice question answers into columns. If \code{FALSE}, each multiple choice
 #' question is one column. Defaults to \code{TRUE}.
+#' @param col_types Optional. This argument provides a way to manually overwrite
+#' column types that may be incorrectly guessed. Takes a \code{\link[readr]{cols}}
+#' specification. See example below and \code{\link[readr]{cols}} for formatting
+#' details. Defaults to \code{NULL}. Overwritten by \code{convert = TRUE}.
 #' @param ... Optional arguments, such as a `fileEncoding` (see `fileEncoding`
 #' argument in \code{\link[qualtRics]{read_survey}}) to import your survey using
 #' a specific encoding.
@@ -79,7 +83,9 @@
 #'   limit = 100,
 #'   label = TRUE,
 #'   unanswer_recode = 999,
-#'   verbose = TRUE
+#'   verbose = TRUE,
+#'   # Manually override EndDate to be a character vector
+#'   col_types = readr::cols(EndDate = readr::col_character())
 #' )
 #' }
 #'
@@ -100,6 +106,7 @@ fetch_survey <- function(surveyID,
                          import_id = FALSE,
                          time_zone = NULL,
                          breakout_sets = TRUE,
+                         col_types = NULL,
                          ...) {
 
   if (lifecycle::is_present(last_response)) {
@@ -177,7 +184,8 @@ fetch_survey <- function(surveyID,
   # READ DATA AND SET VARIABLES ----
 
   # Read data
-  data <- read_survey(survey.fpath, import_id = import_id, time_zone = time_zone)
+  data <- read_survey(survey.fpath, import_id = import_id,
+                      time_zone = time_zone, col_types = col_types)
 
   # Add types
   if (convert & label) {

R/read_survey.R

@@ -16,6 +16,10 @@
 #' format.
 #' @param legacy Logical. If \code{TRUE}, then import "legacy" format CSV files
 #' (as of 2017). Defaults to \code{FALSE}.
+#' @param col_types Optional. This argument provides a way to manually overwrite
+#' column types that may be incorrectly guessed. Takes a \code{\link[readr]{cols}}
+#' specification. See example below and \code{\link[readr]{cols}} for formatting
+#' details. Defaults to \code{NULL}.
 #'
 #' @importFrom sjlabelled set_label
 #' @importFrom jsonlite fromJSON
@@ -37,12 +41,17 @@
 #' file <- system.file("extdata", "sample_legacy.csv", package = "qualtRics")
 #' df <- read_survey(file, legacy = TRUE)
 #'
+#' # Example changing column type
+#' file <- system.file("extdata", "sample.csv", package = "qualtRics")
+#' # Force EndDate to be a string
+#' df <- read_survey(file, col_types = readr::cols(EndDate = readr::col_character()))
 #'
 read_survey <- function(file_name,
                         strip_html = TRUE,
                         import_id = FALSE,
                         time_zone = NULL,
-                        legacy = FALSE) {
+                        legacy = FALSE,
+                        col_types = NULL) {
 
   # START UP: CHECK ARGUMENTS PASSED BY USER ----
 
@@ -137,7 +146,8 @@ read_survey <- function(file_name,
   subquestions[is.na(subquestions)] <- ""
 
   rawdata <- readr::type_convert(rawdata,
-                                 locale = readr::locale(tz = time_zone))
+                                 locale = readr::locale(tz = time_zone),
+                                 col_types = col_types)
 
   # Add labels to data
   rawdata <- sjlabelled::set_label(rawdata, unlist(subquestions))

tests/testthat/test-fetch-survey.R

@@ -42,7 +42,8 @@ test_that("fetch_survey() returns survey with custom params", {
       unanswer_recode = 999,
       limit = 15,
       include_questions = c("QID9", "QID21"),
-      breakout_sets = FALSE
+      breakout_sets = FALSE,
+      col_types = readr::cols(EndDate = readr::col_character()),
     )
   })
 
@@ -61,6 +62,7 @@ test_that("fetch_survey() returns survey with custom params", {
                     "Q3.8 - Topic Sentiment Score",
                     "Q3.8 - Topics"))
   expect_type(x$StartDate, "double")
+  expect_type(x$EndDate, "character")
   expect_type(x$Status, "character")
   expect_type(x$`Duration (in seconds)`, "double")
   expect_type(x$Finished, "logical")

tests/testthat/test-read-survey.R

@@ -9,14 +9,40 @@ test_that("read_survey() reads data in qualtrics standard and legacy format and
   expect_true(is.numeric(survey$LocationLatitude))
 
   # Test if can read legacy format
-  survey_legacy <- suppressWarnings(qualtRics::read_survey("files/sample_legacy.csv", # nolint
-    legacy = TRUE
-  ))
+  survey_legacy <- suppressWarnings(
+    qualtRics::read_survey("files/sample_legacy.csv", # nolint
+                           legacy = TRUE)
+  )
   # Tests
   expect_equal(dim(survey_legacy)[1], 1)
   expect_equal(dim(survey_legacy)[2], 15)
   expect_true(is.numeric(as.numeric(survey_legacy$V8))) # StartDate
   expect_true(is.numeric(survey_legacy$LocationLatitude))
+
+  # Test if it respects col_types argument
+  survey <- suppressWarnings(
+    qualtRics::read_survey("files/sample.csv",
+                           col_types = readr::cols(StartDate = readr::col_character()))
+  )
+  #Tests
+  expect_equal(dim(survey)[1], 1) #Ensure no change in dims
+  expect_equal(dim(survey)[2], 20) #Ensure no change in dims
+  expect_true(is.character(survey$StartDate))
+
+
+  # Test if legacy version respects col_types argument
+  survey_legacy <- suppressWarnings(qualtRics::read_survey(
+    "files/sample_legacy.csv", # nolint
+    legacy = TRUE,
+    col_types = readr::cols(StartDate = readr::col_character()
+    )
+  ))
+  # Tests
+  expect_equal(dim(survey)[1], 1) #Ensure no change in dims
+  expect_equal(dim(survey)[2], 20) #Ensure no change in dims
+  expect_true(is.character(survey$StartDate))
+
+
 })
 
 test_that("Survey exists to read from disk", {