Merge pull request #458 from Crunch-io/flatline

first pass at creating flatline variables

Author: gergness

DESCRIPTION

@@ -137,6 +137,7 @@ Collate:
     'progress.R'
     'project-folder.R'
     'projects.R'
+    'row-distinct.R'
     'search.R'
     'session.R'
     'share.R'
@@ -171,3 +172,5 @@ Collate:
     'versions.R'
     'weight.R'
     'zcl.R'
+Remotes:  
+    rstudio/rmarkdown

NAMESPACE

@@ -252,6 +252,7 @@ export(restoreVersion)
 export(rmdir)
 export(rollup)
 export(rollupResolution)
+export(rowDistinct)
 export(rstandard)
 export(saveVersion)
 export(scoreCatToFeat)
@@ -269,6 +270,7 @@ export(shojiURL)
 export(shojifyDatasetMetadata)
 export(slideCategories)
 export(slides)
+export(straightlineResponse)
 export(streaming)
 export(subtitle)
 export(subtitles)

R/row-distinct.R

@@ -0,0 +1,45 @@
+#' Create variables useful for determining whether a row's values are suspicious
+#'
+#' `rowDistinct()` finds the number of unique values given per row of variables in an array
+#' `CrunchVariable`. `straightlineResponse()` returns a `selection` variable that indicates
+#' whether the responses are identical. When a row has all columns that are missing of the
+#' same type, it will return `Selected`, but will missing if any other number of values is missing
+#' (or there are multiple types of missing).
+#'
+#' @param x A `CrunchVariable`that is an an array, that unique values should be counted across.
+#' @param ... Optional attributes, like `name`, to set on the new variable (passed to `VarDef()`)
+#' @param na.rm Whether to count missing data as a separate category (all missing categories will be
+#' lumped together)
+#'
+#' @return A Variable Definition, which can be used to create a new `CrunchVariable`
+#' @export
+rowDistinct <- function(x, ..., na.rm = TRUE) {
+    if (!is.Array(x)) halt("x must be an array variable")
+
+    if (na.rm) {
+        unique_func <- function(x) length(unique(as.character(x[!is.na(x)])))
+    } else {
+        unique_func <- function(x) length(unique(as.character(x)))
+    }
+
+    VarDef(
+        apply(as.vector(x), 1, unique_func),
+        ...
+    )
+}
+
+#' @export
+#' @rdname rowDistinct
+straightlineResponse <- function(x, ...) {
+    if (!is.Array(x)) halt("x must be an array variable")
+
+    subvar_aliases <- aliases(subvariables(x))
+    if (length(subvar_aliases) == 1) stop("Array must have more than 1 subvariable.")
+    VarDef(
+        Reduce(
+            `&`,
+            lapply(subvar_aliases[-1], function(sv) x[[sv]] == x[[subvar_aliases[1]]])
+        ),
+        ...
+    )
+}

man/rowDistinct.Rd

@@ -0,0 +1,41 @@
+with_mock_crunch({
+    ds <- loadDataset("test ds")
+
+    test_that("rowDistinct works (na.rm = TRUE)", {
+        expect_equal(
+            rowDistinct(ds$catarray, name = "x"),
+            VarDef(
+                as.integer(c(2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 2)), # nolint
+                name = "x"
+            )
+        )
+    })
+
+    test_that("rowDistinct works (na.rm = FALSE)", {
+        expect_equal(
+            rowDistinct(ds$catarray, name = "x", na.rm = FALSE),
+            VarDef(
+                as.integer(c(2, 3, 2, 2, 2, 3, 2, 3, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 3, 1, 2, 1, 2, 2, 2)), # nolint
+                name = "x"
+            )
+        )
+    })
+
+    test_that("error for non-array var rowDistinct", {
+        expect_error(rowDistinct(ds$textvar), "x must be an array variable")
+    })
+
+    test_that("straightlineResponse works", {
+        expect_equal(
+            straightlineResponse(ds$catarray, name = "x"),
+            VarDef(
+                ds$catarray$subvar1 == ds$catarray$subvar2 & ds$catarray$subvar3 == ds$catarray$subvar2, #nolint
+                name = "x"
+            )
+        )
+    })
+
+    test_that("error for non-array var straightline", {
+        expect_error(straightlineResponse(ds$textvar), "x must be an array variable")
+    })
+})