Nothing
context("Make a derived variable with a new type")
with_mock_crunch({
ds <- cachedLoadDataset("test ds")
save_over_error <- paste0(
"A variable cannot be updated with a derivation that changes its ",
"type. Are you trying to overwrite a variable with a derivation ",
"of itself to change the type? If so, you might want to use ",
"`type(ds$variable)<-` instead."
)
test_that("as.* catches arrays", {
# arrays are incompatible on the server, but the error message isn't helpful
expect_error(as.Text(ds$mymrset),
"Array-like variables can't be used with function `as.Text()`.",
fixed = TRUE
)
expect_error(as.Numeric(ds$catarray),
"Array-like variables can't be used with function `as.Numeric()`.",
fixed = TRUE
)
})
test_that("as.Datetime catches unknown variable types", {
# fake the variable type because all types so far are covered, but new
# types won't be, so make sure we catch those.
fake_var <- ds$birthyr
class(fake_var) <- "CrunchVariable"
fake_var@tuple@body$type <- "not a real type"
expect_false(is.Numeric(fake_var))
expect_error(
as.Datetime(fake_var),
paste0(
"Can't derive Datetime variables from .*not a real",
" type.* variables."
)
)
})
test_that("numeric to text", {
var_def <- as.Text(ds$birthyr)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr("cast", ds$birthyr, "text"))
# check the as.character alias
expect_equal(var_def, as.character(ds$birthyr))
expect_error(ds$birthyr <- var_def, save_over_error, fixed = TRUE)
})
test_that("text to numeric", {
var_def <- as.Numeric(ds$textVar)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr("cast", ds$textVar, "numeric"))
# check the as.numeric alias
expect_equal(var_def, as.numeric(ds$textVar))
expect_error(ds$textVar <- var_def, save_over_error, fixed = TRUE)
})
test_that("text to categorical", {
var_def <- as.Categorical(ds$textVar)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr("cast", ds$textVar, "categorical"))
expect_error(ds$textVar <- var_def, save_over_error, fixed = TRUE)
})
test_that("datetime to categorical", {
var_def <- as.Categorical(ds$starttime)
expect_is(var_def, "CrunchExpr")
expect_equal(
var_def,
zfuncExpr(
"cast",
zfunc(
"format_datetime", ds$starttime,
list(value = "%Y-%m-%d %H:%M:%S")
),
"categorical"
)
)
expect_error(ds$starttime <- var_def, save_over_error, fixed = TRUE)
})
test_that("datetime to numeric", {
var_def <- as.Numeric(ds$starttime)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr("datetime_to_numeric", ds$starttime))
expect_error(ds$starttime <- var_def, save_over_error, fixed = TRUE)
})
test_that("datetime to text", {
var_def <- as.Text(ds$starttime)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"format_datetime", ds$starttime,
list(value = "%Y-%m-%d %H:%M:%S")
))
var_def <- as.Text(ds$starttime, format = "%Y-%m-%d")
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"format_datetime", ds$starttime,
list(value = "%Y-%m-%d")
))
# as.Text uses rollup resolution to determine the default format
var_ref <- ds$starttime
var_ref@tuple@body$rollup_resolution <- "M"
var_def <- as.Text(var_ref)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"format_datetime", var_ref,
list(value = "%Y-%m")
))
var_ref@tuple@body$rollup_resolution <- "W"
var_def <- as.Text(var_ref)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"format_datetime", var_ref,
list(value = "%Y W%W")
))
expect_error(ds$starttime <- var_def, save_over_error, fixed = TRUE)
})
test_that("numeric to datetime", {
var_def <- as.Datetime(ds$birthyr, resolution = "Y")
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"numeric_to_datetime", ds$birthyr,
list(value = "Y")
))
# this time with an offset
var_def <- as.Datetime(ds$birthyr,
resolution = "Y",
offset = "1975-01-01"
)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"numeric_to_datetime", ds$birthyr,
list(value = "Y"),
list(value = "1975-01-01")
))
expect_error(ds$birthyr <- var_def, save_over_error, fixed = TRUE)
})
test_that("text to datetime", {
var_def <- as.Datetime(ds$textVar)
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"parse_datetime", ds$textVar,
list(value = "%Y-%m-%d %H:%M:%S")
))
var_def <- as.Datetime(ds$textVar, format = "%Y")
expect_is(var_def, "CrunchExpr")
expect_equal(var_def, zfuncExpr(
"parse_datetime", ds$textVar,
list(value = "%Y")
))
expect_error(ds$textVar <- var_def, save_over_error, fixed = TRUE)
})
})
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
ds$num_as_text <- as.character(c(1:20))
test_that("numeric to text", {
ds$v1_text <- as.Text(ds$v1)
expect_true(is.derived(ds$v1_text))
expect_true(is.Text(ds$v1_text))
expect_equal(
as.vector(ds$v1_text),
as.character(as.vector(ds$v1))
)
# alias to R's function names
expect_equal(as.character(ds$v1), as.Text(ds$v1))
})
test_that("text to numeric", {
ds$num_as_text_num <- as.Numeric(ds$num_as_text)
expect_true(is.derived(ds$num_as_text_num))
expect_true(is.Numeric(ds$num_as_text_num))
expect_equal(
as.vector(ds$num_as_text_num),
as.numeric(as.vector(ds$num_as_text))
)
# if there aren't numbers in the text, the result should be NA
ds$v2_num <- as.Numeric(ds$v2)
expect_true(is.derived(ds$v2_num))
expect_true(is.Numeric(ds$v2_num))
expect_equal(
as.vector(ds$v2_num),
expect_warning(
as.numeric(as.vector(ds$v2)),
"NAs introduced by coercion"
)
)
# alias to R's function names
expect_equal(as.numeric(ds$v1), as.Numeric(ds$v1))
})
test_that("text to categorical", {
ds$v2_cat <- as.Categorical(ds$v2)
expect_true(is.derived(ds$v2_cat))
expect_true(is.Categorical(ds$v2_cat))
expect_equal(
as.vector(ds$v2_cat),
as.factor(as.vector(ds$v2))
)
})
test_that("datetime to numeric", {
ds$v5_num <- as.Numeric(ds$v5)
expect_true(is.derived(ds$v5_num))
expect_true(is.Numeric(ds$v5_num))
expect_equal(
as.vector(ds$v5_num),
as.numeric(as.vector(ds$v5))
)
})
test_that("datetime to text", {
ds$v5_text <- as.Text(ds$v5)
expect_true(is.derived(ds$v5_text))
expect_true(is.Text(ds$v5_text))
expect_equal(
as.vector(ds$v5_text),
format(as.vector(ds$v5), format = "%Y-%m-%d %H:%M:%S")
)
})
test_that("datetime to categorical", {
ds$v5_cat <- as.Categorical(ds$v5)
expect_true(is.derived(ds$v5_cat))
expect_true(is.Categorical(ds$v5_cat))
expect_equal(
as.vector(ds$v5_cat),
as.factor(
format(as.vector(ds$v5), format = "%Y-%m-%d %H:%M:%S")
)
)
})
test_that("text to datetime", {
ds$text_times <- as.Text(ds$v5, format = "%Y-%m-%d")
expect_true(is.Text(ds$text_times))
ds$times_from_text <- as.Datetime(ds$text_times, format = "%Y-%m-%d")
expect_true(is.derived(ds$times_from_text))
expect_true(is.Datetime(ds$times_from_text))
expect_equal(
as.vector(ds$times_from_text),
as.vector(ds$v5)
)
})
test_that("numeric to datetime", {
ds$num_times <- as.numeric(as.vector(ds$v5))
ds$times_from_num <- as.Datetime(ds$num_times, resolution = "D")
expect_true(is.derived(ds$times_from_num))
expect_true(is.Datetime(ds$times_from_num))
expect_equal(
as.vector(ds$times_from_num),
as.vector(ds$v5)
)
# different resolutions and offsets change the result
ds$num_times_secs <- rep(365 * 24 * 60 * 60, 20)
ds$times_from_secs <- as.Datetime(ds$num_times_secs,
resolution = "s",
offset = "1975-01-01"
)
expect_true(is.derived(ds$times_from_secs))
expect_true(is.Datetime(ds$times_from_secs))
expect_equal(
as.vector(ds$times_from_secs),
as.POSIXlt(rep("1976-01-01", 20), tz = "UTC")
)
ds$num_times_years <- rep(1, 20)
ds$times_from_years <- as.Datetime(ds$num_times_years, resolution = "Y")
expect_true(is.derived(ds$times_from_years))
expect_true(is.Datetime(ds$times_from_years))
# need rollup() here because as.vector doesn't currently support other rollups
expect_equal(
as.vector(rollup(ds$times_from_years, "D")),
as.Date(rep("1971-01-01", 20))
)
})
test_that("casting in a CrunchCubes returns expected values", {
cube <- crtabs(~ as.Categorical(v2), ds)
expect_equal(dimensions(cube)[[1]]$references$type, "categorical")
cube <- crtabs(~ as.Numeric(num_as_text), ds)
expect_equal(dimensions(cube)[[1]]$references$type, "enum")
cube <- crtabs(mean(as.Numeric(num_as_text)) ~ v4, ds)
expect_equivalent(
as.array(cube),
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))
)
})
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.