diff --git a/R/AllGenerics.R b/R/AllGenerics.R index f863ce66a..ee29445bc 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -8,9 +8,9 @@ setGeneric("is.selected<-", function (x, value) standardGeneric("is.selected<-") setGeneric("ids", function (x) standardGeneric("ids")) setGeneric("ids<-", function (x, value) standardGeneric("ids<-")) -setGeneric("is.dichotomized", function (x) standardGeneric("is.dichotomized")) -setGeneric("dichotomize", function (x, i) standardGeneric("dichotomize")) -setGeneric("undichotomize", function (x) standardGeneric("undichotomize")) +setGeneric("is.dichotomized", function (categories) standardGeneric("is.dichotomized")) +setGeneric("dichotomize", function (categories, selection) standardGeneric("dichotomize")) +setGeneric("undichotomize", function (categories) standardGeneric("undichotomize")) setGeneric("value", function (x) standardGeneric("value")) setGeneric("value<-", function (x, value) standardGeneric("value<-")) setGeneric("name", function (x) standardGeneric("name")) diff --git a/R/dichotomize.R b/R/dichotomize.R index d90b26ac3..f6049812b 100644 --- a/R/dichotomize.R +++ b/R/dichotomize.R @@ -7,8 +7,8 @@ #' `undichotomize` strips that selection information. Dichotomize converts #' a Categorical Array to a Multiple Response, and undichotomize does the reverse. #' -#' @param x Categories or a Variable subclass that has Categories -#' @param i For the `dichotomize` methods, the numeric or logical indices +#' @param categories Categories or a Variable subclass that has Categories +#' @param selection For the `dichotomize` methods, the numeric or logical indices #' of the categories to mark as "selected", or if character, the Category #' "names". Note that unlike some other categorical variable methods, #' numeric indices are positional, not with reference to category ids. @@ -16,17 +16,27 @@ #' @name dichotomize #' @aliases dichotomize is.dichotomized undichotomize #' @seealso [`describe-category`] +#' @examples +#' \dontrun{ +#' ds$sub1 <- factor(1:nrow(ds)) +#' ds$sub2 <- factor(1:nrow(ds)) +#' ds$arr <- makeArray(ds[, c("sub1", "sub2")], "array") +#' ds$arr <- dichotomize(ds$arr, 3) +#' class(ds$arr) +#' ds$arr <- undichotomize(ds$arr) +#' class(ds$arr) +#' } NULL #' @rdname dichotomize #' @export setMethod("is.dichotomized", "Categories", - function (x) any(vapply(x, is.selected, logical(1)))) + function (categories) any(vapply(categories, is.selected, logical(1)))) -.dichotomize.categories <- function (x, i) { +.dichotomize.categories <- function (categories, selection) { ## Internal method for dichtomizing Categories (or lists) - is.selected(x[i]) <- TRUE - return(x) + is.selected(categories[selection]) <- TRUE + return(categories) } #' @rdname dichotomize @@ -37,35 +47,35 @@ setMethod("dichotomize", c("Categories", "numeric"), .dichotomize.categories) setMethod("dichotomize", c("Categories", "logical"), .dichotomize.categories) #' @rdname dichotomize #' @export -setMethod("dichotomize", c("Categories", "character"), function (x, i) { - ind <- names(x) %in% i +setMethod("dichotomize", c("Categories", "character"), function (categories, selection) { + ind <- names(categories) %in% selection if (!any(ind)) { halt("Category not found") ## make nicer error message } - return(dichotomize(x, ind)) + return(dichotomize(categories, ind)) }) #' @rdname dichotomize #' @export -setMethod("undichotomize", "Categories", function (x) { - is.selected(x) <- FALSE - return(x) +setMethod("undichotomize", "Categories", function (categories) { + is.selected(categories) <- FALSE + return(categories) }) -.dichotomize.var <- function (x, i) { - newcats <- dichotomize(categories(x), i) - categories(x) <- newcats +.dichotomize.var <- function (categories, selection) { + newcats <- dichotomize(categories(categories), selection) + categories(categories) <- newcats if (is.dichotomized(newcats)) { ## Do this to avoid needing to refresh the variable catalog - x@tuple@body$type <- "multiple_response" + categories@tuple@body$type <- "multiple_response" } - invisible(CrunchVariable(tuple(x))) + invisible(CrunchVariable(tuple(categories))) } -.undichotomize.var <- function (x) { - categories(x) <- undichotomize(categories(x)) +.undichotomize.var <- function (categories) { + categories(categories) <- undichotomize(categories(categories)) ## Do this to avoid needing to refresh the variable catalog - x@tuple@body$type <- "categorical_array" - invisible(CrunchVariable(tuple(x))) + categories@tuple@body$type <- "categorical_array" + invisible(CrunchVariable(tuple(categories))) } #' @rdname dichotomize diff --git a/man/dichotomize.Rd b/man/dichotomize.Rd index 188fc4b3e..f11f18ffe 100644 --- a/man/dichotomize.Rd +++ b/man/dichotomize.Rd @@ -16,28 +16,28 @@ \alias{undichotomize,CategoricalArrayVariable-method} \title{Indicate how categories represent a dichotomized value} \usage{ -\S4method{is.dichotomized}{Categories}(x) +\S4method{is.dichotomized}{Categories}(categories) -\S4method{dichotomize}{Categories,numeric}(x, i) +\S4method{dichotomize}{Categories,numeric}(categories, selection) -\S4method{dichotomize}{Categories,logical}(x, i) +\S4method{dichotomize}{Categories,logical}(categories, selection) -\S4method{dichotomize}{Categories,character}(x, i) +\S4method{dichotomize}{Categories,character}(categories, selection) -\S4method{undichotomize}{Categories}(x) +\S4method{undichotomize}{Categories}(categories) -\S4method{dichotomize}{CategoricalVariable,ANY}(x, i) +\S4method{dichotomize}{CategoricalVariable,ANY}(categories, selection) -\S4method{dichotomize}{CategoricalArrayVariable,ANY}(x, i) +\S4method{dichotomize}{CategoricalArrayVariable,ANY}(categories, selection) -\S4method{undichotomize}{CategoricalVariable}(x) +\S4method{undichotomize}{CategoricalVariable}(categories) -\S4method{undichotomize}{CategoricalArrayVariable}(x) +\S4method{undichotomize}{CategoricalArrayVariable}(categories) } \arguments{ -\item{x}{Categories or a Variable subclass that has Categories} +\item{categories}{Categories or a Variable subclass that has Categories} -\item{i}{For the \code{dichotomize} methods, the numeric or logical indices +\item{selection}{For the \code{dichotomize} methods, the numeric or logical indices of the categories to mark as "selected", or if character, the Category "names". Note that unlike some other categorical variable methods, numeric indices are positional, not with reference to category ids.} @@ -54,6 +54,17 @@ or more categories are set as "selected". These methods allow you set that state \code{undichotomize} strips that selection information. Dichotomize converts a Categorical Array to a Multiple Response, and undichotomize does the reverse. } +\examples{ +\dontrun{ +ds$sub1 <- factor(1:nrow(ds)) +ds$sub2 <- factor(1:nrow(ds)) +ds$arr <- makeArray(ds[, c("sub1", "sub2")], "array") +ds$arr <- dichotomize(ds$arr, 3) +class(ds$arr) +ds$arr <- undichotomize(ds$arr) +class(ds$arr) +} +} \seealso{ \code{\link{describe-category}} } diff --git a/tests/testthat/test-flip-array.R b/tests/testthat/test-flip-array.R index 011896151..a0a7cf3c4 100644 --- a/tests/testthat/test-flip-array.R +++ b/tests/testthat/test-flip-array.R @@ -17,7 +17,6 @@ with_test_authentication({ }) ds <- addVariables(ds, newvars) test_that("The flipped variables are created", { - print(names(ds)) expect_true(all(c("Home, flipped", "Work, flipped", "Pet, flipped") %in% names(variables(ds)))) expect_true(all(c("Home, flipped", "Work, flipped", "Pet, flipped") %in% names(ds))) expect_identical(names(subvariables(ds[["Home, flipped"]])),