diff --git a/.Rbuildignore b/.Rbuildignore index 7856c9b..f925cfb 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,3 +2,4 @@ ^\.Rproj\.user$ .*~ ^\.circleci/config\.yml$ +^\.github/ diff --git a/DESCRIPTION b/DESCRIPTION index 9da6865..5bbfc97 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flipData Type: Package Title: Functions for extracting and describing data -Version: 1.8.9 +Version: 1.8.10 Author: Displayr Maintainer: Displayr Description: Functions for extracting data from formulas and diff --git a/R/mergingandstackingutilities.R b/R/mergingandstackingutilities.R index 4e518ce..7523230 100644 --- a/R/mergingandstackingutilities.R +++ b/R/mergingandstackingutilities.R @@ -12,18 +12,22 @@ readDataSets <- function(data.set.names, min.data.sets = 1) data.set.names <- vapply(data.set.names, trimws, character(1), USE.NAMES = FALSE) - if (length(data.set.names) < min.data.sets) + if (length(data.set.names) < min.data.sets) { StopForUserError("At least ", min.data.sets, " data set(s) are required.") + } - if (!all(grepl('.+\\.sav$', data.set.names, ignore.case = TRUE))) { - StopForUserError("An input data file was not an SPSS .sav data file. ", - "Only SPSS .sav data files are accepted.") + if (!all(grepl(".+\\.sav$", data.set.names, ignore.case = TRUE))) { + StopForUserError( + "An input data file was not an SPSS .sav data file. ", + "Only SPSS .sav data files are accepted." + ) } - if (IsDisplayrCloudDriveAvailable()) + if (IsDisplayrCloudDriveAvailable()) { readDataSetsFromDisplayrCloudDrive(data.set.names) - else + } else { readLocalDataSets(data.set.names) + } } #' @param data.set.paths A character vector of paths to local data files. @@ -34,7 +38,7 @@ readDataSets <- function(data.set.names, min.data.sets = 1) readLocalDataSets <- function(data.set.paths, parser = read_sav) { result <- lapply(data.set.paths, function(path) { - handler = createReadErrorHandler(path) + handler <- createReadErrorHandler(path) InterceptExceptions(parser(path), error.handler = handler) }) names(result) <- basename(data.set.paths) @@ -49,43 +53,57 @@ readLocalDataSets <- function(data.set.paths, parser = read_sav) readDataSetsFromDisplayrCloudDrive <- function(data.set.names) { result <- lapply(data.set.names, function(nm) { - handler = createReadErrorHandler(nm) + handler <- createReadErrorHandler(nm) InterceptExceptions(QLoadData(nm), error.handler = handler) }) names(result) <- data.set.names result } -createExceptionHandler <- function(intercept.messages, - replacement.messages, warn = FALSE) -{ - if (length(replacement.messages) == 1 && length(intercept.messages) > 1) +#' @importFrom flipU StopForUserError +createExceptionHandler <- function( + intercept.messages, + replacement.messages, + warn = FALSE +) { + if (length(replacement.messages) == 1 && length(intercept.messages) > 1) { replacement.messages <- rep(replacement.messages, length(intercept.messages)) - condition.fun <- if (warn) warning else stop - function(e) - { + } + function(e) { + condition.fun <- function(...) { + if (warn) { + warning(..., call. = FALSE) + } else if (inherits(e, "UserError")) { + StopForUserError(...) + } else { + stop(..., call. = FALSE) + } + } msg.found <- FALSE - for (i in seq_along(intercept.messages)) - { - if (grepl(intercept.messages[i], e$message)) - { - condition.fun(replacement.messages[i], call. = FALSE) + for (i in seq_along(intercept.messages)) { + if (grepl(intercept.messages[i], e$message)) { + condition.fun(replacement.messages[i]) msg.found <- TRUE } } - if (!msg.found) - condition.fun(e$message, call. = FALSE) + if (!msg.found) { + condition.fun(e$message) + } } } createReadErrorHandler <- function(data.set.name) { - replacement.msg <- paste0("The data file '", data.set.name, "' could not be parsed. ", - "The data file may be fixed by inserting it in a Displayr document, ", - "exporting it as an SPSS file (.sav) via the Publish button, ", - "and then uploading it back to the cloud drive.") - intercept.msgs <- c("Invalid file, or file has unsupported features", - "Unable to convert string to the requested encoding") + replacement.msg <- paste0( + "The data file '", data.set.name, "' could not be parsed. ", + "The data file may be fixed by inserting it in a Displayr document, ", + "exporting it as an SPSS file (.sav) via the Publish button, ", + "and then uploading it back to the cloud drive." + ) + intercept.msgs <- c( + "Invalid file, or file has unsupported features", + "Unable to convert string to the requested encoding" + ) createExceptionHandler(intercept.msgs, replacement.msg, warn = FALSE) } @@ -97,10 +115,8 @@ createReadErrorHandler <- function(data.set.name) #' @importFrom flipAPI QSaveData IsDisplayrCloudDriveAvailable #' @importFrom flipU InterceptExceptions #' @importFrom tools file_path_sans_ext -writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) -{ - if (is.saved.to.cloud) - { +writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) { + if (is.saved.to.cloud) { warn.msg <- paste0("The data file ", data.set.name, " has been compressed into ", file_path_sans_ext(data.set.name), ".zip on the Cloud Drive as it is too large. ", @@ -108,13 +124,15 @@ writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) "used in a Displayr document.") error.msg <- paste0("The data file could not be saved due to invalid characters ", "in some of the variable names. Please contact support for assistance.") - InterceptExceptions(QSaveData(data.set, data.set.name, 2e9), # 2e9 bytes seems to be just below the API upload limit for the cloud drive - warning.handler = createExceptionHandler("Object compressed into a zip file", - warn.msg, TRUE), - error.handler = createExceptionHandler("must have valid SPSS variable names", - error.msg, FALSE)) - }else + # 2e9 bytes seems to be just below the API upload limit for the cloud drive + InterceptExceptions( + QSaveData(data.set, data.set.name, 2e9), + warning.handler = createExceptionHandler("Object compressed into a zip file", warn.msg, TRUE), + error.handler = createExceptionHandler("must have valid SPSS variable names", error.msg, FALSE) + ) + } else { write_sav(data.set, data.set.name) + } } #' @description Creates a list of metadata for a data set @@ -239,12 +257,12 @@ variableType <- function(variable) StopForUserError("Variable type not recognised") } -NUMERIC.VARIABLE.TYPE = "Numeric"; -TEXT.VARIABLE.TYPE = "Text"; -CATEGORICAL.VARIABLE.TYPE = "Categorical"; -DATE.VARIABLE.TYPE = "Date"; -DATE.TIME.VARIABLE.TYPE = "Date/Time"; -DURATION.VARIABLE.TYPE = "Duration"; +NUMERIC.VARIABLE.TYPE <- "Numeric" +TEXT.VARIABLE.TYPE <- "Text" +CATEGORICAL.VARIABLE.TYPE <- "Categorical" +DATE.VARIABLE.TYPE <- "Date" +DATE.TIME.VARIABLE.TYPE <- "Date/Time" +DURATION.VARIABLE.TYPE <- "Duration" #' @param var.types A character vector containing variable types (see function #' variableType). @@ -342,6 +360,9 @@ splitByComma <- function(input.text, ignore.commas.in.parentheses = FALSE) result <- result[result != ""] result } + result <- trimws(result) + result <- result[result != ""] + result } #' @param x A vector.