R/amostragem.R

In jtrecenti/ea2:

amostrar_n <- function(bn, n) {
  o <- bnlearn:::schedule(bn)
  res <- list()
  pa <- NULL
  for (i in seq_along(o)) {
    pa <- res[bn[[o[i]]]$parents]
    if (length(pa) == 0) {
      res[[o[i]]] <- amostrar_node(bn[[o[i]]], n)
    } else {
      res[[o[i]]] <- amostrar_node(bn[[o[i]]], dplyr::as_data_frame(pa))
    }
  }
  dplyr::as_data_frame(res)
}

#' Se pa for nulo, será n
amostrar_node <- function(node, pa) {
  classes <- unique(node$cpt[[node$node]])
  if(ncol(node$cpt) == 2) {
    classes[LaplacesDemonCpp::rcat(pa, node$cpt$factor)]
  } else {
    probs <- tidyr::spread_(node$cpt, node$node, 'factor')
    d <- dplyr::select(dplyr::inner_join(pa, probs, names(pa)), one_of(classes))
    m <- as.matrix(d)
    classes[LaplacesDemonCpp::rcat(nrow(m), m)]
  }
}

inferencia_logic_sampling <- function(bn, Q, E, n = 100) {
  E_var <- sapply(stringr::str_match_all(as.character(E), '(X[0-9]+) ?=='),
                  function(x) x[, 2])
  Q_var <- sapply(stringr::str_match_all(as.character(Q), '(X[0-9]+) ?=='),
                  function(x) x[, 2])
  bn <- remove_barren(bn, E_var, Q_var)
  if (missing(Q) && missing(E)) return(NULL)
  if (!missing(Q) && !missing(E)) {
    EV <- paste(as.character(c(Q, E)), collapse = ' & ')
    RAZ <- paste(as.character(E), collapse = ' & ')
  } else if (missing(Q) | !missing(E)) {
    EV <- paste(as.character(E), collapse = ' & ')
    RAZ <- NULL
  } else {
    EV <- paste(as.character(Q), collapse = ' & ')
    RAZ <- NULL
  }
  amostra <- amostrar_n(bn, n)
  NUM <- setNames(dplyr::count_(amostra, EV), c('r', 'n'))
  if (length(NUM$r[NUM$r]) == 0) return(0)
  freq_num <- NUM$n[NUM$r]
  if (is.null(RAZ)) return(freq_num / n)
  DEN <- setNames(dplyr::count_(amostra, RAZ), c('r', 'n'))
  if (length(DEN$r[DEN$r]) == 0) return(0)
  freq_den <- DEN$n[DEN$r]
  freq_num / freq_den
}