R/ser.r

In giupo/GrafoDB: simple ETL for timeseries in R

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
}