Merge pull request #460 from Crunch-io/expr-as-methods

Expr as methods

Author: gergness

NAMESPACE

@@ -10,6 +10,7 @@ S3method(as.array,CrunchCube)
 S3method(as.array,CrunchCubeCalculation)
 S3method(as.array,MultitableResult)
 S3method(as.array,TabBookResult)
+S3method(as.character,CrunchExpr)
 S3method(as.character,CrunchVariable)
 S3method(as.data.frame,BatchCatalog)
 S3method(as.data.frame,CrunchDataFrame)
@@ -18,6 +19,7 @@ S3method(as.data.frame,FilterCatalog)
 S3method(as.data.frame,ShojiCatalog)
 S3method(as.data.frame,UserCatalog)
 S3method(as.data.frame,VariableCatalog)
+S3method(as.double,CrunchExpr)
 S3method(as.double,CrunchVariable)
 S3method(as.list,CrunchDataset)
 S3method(as.list,OrderGroup)

R/variable-as-methods.R

@@ -29,7 +29,7 @@
 #' @param ... additional arguments for `as.character` and `as.numeric`, ignored when used with
 #' Crunch variables
 #'
-#' @return a `VariableDefinition` to be used as the derivation
+#' @return a `CrunchExpr` to be used as the derivation
 #'
 #' @examples
 #' \dontrun{
@@ -138,3 +138,71 @@ as.double.CrunchVariable <- function(x, ...) as.Numeric(x)
 #' @rdname variable-as-methods
 #' @export
 as.character.CrunchVariable <- function(x, ...) as.Text(x)
+
+# Expressions ----
+#' @rdname variable-as-methods
+#' @export
+setMethod("as.Numeric", "CrunchExpr", function(x) {
+    return(zfuncExpr("cast", x, "numeric"))
+})
+
+#' @rdname variable-as-methods
+#' @export
+setMethod("as.Text", "CrunchExpr", function(x, format) {
+    # format is for DateTimes only, but we have to rely on user
+    # doing this correctly because we can't tell for an expression
+    if (!missing(format)) {
+        return(zfuncExpr("format_datetime", x, list(value = format)))
+    }
+
+    return(zfuncExpr("cast", x, "text"))
+})
+
+#' @rdname variable-as-methods
+#' @export
+setMethod("as.Categorical", "CrunchExpr", function(x, format) {
+    # format is for DateTimes only, but we have to rely on user
+    # doing this correctly because we can't tell for an expression
+    # no direct datetime to cat ZCL function, so must format first then cast
+    if (!missing(format)) {
+        x <- zfunc("format_datetime", x, list(value = format))
+    }
+
+    return(zfuncExpr("cast", x, "categorical"))
+})
+
+#' @rdname variable-as-methods
+#' @export
+setMethod(
+    "as.Datetime", "CrunchExpr",
+    function(x, format, resolution, offset) {
+        # datetimes are special, so each source type must be determined
+        # resolution non-missing indicate numeric
+        # format non-missing indicates categorical/text
+        if (missing(format) & !missing(resolution)) {
+            validateResolution(resolution)
+
+            args <- list("numeric_to_datetime", x, list(value = resolution))
+            if (!missing(offset)) {
+                args <- append(args, list(list(value = offset)))
+            }
+
+            return(do.call(zfuncExpr, args))
+        } else if (!missing(format) & missing(resolution) & missing(offset)) {
+            return(zfuncExpr("parse_datetime", x, list(value = format)))
+        }
+
+        halt(
+            "Invalid arguments to `as.Datetime`. Must provide either `resolution` for Numeric ",
+            "expressions or `format` for Categorical/Text expressions."
+        )
+    }
+)
+
+#' @rdname variable-as-methods
+#' @export
+as.double.CrunchExpr <- function(x, ...) as.Numeric(x)
+
+#' @rdname variable-as-methods
+#' @export
+as.character.CrunchExpr <- function(x, ...) as.Text(x)

man/variable-as-methods.Rd

@@ -173,6 +173,70 @@ with_mock_crunch({
     })
 })
 
+test_that("cast expressions modifies zcl expression", {
+    # simple expression, which we'll reuse even if it wouldn't actually work in
+    # a real cast
+    this_expr <- CrunchExpr(expression = zfunc("now"))
+
+    expect_equal(
+        as.Numeric(this_expr),
+        CrunchExpr(expression = zfunc("cast", this_expr, "numeric"))
+    )
+
+    expect_equal(
+        as.Text(this_expr),
+        CrunchExpr(expression = zfunc("cast", this_expr, "text"))
+    )
+
+    expect_equal(
+        as.Text(this_expr, format = "%Y-%m-%d %H:%M:%S"),
+        CrunchExpr(
+            expression = zfunc("format_datetime", this_expr, list(value = "%Y-%m-%d %H:%M:%S"))
+        )
+    )
+
+    expect_equal(
+        as.Categorical(this_expr),
+        CrunchExpr(expression = zfunc("cast", this_expr, "categorical"))
+    )
+
+    expect_equal(
+        as.Categorical(this_expr, format = "%Y-%m-%d %H:%M:%S"),
+        CrunchExpr(
+            expression = zfunc(
+                "cast",
+                zfunc("format_datetime", this_expr, list(value = "%Y-%m-%d %H:%M:%S")),
+                "categorical"
+            )
+        )
+    )
+
+    expect_equal(
+        as.Datetime(this_expr, format = "%Y-%m-%d %H:%M:%S"),
+        CrunchExpr(
+            expression = zfunc("parse_datetime", this_expr, list(value = "%Y-%m-%d %H:%M:%S"))
+        )
+    )
+
+    expect_equal(
+        as.Datetime(this_expr, resolution = "D", offset = "1975-01-01"),
+        CrunchExpr(
+            expression = zfunc(
+                "numeric_to_datetime", this_expr, list(value = "D"), list(value = "1975-01-01")
+            )
+        )
+    )
+
+    expect_error(as.Datetime(this_expr), "Invalid arguments to `as.Datetime`")
+
+    # R base aliases
+    expect_equal(as.Numeric(this_expr), as.numeric(this_expr))
+    expect_equal(as.Text(this_expr), as.character(this_expr))
+})
+
+
+
+
 with_test_authentication({
     ds <- newDataset(df)
     # make a text variable with numbers
@@ -317,4 +381,24 @@ with_test_authentication({
             cubify(10, 11, dims = list(v4 = list("B", "C")))
         )
     })
+
+    test_that("categorical expression to numeric", {
+        ds$v3_gt_ten_num <- as.Numeric(ds$v3 > 10)
+        expect_true(is.derived(ds$v3_gt_ten_num))
+        expect_true(is.Numeric(ds$v3_gt_ten_num))
+        expect_equal(
+            as.vector(ds$v3_gt_ten_num),
+            as.numeric(as.vector(ds$v3 > 10))
+        )
+    })
+
+    test_that("numeric expression to text", {
+        ds$v3_plus_one_text <- as.Text(ds$v3 + 1)
+        expect_true(is.derived(ds$v3_plus_one_text))
+        expect_true(is.Text(ds$v3_plus_one_text))
+        expect_equal(
+            as.vector(ds$v3_plus_one_text),
+            sprintf("%1.1f", as.vector(ds$v3 + 1))
+        )
+    })
 })