diff --git a/R/add-variable.R b/R/add-variable.R index 3c141b803..aab427a50 100644 --- a/R/add-variable.R +++ b/R/add-variable.R @@ -11,7 +11,7 @@ #' @export #' @importFrom httpcache halt addVariables <- function (dataset, ...) { - var_catalog_url <- shojiURL(dataset, "catalogs", "variables") + var_catalog_url <- shojiURL(dataset, "catalogs", "variables") ## Get vardefs and validate vardefs <- list(...) ## Check for whether a list of vardefs passed @@ -42,6 +42,27 @@ addVariables <- function (dataset, ...) { checkVarDefErrors(new_var_urls) dataset <- refresh(dataset) + + ## Check for any "replacement" variables + hides <- lapply(vardefs, attr, which=".hide") + todo <- vapply(hides, Negate(is.null), logical(1)) + if (any(todo)) { + replacements <- new_var_urls[todo] + locations <- lapply(hides[todo], + function (u) locateEntity(u[1], ord=ordering(dataset))) + hides <- unlist(hides) + allVariables(dataset)[hides]<- hide(allVariables(dataset)[hides]) + for (i in seq_along(locations)) { + loc <- locations[[i]] + if (length(loc)) { + ## If location is length 0, it is already at top level, so + ## no need to move + entities(ordering(dataset)[[loc]]) <- c(entities(ordering(dataset)[[loc]]), replacements[i]) + ## TODO: make that be folder(dataset[[replacements[[i]]]]) <- loc + } + } + } + invisible(dataset) } @@ -131,4 +152,4 @@ checkVarDefErrors <- function(new_var_urls) { paste(which(errs), collapse = ", ") ) } -} \ No newline at end of file +} diff --git a/R/combine-categories.R b/R/combine-categories.R index a20b5170b..b8a2bbcc3 100644 --- a/R/combine-categories.R +++ b/R/combine-categories.R @@ -1,23 +1,27 @@ #' Combine categories or responses #' -#' Crunch allows you to create a new categorical variable by combining -#' the categories of another variable. For instance, you might want to +#' Create a new categorical or multiple-response variable by collapsing +#' the categories/responses of another. For instance, you might want to #' recode a categorical variable with three categories small, medium, and large #' to one that has just small and large. #' #' @param variable Categorical, Categorical Array, or Multiple Response #' variable #' @param combinations list of named lists containing -#' 1. "categories": category ids or names for categorical types, or for multiple response, -#' "responses": subvariable names, aliases, or positional indices; +#' 1. "categories": category ids or names for categorical types, or for multiple +#' response, "responses": subvariable names, aliases, or positional indices; #' 1. a "name" for the new category or response; and -#' 1. optionally, other category ("missing", "numeric_value") or subvariable ("alias", "description") -#' attributes. If `combinations` is omitted, the resulting variable will -#' essentially be a copy (but see [copy()] for a more natural way to copy variables. +#' 1. optionally, other category ("missing", "numeric_value") or subvariable +#' ("alias", "description") attributes. If `combinations` is omitted, the +#' resulting variable will essentially be a copy (but see [copy()] for a more +#' natural way to copy variables. #' @param ... Additional variable metadata for the new derived variable -#' @return A [`VariableDefinition`] that will create the new combined-category or -#' -response derived variable. Categories/responses not referenced in `combinations` will be -#' appended to the end of the combinations. +#' @param replace Logical: should this derived variable, when added to the +#' dataset, take the place of the input `variable`, i.e. same folder/location? +#' If so, `variable` will also become "hidden". +#' @return A [`VariableDefinition`] that will create the new combined-category +#' or -response derived variable. Categories/responses not referenced in +#' `combinations` will be appended to the end of the combinations. #' @examples #' \dontrun{ #' ds$fav_pet2 <- combine(ds$fav_pet, name="Pets (combined)", @@ -28,7 +32,7 @@ #' } #' @export #' @importFrom utils modifyList -combine <- function (variable, combinations=list(), ...) { +combine <- function (variable, combinations=list(), ..., replace=FALSE) { ## Validate inputs if (!(type(variable) %in% c("categorical", "categorical_array", "multiple_response"))) { halt("Cannot combine ", dQuote(name(variable)), ": must be type ", @@ -67,6 +71,10 @@ combine <- function (variable, combinations=list(), ...) { ifelse(nvalidcats == 1, " category)", " categories)")) } } + + if (replace) { + attr(newvar, ".hide") <- self(variable) + } class(newvar) <- "VariableDefinition" return(newvar) } @@ -251,4 +259,4 @@ collapseCategories <- function (var, from, to) { var[var %in% from] <- to categories(var) <- categories(var)[!(cats %in% from)] return(var) -} \ No newline at end of file +} diff --git a/man/combine.Rd b/man/combine.Rd index c1d2e605d..48c6389b4 100644 --- a/man/combine.Rd +++ b/man/combine.Rd @@ -4,7 +4,7 @@ \alias{combine} \title{Combine categories or responses} \usage{ -combine(variable, combinations = list(), ...) +combine(variable, combinations = list(), ..., replace = FALSE) } \arguments{ \item{variable}{Categorical, Categorical Array, or Multiple Response @@ -12,24 +12,29 @@ variable} \item{combinations}{list of named lists containing \enumerate{ -\item "categories": category ids or names for categorical types, or for multiple response, -"responses": subvariable names, aliases, or positional indices; +\item "categories": category ids or names for categorical types, or for multiple +response, "responses": subvariable names, aliases, or positional indices; \item a "name" for the new category or response; and -\item optionally, other category ("missing", "numeric_value") or subvariable ("alias", "description") -attributes. If \code{combinations} is omitted, the resulting variable will -essentially be a copy (but see \code{\link[=copy]{copy()}} for a more natural way to copy variables. +\item optionally, other category ("missing", "numeric_value") or subvariable +("alias", "description") attributes. If \code{combinations} is omitted, the +resulting variable will essentially be a copy (but see \code{\link[=copy]{copy()}} for a more +natural way to copy variables. }} \item{...}{Additional variable metadata for the new derived variable} + +\item{replace}{Logical: should this derived variable, when added to the +dataset, take the place of the input \code{variable}, i.e. same folder/location? +If so, \code{variable} will also become "hidden".} } \value{ -A \code{\link{VariableDefinition}} that will create the new combined-category or --response derived variable. Categories/responses not referenced in \code{combinations} will be -appended to the end of the combinations. +A \code{\link{VariableDefinition}} that will create the new combined-category +or -response derived variable. Categories/responses not referenced in +\code{combinations} will be appended to the end of the combinations. } \description{ -Crunch allows you to create a new categorical variable by combining -the categories of another variable. For instance, you might want to +Create a new categorical or multiple-response variable by collapsing +the categories/responses of another. For instance, you might want to recode a categorical variable with three categories small, medium, and large to one that has just small and large. } diff --git a/tests/testthat/test-combine-categories.R b/tests/testthat/test-combine-categories.R index 5bb95459d..66924f533 100644 --- a/tests/testthat/test-combine-categories.R +++ b/tests/testthat/test-combine-categories.R @@ -194,6 +194,18 @@ with_test_authentication({ expect_identical(as.vector(ds$combined_pets2), as.vector(ds$q1)) }) + test_that("combine with replace=TRUE hides the original and puts new var in same folder", { + # Setup + ds <- refresh(ds) + folder(ds$combined_pets2) <- "A folder" + expect_identical(folder(ds$combined_pets2), "A folder") + expect_false("combined_pets2" %in% hiddenVariables(ds)) + + ds$comb3 <- combine(ds$combined_pets2, replace=TRUE) + expect_identical(folder(ds$comb3), "A folder") + expect_true("combined_pets2" %in% hiddenVariables(ds)) + }) + test_that("combine() with categorical array", { ds$combined_petloc <- combine(ds$petloc, name="Pet locations (combined)",