R/frontend-nodes.R In bnlearn: Bayesian Network Structure Learning, Parameter Learning and Inference

```# return the markov blanket of a node.
mb = 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)

if (is(x, "bn"))
x\$nodes[[node]]\$mb
else
mb.fitted(x, node)

}#MB

# return the neighbourhood of a node.
nbr = 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)

if (is(x, "bn"))
x\$nodes[[node]]\$nbr
else
unique(c(x[[node]]\$parents, x[[node]]\$children))

}#NBR

# get the parents of a node.
parents = 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)

if (is(x, "bn"))
x\$nodes[[node]]\$parents
else
x[[node]]\$parents

}#PARENTS

# add one or more parents to a node.
"parents<-" = function(x, node, debug = FALSE, value) {

# check x's class.
check.bn(x)
# a valid node is needed.
check.nodes(nodes = node, graph = x, max.nodes = 1)
# at least one parent node is needed.
if (missing(value))
stop("no parent specified.")
# node must be a valid node label.
if (!any(value %in% names(x\$nodes)))
stop("node not present in the graph.")

# remove duplicate labels from value.
value = unique(value)
# drop the parents which are not listed for inclusion.
to.be.dropped = x\$nodes[[node]]\$parents[x\$nodes[[node]]\$parents %!in% value]

if (debug) {

cat("* resetting the parents of node", node, ".\n")
cat("  > old parents: '", x\$nodes[[node]]\$parents, "'\n")
cat("  > new parents: '", value, "'\n")
cat("  > to be really dropped: '", to.be.dropped, "'\n")

}#THEN

# dropping!
for (p in to.be.dropped) {

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

}#FOR

x = arc.operations(x = x, from = p, to = node, op = "set",
check.cycles = TRUE, check.illegal = TRUE, update = FALSE,
debug = debug)

}#FOR

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

return(x)

}#PARENTS<-

# get the children of a node.
children = 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)

if (is(x, "bn"))
x\$nodes[[node]]\$children
else
x[[node]]\$children

}#CHILDREN

# add one or more children to a node.
"children<-" = function(x, node, debug = FALSE, value) {

# check x's class.
check.bn(x)
# a valid node is needed.
check.nodes(nodes = node, graph = x, max.nodes = 1)
# a node is needed.
if (missing(value))
stop("no children specified.")
# node must be a valid node label.
if (!any(value %in% names(x\$nodes)))
stop("node not present in the graph.")

# remove duplicate labels from value.
value = unique(value)
# drop the parents which are not listed for inclusion.
to.be.dropped = x\$nodes[[node]]\$children[x\$nodes[[node]]\$children %!in% value]

if (debug) {

cat("* resetting the children of node", node, ".\n")
cat("  > old children: '", x\$nodes[[node]]\$children, "'\n")
cat("  > new children: '", value, "'\n")
cat("  > to be really dropped: '", to.be.dropped, "'\n")

}#THEN

# dropping!
for (child in to.be.dropped) {

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

}#FOR

x = arc.operations(x = x, from = node, to = child, op = "set",
check.cycles = TRUE, check.illegal = TRUE, update = FALSE,
debug = debug)

}#FOR

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

return(x)

}#CHILDREN<-

# get the spouses of a node.
spouses = 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)

chld = children(x, node)
sp = unique(unlist(lapply(chld, parents, x = x)))

return(setdiff(as.character(sp), node))

}#SPOUSES

# get the ancestors of a node.
ancestors = 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)

# the first element is the node itself, which is not its own ancestor.
return(topological.ordering(x, start = node, reverse = TRUE)[-1])

}#ANCESTORS

# get the descendants of a node.
descendants = 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)

# the first element is the node itself, which is not its own ancestor.
return(topological.ordering(x, start = node)[-1])

}#DESCENDANTS

# get the in-degree of a node.
in.degree = 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)

if (is(x, "bn"))
length(x\$nodes[[node]]\$parents)
else
length(x[[node]]\$parents)

}#IN.DEGREE

# get the out-degree of a node.
out.degree = 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)

if (is(x, "bn"))
length(x\$nodes[[node]]\$children)
else
length(x[[node]]\$children)

}#OUT.DEGREE

# add a node to a network structure.

# check x's class.
check.bn(x)
# a valid node (that is not already in the graph) is needed.
if (!is.string(node))
stop("'node' should be a single character string.")
if (node %in% names(x\$nodes))
stop("node ", node, " is already present in the graph.")

x\$nodes[[node]] = list(mb = character(0), nbr = character(0),
parents = character(0), children = character(0))

return(x)

# remove a node from a network structure.
remove.node = function(x, node) {

# check x's class.
check.bn(x)
# the resulting graphs should have at least one node.
if (length(x\$nodes) == 1)
stop("trying to remove the only node in the graph.")
# a valid node (that is already in the graph) is needed.
check.nodes(nodes = node, graph = x, max.nodes = 1)

# removing a single node is a special case of creating a subgraph.
subgraph.backend(x = x, nodes = setdiff(names(x\$nodes), node),
preserve.learning = TRUE)

}#REMOVE.NODE

# rename the nodes of a network structure.
rename.nodes = function(x, names) {

.relabel(x, value = names)

}#RENAME.NODES
```

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.