
# backend for sampling from conditional probability distributions.
conditional.distribution = function(fitted, nodes, evidence, method, extra,
    cluster = NULL, eval.env = parent.frame(), debug = FALSE) {

  # consider only the upper closure of event and evidence to reduce the number
  # of variables in the Monte Carlo simulation.
  fitted = reduce.fitted(fitted = fitted, event = nodes, evidence = evidence,
             nodes = extra$query.nodes, method = method, eval.env = eval.env,
             debug = debug)

  if (method == "ls")
    distribution = logic.distribution
  else if (method == "lw")
    distribution = weighting.distribution

  if (!is.null(cluster)) {

    # get the number of slaves.
    s = nSlaves(cluster)
    # divide the number of particles among the slaves.
    batch = n = ceiling(extra$n / s)

    results = parallel::parLapplyLB(cluster, seq(s),
      function(x) {

        distribution(fitted = fitted, nodes = nodes, evidence = evidence,
          n = n, batch = batch, eval.env = eval.env, debug = debug)

      })

    return(do.call(rbind, results))

  }#THEN
  else {

    distribution(fitted = fitted, nodes = nodes, evidence = evidence,
      n = extra$n, batch = extra$batch, eval.env = eval.env, debug = debug)

  }#ELSE

}#CONDITIONAL.DISTRIBUTION

# backend for conditional probability queries.
conditional.probability.query = function(fitted, event, evidence, method,
    extra, cluster = NULL, eval.env = parent.frame(), debug = FALSE) {

  # consider only the upper closure of event and evidence to reduce the number
  # of variables in the Monte Carlo simulation.
  fitted = reduce.fitted(fitted = fitted, event = event, evidence = evidence,
             nodes = extra$query.nodes, method = method, eval.env = eval.env,
             debug = debug)

  if (method == "ls")
    sampling = logic.sampling
  else if (method == "lw")
    sampling = weighting.sampling

  if (!is.null(cluster)) {

    # get the number of slaves.
    s = nSlaves(cluster)
    # divide the number of particles among the slaves.
    batch = n = ceiling(extra$n / s)

    results = parallel::parSapplyLB(cluster, seq(s),
      function(x) {

        sampling(fitted = fitted, event = event, evidence = evidence,
         n = n, batch = batch, eval.env = eval.env, debug = debug)

      })

    return(mean(results))

  }#THEN
  else {

    sampling(fitted = fitted, event = event, evidence = evidence,
      n = extra$n, batch = extra$batch, eval.env = eval.env, debug = debug)

  }#ELSE

}#CONDITIONAL.PROBABILITY.QUERY

# create an empty data frame from a bn.fit object.
fit.dummy.df = function(fitted, nodes) {

  dummy = sapply(nodes, function(x) {

    node = fitted[[x]]

    if (is(node, "bn.fit.dnode"))
      return(factor(character(0), levels = dimnames(node$prob)[[1]]))
    else if (is(node, "bn.fit.onode"))
      return(ordered(character(0), levels = dimnames(node$prob)[[1]]))
    else if (is(node, "bn.fit.gnode"))
      return(numeric(0))

  })

  return(as.data.frame(dummy))

}#FIT.DUMMY.DF

# reduce a bn.fit object to the upper closure of event and evidence nodes.
reduce.fitted = function(fitted, event, evidence, nodes, method,
    eval.env = parent.frame(), debug = FALSE) {

  if (is.null(nodes)) {

    # find out which nodes are involved in the event and the evidence and
    # construct their upper closure.
    nodes = names(fitted)
    if (is.character(event))
      event.vars = event
    else
      event.vars = all.vars(event)
    if (is.list(evidence))
      evidence.vars = names(evidence)
    else
      evidence.vars = all.vars(evidence)
    nodes.event = nodes[nodes %in% event.vars]
    nodes.evidence = nodes[nodes %in% evidence.vars]
    upper.closure =
      topological.ordering(fitted, start = union(nodes.evidence, nodes.event),
                           reverse = TRUE)

    # check whether something went horribly wrong in getting the node labels
    # and the upper closure.
    if (((length(upper.closure) == 0) || any(upper.closure %!in% nodes)) ||
        (!identical(evidence, TRUE) && (length(nodes.evidence) == 0)) ||
        (!identical(event, TRUE) && (length(nodes.event) == 0))) {

      # use all the nodes when in doubt.
      event = evidence = TRUE
      upper.closure = nodes

      if (debug) {

        cat("* checking which nodes are needed.\n")
        cat("  > unable to identify query nodes.\n")

      }#THEN

    }#THEN
    else {

      if (debug) {

        cat("* checking which nodes are needed.\n")
        cat("  > event involves the following nodes:", nodes.event, "\n")
        cat("  > evidence involves the following nodes:", nodes.evidence, "\n")
        cat("  > upper closure is '", upper.closure, "'\n")

      }#THEN

    }#ELSE

  }#THEN
  else {

    # construct the upper closure of the query nodes.
    upper.closure = topological.ordering(fitted, start = nodes, reverse = TRUE)

    if (debug) {

      cat("* using specified query nodes.\n")
      cat("  > upper closure is '", upper.closure, "'\n")

    }#THEN

  }#ELSE

  # check that the reduced network can actually evaluate the expressions: those
  # referencing variables outside the node set fall back to the whole network.
  dummy = fit.dummy.df(fitted, upper.closure)
  # testing evidence (TRUE or an expression in LS, a list in LW).
  if (!(is.language(evidence) || identical(evidence, TRUE)))
    try.evidence = TRUE
  else
    try.evidence = try(eval(evidence, dummy, eval.env), silent = TRUE)
  # testing event (it's the label nodes in cpdist; TRUE or an expression
  # in cpquery).
  if (!(is.language(event) || identical(event, TRUE)))
    try.event = TRUE
  else
    try.event = try(eval(event, dummy, eval.env), silent = TRUE)

  # create the subgraph corresponding to the upper closure, keeping the ordering
  # of the node in the bn.fit object the same to avoid potentially affecting
  # random simulations later.
  if (is.logical(try.event) && is.logical(try.evidence)) {

    if (debug)
      cat("  > generating observations from", length(upper.closure), "/",
        length(fitted), "nodes.\n")

    fitted =
      structure(fitted[names(fitted) %in% upper.closure], class = class(fitted))

  }#THEN
  else {

    if (debug)
      cat("  > unable to use the upper closure, using the whole network.\n")

  }#ELSE

  return(fitted)

}#REDUCE.FITTED

# compute conditional probabilities with forward/logic sampling.
logic.sampling = function(fitted, event, evidence, n, batch,
    eval.env = parent.frame(), debug = FALSE) {

  .Call(call_logic_sampling,
        fitted = fitted,
        event = event,
        evidence = evidence,
        n = as.integer(n),
        batch = as.integer(batch),
        eval.env = eval.env,
        debug = debug)

}#LOGIC.SAMPLING

# generate random observations from conditional distributions with forward/logic
# sampling.
logic.distribution = function(fitted, nodes, evidence, n, batch,
    eval.env = parent.frame(), debug = FALSE) {

  .Call(call_logic_distribution,
        fitted = fitted,
        nodes = nodes,
        evidence = evidence,
        n = as.integer(n),
        batch = as.integer(batch),
        eval.env = eval.env,
        debug = debug)

}#LOGIC.DISTRIBUTION

# compute conditional probabilities with likelihood weighting.
weighting.sampling = function(fitted, event, evidence, n, batch,
    eval.env = parent.frame(), debug = FALSE) {

  .Call(call_weighting_sampling,
        fitted = fitted,
        event = event,
        evidence = evidence,
        n = as.integer(n),
        batch = as.integer(batch),
        eval.env = eval.env,
        debug = debug)

}#WEIGHTING.SAMPLING

# generate random observations from conditional distributions with likelihood
# weighting.
weighting.distribution = function(fitted, nodes, evidence, n, batch,
    eval.env = parent.frame(), debug = FALSE) {

  .Call(call_weighting_distribution,
        fitted = fitted,
        nodes = nodes,
        n = as.integer(n),
        fix = evidence,
        debug = debug)

}#WEIGHTING.DISTRIBUTION
