R/evaluate_old.r

In giupo/GrafoDB: simple ETL for timeseries in R

#' 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

evaluate_old <- function(object, v_start = NULL, ...) { # nolint
  params <- list(...)

  debug <- rutils::ifelse("debug" %in% names(params),
    as.logical(params[["debug"]]),
    FALSE)

  tag <- object@tag
  data <- object@data
  functions <- object@functions
  network <- object@network
  all_names <- names(object)

  if (!all(v_start %in% all_names)) {
    not_in_graph <- setdiff(v_start, all_names)
    stop("Not in graph: ", paste(not_in_graph, collapse = ", "))
  }

  ## preload primitive
  primitive <- listPrimitives(object)

  if (!is.null(v_start)) {
    v_start <- as.character(v_start)
    network <- igraph::induced.subgraph(
      network,
      igraph::V(network)[
        unlist(igraph::neighborhood(
          network, order = .Machine$integer.max,
          nodes = v_start, mode = "out")
        )])
  }

  ## se il network e' vuoto dopo l'eliminazione delle sorgenti,
  ## ritorno senza fare nulla

  total <- length(igraph::V(network))
  if (total == 0) {
    return(invisible(object))
  }

  is_interactive <- interactive()
  # nocov start
  pb <- progress::progress_bar$new(
    format = ":what [:bar] :current/:total :percent eta: :eta", total = total)
  # nocov end

  next_layer <- function(network) {
    igraph::V(network)[igraph::degree(network, mode = "in") == 0]
  }

  sources_id <- next_layer(network)

  proxy <- function(name, object) {
    serie <- evaluate_single(name, object)
    ret <- list()
    ret[[name]] <- serie
    ret
  }

  while (length(sources_id)) {
    sources <- igraph::V(network)[sources_id]$name
    sources_primitive <- intersect(sources, primitive)

    if (length(sources_primitive)) {
      pb$tick(length(sources_primitive),
        tokens = list(what = utils::tail(sources_primitive)))
    }

    prim_non_in_data <- setdiff(sources_primitive, hash::keys(data))
    prim_non_in_data <- setdiff(prim_non_in_data, hash::keys(functions))
    if (length(prim_non_in_data)) {
      datip <- object[prim_non_in_data]
      for (n in names(datip)) {
        data[n] <- datip[[n]]
      }
    }

    sources <- setdiff(sources, sources_primitive)

    if (length(sources)) {
      name <- NULL
      evaluated <- foreach::`%dopar%`(
        foreach::foreach(name = sources, .combine = c), {
        proxy(name, object)
      })

      if (is_interactive) { # nocov start
        pb$tick(
          length(sources),
          tokens = list(what = utils::tail(names(evaluated))))
      } # nocov end

      if (length(evaluated) == 1) {
        data[[names(evaluated)]] <- evaluated[[names(evaluated)]]
      } else {
        data[names(evaluated)] <- evaluated
      }
    }

    network <- igraph::delete.vertices(network, sources_id)
    sources_id <- next_layer(network)
  }

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