R/frontend-arcs.R

Defines functions drop.edge set.edge reverse.arc drop.arc set.arc narcs reversible.arcs compelled.arcs incident.arcs outgoing.arcs incoming.arcs undirected.arcs directed.arcs arcs

Documented in arcs compelled.arcs directed.arcs drop.arc drop.edge incident.arcs incoming.arcs narcs outgoing.arcs reverse.arc reversible.arcs set.arc set.edge undirected.arcs

# return the arcs in the graph.
arcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  if (is(x, "bn"))
    x$arcs
  else
    fit2arcs(x)

}#ARCS

# rebuild the network structure using a new set fo arcs.
"arcs<-" = function(x, check.cycles = TRUE, check.illegal = TRUE, debug = FALSE,
    value) {

  # check x's class.
  check.bn(x)
  # a set of arcs is needed.
  if (missing(value))
    stop("no arc specified.")
  # check logical arguments.
  check.logical(check.cycles)
  check.logical(check.illegal)
  check.logical(debug)
  # sanitize the set of arcs.
  value = check.arcs(value, nodes = names(x$nodes))
  # check whether the the graph contains directed cycles.
  if (check.cycles)
    if (!is.acyclic(nodes = names(x$nodes), arcs = value, debug = debug,
           directed = TRUE))
      stop("the specified network contains cycles.")
  # check whether any arc is illegal.
  if (check.illegal) {

    illegal = which.listed(value, x$learning$illegal)

    if (any(illegal)) {

      illegal = apply(value[illegal, , drop = FALSE], 1,
                  function(x) { paste(" (", x[1], ", ", x[2], ")", sep = "")  })

      stop("the following arcs are not valid due to the parametric assumptions of the network:",
        illegal, ".")

    }#THEN

  }#THEN

  # update the arcs of the network.
  x$arcs = value
  # update the network structure.
  x$nodes = cache.structure(names(x$nodes), arcs = x$arcs, debug = debug)

  return(x)

}#ARCS<-

# return the directed arcs in the graph.
directed.arcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  if (is(x, "bn"))
    x$arcs[which.directed(x$arcs, names(x$nodes)), , drop = FALSE]
  else
    fit2arcs(x)

}#DIRECTED.ARCS

# return the undirected arcs in the graph.
undirected.arcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  if (is(x, "bn"))
    x$arcs[which.undirected(x$arcs, names(x$nodes)), , drop = FALSE]
  else
    matrix(character(0), nrow = 0, ncol = 2,
      dimnames = list(NULL, c("from", "to")))

}#UNDIRECTED.ARCS

# return the arcs pointing to a particular node.
incoming.arcs = function(x, node) {

  # check x's class.
  check.bn.or.fit(x)
  # a valid node is needed.
  check.nodes(nodes = node, graph = x, max.nodes = 1)

  arcs = directed.arcs(x)

  arcs[arcs[, "to"] == node, , drop = FALSE]

}#INCOMING.ARCS

# return the arcs originating from a particular node.
outgoing.arcs = function(x, node) {

  # check x's class.
  check.bn.or.fit(x)
  # a valid node is needed.
  check.nodes(nodes = node, graph = x, max.nodes = 1)

  arcs = directed.arcs(x)

  arcs[arcs[, "from"] == node, , drop = FALSE]

}#OUTGOING.ARCS

# return the arcs incident on a particular node.
incident.arcs = function(x, node) {

  # check x's class.
  check.bn.or.fit(x)
  # a valid node is needed.
  check.nodes(nodes = node, graph = x, max.nodes = 1)

  arcs = arcs(x)

  arcs[(arcs[, "from"] == node) | (arcs[, "to"] == node), , drop = FALSE]

}#INCIDENT.ARCS

# return compelled arcs.
compelled.arcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  if (is(x, "bn.fit"))
    x = cpdag(bn.net(x))
  else
    x = cpdag(x)

  return(directed.arcs(x))

}#COMPELLED.ARCS

# return reversible arcs.
reversible.arcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  if (is(x, "bn.fit"))
    cp = cpdag(bn.net(x))
  else
    cp = cpdag(x)

  return(x$arcs[which.listed(x$arcs, undirected.arcs(cp)), ])

}#REVERSIBLE.ARCS

# return the number of arcs in the graph.
narcs = function(x) {

  # check x's class.
  check.bn.or.fit(x)

  narcs.backend(x)

}#NARCS

# set an arc direction manually.
set.arc = function(x, from, to, check.cycles = TRUE, check.illegal = TRUE,
    debug = FALSE) {

  arc.operations(x = x, from = from, to = to, op = "set",
    check.cycles = check.cycles, check.illegal = check.illegal, debug = debug)

}#SET.ARC

# remove an arc from the graph.
drop.arc = function(x, from, to, debug = FALSE) {

  arc.operations(x = x, from = from, to = to, op = "drop",
    check.cycles = FALSE, check.illegal = FALSE, debug = debug)

}#DROP.ARC

# reverse an arc in the graph.
reverse.arc = function(x, from, to, check.cycles = TRUE, check.illegal = TRUE,
    debug = FALSE) {

  arc.operations(x = x, from = from, to = to, op = "reverse",
    check.cycles = check.cycles, check.illegal = check.illegal, debug = debug)

}#REVERSE.ARC

# set an undirected arc.
set.edge = function(x, from, to, check.cycles = TRUE, check.illegal = TRUE,
    debug = FALSE) {

  arc.operations(x = x, from = from, to = to, op = "seted",
    check.cycles = check.cycles, check.illegal = check.illegal, debug = debug)

}#SET.EDGE

# remove an arc from the graph.
drop.edge = function(x, from, to, debug = FALSE) {

  arc.operations(x = x, from = from, to = to, op = "droped",
    check.cycles = FALSE, check.illegal = FALSE, debug = debug)

}#DROP.EDGE

Try the bnlearn package in your browser

Any scripts or data that you put into this service are public.

bnlearn documentation built on Sept. 7, 2021, 1:07 a.m.