R/evaluate_by_roots.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_by_roots <- function(x, name = NULL, ...) {
  all_names <- names(x)

  # verifica che tutti i name siano nel grafo, altrimeti errore
  if (!all(name %in% all_names)) {
    not_in_graph <- setdiff(name, all_names)
    stop("Not in graph: ", paste(not_in_graph, collapse = ", "))
  }

  # definisce un unita' di calcolo (per foreach)
  proxy <- function(name, object) {
    serie <- evaluate_single(name, object)
    ret <- list()
    ret[[name]] <- serie
    ret
  }

  # definisce il network su cui lavorare: se non ho passato name,
  # prende tutto il network di x, altrimenti fa un induced.subgraph,
  # ovvero un sottografo con tutti archi connessi tra i nodi passati
  # con name
  network <- if (is.null(name)) {
    x@network
  } else {
    vicinato <- igraph::neighborhood(
      x@network,
      order = .Machine$integer.max,
      nodes = name, mode = "out")

    vertex_ids <- igraph::V(x@network)[unlist(vicinato)]
    igraph::induced.subgraph(x@network, vertex_ids)
  }


  # PerformanceFix
  # escludo le primitive dalle radici perche' inutile valutarle.
  # trick per far lavorare le elementari
  sources <- .roots(network)
  primitive <- .list_primitives(x, sources = sources)
  network <- rutils::ifelse(length(primitive),
    igraph::delete.vertices(network, primitive),
    network)

  # calcolo il numero totale del nuovo grafo, se zero ritorno
  total <- length(igraph::V(network))
  if (total == 0) return(invisible(x))

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


  # estrarre le radici, di nuovo se ho eliminato le primitive
  sources <- .roots(network)
  data <- x@data
  while (length(sources)) {
    name <- NULL

    # valuta le radici (aka nodi senza archi entrati)
    evaluated <- foreach::`%dopar%`(
      foreach::foreach(name = sources,
        .combine = c), {
      proxy(name, x)
    })

    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
    }

    # elimina i nodi appena valutati e ricacola le radici
    network <- igraph::delete.vertices(network, sources)
    sources <- .roots(network)
  }

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