Nothing
#' Get or set a derived variable's expression
#'
#' Get a derived variable's derivation formula as a [CrunchExpr][expressions] with
#' `derivation(variable)`. Set (change) a derived variable's derivation with
#' `derivation(variable) <- expression`.
#'
#' To break a derivation link between a derived variable and the originating variable, set
#' the derivation value of the derived variable to `NULL` with `derivation(variable) <- NULL`
#'
#' `is.derived` can be used to see if a variable is derived or not. Additionally
#' setting a derived variable's `is.derived` to `FALSE` will break the derivation link between
#' two variables.
#'
#' @param x a variable
#' @param value a `CrunchExpr` to be used as the derivation (for the setter
#' only) or `NULL` to integrate a derived variable. For `is.derived`, `FALSE`
#' can be used to integrate a derived variable.
#'
#' @return a `CrunchExpr` of the derivation for `derivation`; a logical for
#' `is.derived`; the variable given in `x` for `is.derived<-` returns
#'
#' @examples
#' \dontrun{
#'
#' ds$derived_v1 <- ds$v1 + 5
#'
#' derivation(ds$derived_v1)
#' # Crunch expression: v1 + 5
#'
#' derivation(ds$derived_v1) <- ds$v1 + 10
#' derivation(ds$derived_v1)
#' # Crunch expression: v1 + 10
#'
#' is.derived(ds$derived_v1)
#' # TRUE
#'
#' # to integrate or instantiate the variable in place (remove the link between
#' # variable v1 and the derivation) you can:
#' derivation(ds$derived_v1) <- NULL
#'
#' # after integrating, the derived variable is no longer derived.
#' is.derived(ds$derived_v1)
#' # FALSE
#'
#' # Derivations can be updated with arbitrary expressions.
#' # Consider a numeric case variable that combines weights
#' # calculated separately in a separate variable
#' # for each of several waves:
#' ds$weight <- makeCaseWhenVariable(
#' ds$wave == 1 ~ ds$weight_wave1,
#' ds$wave == 2 ~ ds$weight_wave2,
#' ds$wave == 3 ~ ds$weight_wave3,
#' name = "Weight"
#' )
#'
#' # When a new wave is added, update the derivation
#' # of the weight to add the new condition and source
#' # column.
#' derivation(ds$weight) <- caseWhenExpr(
#' ds$wave == 1 ~ ds$weight_wave1,
#' ds$wave == 2 ~ ds$weight_wave2,
#' ds$wave == 3 ~ ds$weight_wave3,
#' ds$wave == 4 ~ ds$weight_wave4
#' )
#' }
#' @name derivations
#' @aliases derivation derivation<-
NULL
#' @export
#' @rdname derivations
setMethod("derivation", "CrunchVariable", function(x) {
if (!is.derived(x)) {
return(NULL)
}
expr <- CrunchExpr(expression = entity(x)@body$derivation)
# self(x) is needed and not variableCatalog because the variables are stored
# as '../varid/' and when absoluteURL concats them, the varid from self(x)
# is automatically removed.
expr@expression <- absolutifyVariables(expr@expression, self(x))
return(expr)
})
absolutifyVariables <- function(expr, base.url) {
if (is.list(expr)) {
# Recurse.
lists <- vapply(expr, is.list, logical(1))
expr[lists] <- lapply(expr[lists], absolutifyVariables, base.url)
# For others, look for "variable" references
if (length(names(expr))) {
vars <- names(expr) %in% "variable"
expr[!lists & vars] <- lapply(expr[!lists & vars], absoluteURL, base.url)
return(expr)
}
}
return(expr)
}
#' @export
#' @rdname derivations
setMethod("derivation<-", c("CrunchVariable", "ANY"), function(x, value) {
if (!is.derived(x)) {
halt("The variable ", dQuote(name(x)), " must already be a derived variable.")
}
if (!is.CrunchExpr(value)) {
halt(
"The value ", dQuote(substitute(value)), " must be a CrunchExpr, got a ",
class(value), " instead."
)
}
payload <- toJSON(list(derivation = value@expression))
crPATCH(self(x), body = payload)
## Refresh and return
dropCache(datasetReference(x))
return(invisible(refresh(x)))
})
# sets derived to FALSE, which integrates / instantiates the variable's values
# silently takes and discards `value` to make method dispatch easier
integrateDerivedVar <- function(x, value) {
if (is.derived(x)) {
payload <- toJSON(list(derived = FALSE))
crPATCH(self(x), body = payload)
## Refresh and return
dropCache(datasetReference(x))
x <- refresh(x)
}
return(invisible(x))
}
#' @export
#' @rdname derivations
setMethod("derivation<-", c("CrunchVariable", "NULL"), integrateDerivedVar)
#' @rdname derivations
#' @aliases is.derived
#' @export
setMethod("is.derived", "CrunchVariable", function(x) {
isTRUE(tuple(x)$derived)
})
#' @rdname derivations
#' @aliases is.derived<-
#' @export
setMethod("is.derived<-", c("CrunchVariable", "logical"), function(x, value) {
if (!isTRUE(value)) {
x <- integrateDerivedVar(x, value)
} else if (!is.derived(x)) {
halt(
"can't change a non-derived variable into a derived one with ",
"is.derived()."
)
}
return(x)
})
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.