ser_impl <- function(x, name, debug=FALSE) {
## that's the dumbest thing in my life, inverting arguments.
if (!debug) {
ser_impl_nodebug(x, name)
} else { # nocov start
task <- expr(x, name, echo = FALSE)
if (is.null(task)) {
if (name %in% names(x)) {
stop(name, " non e' una serie con formula")
} else {
stop(name, " non e' una serie del grafo")
}
}
func_name <- paste0(name, "_func")
nomi_padri <- deps(x, name)
func_content <- function_as_string(
task, name, nomi_padri, func_name = func_name)
## create function in current environment & debug it
filetmp <- tempfile(pattern = name, fileext = ".R")
on.exit(file.remove(filetmp), add = TRUE)
write(func_content, file = filetmp)
source(filetmp)
debug(func_name)
# define ancestors in current env.
padri <- rutils::ifelse(is.null(nomi_padri) || length(nomi_padri) == 0,
list(),
x[[nomi_padri]])
if (length(nomi_padri) == 1) {
## boxing
ppp <- list()
ppp[[nomi_padri]] <- padri
padri <- ppp
}
for(padre in names(padri)) {
assign(padre, padri[[padre]])
}
## dovete mori' male
params <- paste("(", paste(names(padri), collapse=", "), ")")
eval(parse(text = paste0(func_name, params)))
} # nocov end
}
ser_impl_nodebug <- function(x, name) {
## that's the dumbest thing in my life, inverting arguments.
ret <- evaluate_single(name, x)
if (!stats::is.ts(ret)) {
stop(name, " non e' un oggetto ts")
}
ret
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.