R/evaluate.r

In giupo/GrafoDB: simple ETL for timeseries in R

#' @include expr.r

evaluate_single_1 <- function(name, graph) {
  tsformula <- expr_impl(graph, name, echo = FALSE)
  nomi_padri <- upgrf(graph, name, livello = 1)
  if (length(nomi_padri) == 0 && is.null(tsformula)) {
    return(graph[[name]])
  }

  if (length(nomi_padri) > 1) {
    padri <- graph[[nomi_padri]]
  } else if (length(nomi_padri) == 1) {
    padri <- list()
    padri[[nomi_padri]] <- graph[[nomi_padri]]
  } else {
    padri <- list()
  }

  if (isElementary(graph, name)) {
    ## Se e' elementare cmq la carico (e' nato prima l'uovo o la gallina?)
    ## e la metto nei nomi_padri
    nomi_padri <- name
    tt <- tryCatch({
      ## sopprimo il warning perche' e' normale che non ci
      ## sia la serie elementare se la valuto per la prima volta
      suppressWarnings(graph[[name]])
    }, error = function(cond) {
      NA
    })
    padri[[name]] <- tt
    assign(name, tt)
  }

  cmd <- clutter_with_params_and_return(tsformula, name, nomi_padri)
  tryCatch({
    env <- as.environment(padri)
    # defines the proxy
    proxy <- NULL
    eval(parse(text = cmd))
    # executes the call
    env$proxy <- proxy
    env[[name]] <- do.call("proxy", padri, envir = env)
    # lookup the name in the env
    ret <- get(name, envir = env)
    if (is.call(ret) || is.function(ret)) {
      stop("evaluated as a function: check your function definition")
    }
    ret
  }, error = function(err) {
    stop(name, ": ", err)
  })
}


#' Evaluates a single object function identified with `name`
#'
#' @name evaluate_single
#' @param name `character` nome della serie
#' @param graph istanza di `GrafoDB`
#' @return la serie storica calcolata.

evaluate_single <- evaluate_single_1

#' Patch to evaluate
#'
#' @name evaluate_plain
#' @param x GrafoDB instance
#' @param ids object names to be evaluated
#' @returns GrafoDB with ids evaluated
#' @export
#' @note this is useful to evaluate the topological sort
#'   without multicore

evaluate_plain <- function(x, ids = names(x)) {
  # nocov start
  if (interactive())
    pb <- progress::progress_bar$new(total = length(ids),
      format = ":what [:bar] :current/:total :percent eta: :eta")
  # nocov end

  data <- x@data

  for (name in ids) {
    if (interactive()) pb$tick(tokens = list(what = name)) # nocov
    data[[name]] <- evaluate_single(name, x)
  }

  x@data <- data
  x@touched <- sort(unique(c(x@touched, hash::keys(data))))
  x
}


#' Implementazione del generic `evaluate` definito nel package `grafo`
#' per la classe `GrafoDB`
#'
#' @param object GrafoDB instance
#' @param v_start node to be evaluated, if `NULL` evaluates all nodes
#' @param ... eventual other params (like `debug`, for internal testing)
#' @return il grafo con i dati correttamente valutato
#' @rdname evaluate-internal
#' @include evaluate_by_roots.r evaluate_old.r

evaluate_impl <-  function(object, v_start = NULL, ...) {
  rutils::ifelse(
    is.null(getOption("GRAFODB_NEW_STRATEGY")),
    evaluate_old(object, v_start = v_start, ...),
    evaluate_by_roots(object, name = v_start, ...))
}