Derive a replacement variable

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 = ", ")
         )
     }
-}
+}

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)
-}
+}

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)",