Skip to main content

Structural learning in R

source("bayesserver.R")

# Manually construct a network to keep the example simple.
createNetworkNoLinks <- function() {
network <- new(Network)

# Instead of manually constructing a network
# you could also load from a file using
# network$load("path-to-file")

for (name in c("A", "B", "C"))
{
node = new(Node, name, c("False", "True"))
network$getNodes()$add(node)
}

# We are not adding links here, as we are going to learn them from data.

return(network)
}

# Manually creating a data frame here,
# but you could also create a data frame from a file or database
# or you could use DatabaseDataReader to connect Bayes Server directly to a database
# by-passing the creation of a data frame

da = c("True", "True", "True", "False", "False", "False", "False", "True", "True", "True", "True", "False", "True", "True", "False", "True", "False", "False", "True", "False", "False", "True", "False", "True", "False", "True", "False", "False", "True", "False", "True", "False", "True", "True", "True", "True", "True", "True", "False", "True", "True", "False", "True", "False", "False", "True", "True", "True", "False", "True", "True", "True", "True", "True", "True", "True", "True", "True", "False", "True", "False", "False", "True", "False", "True", "False", "False", "True", "False", "False", "True", "True", "False", "False", "True", "True", "True", "False", "True", "False", "True", "True", "True", "True", "False", "True", "True", "False", "True", "True", "True", "False", "False", "True", "True", "True", "True", "False", "True", "True" )
db = c("False", "True", "False", "False", "True", "False", "True", "False", "True", "False", "False", "True", "True", "True", "False", "False", "True", "False", "False", "True", "False", "False", "False", "True", "False", "False", "False", "False", "True", "False", "False", "False", "False", "False", "False", "True", "True", "False", "False", "False", "True", "True", "False", "False", "False", "False", "True", "False", "False", "True", "True", "True", "False", "False", "False", "False", "False", "False", "False", "False", "True", "False", "True", "True", "True", "True", "False", "True", "False", "False", "True", "False", "False", "False", "False", "False", "True", "True", "False", "True", "True", "True", "True", "False", "True", "False", "False", "False", "False", "False", "True", "False", "True", "False", "False", "True", "True", "True", "True", "False")
dc = c("True", "True", "True", "False", "True", "False", "True", "True", "True", "True", "True", "True", "True", "True", "False", "True", "True", "False", "True", "True", "False", "True", "False", "True", "False", "True", "False", "False", "True", "False", "True", "False", "True", "True", "True", "True", "True", "True", "False", "True", "True", "True", "True", "False", "False", "True", "True", "True", "False", "True", "True", "True", "True", "True", "True", "True", "True", "True", "False", "True", "True", "False", "True", "True", "True", "True", "False", "True", "False", "False", "True", "True", "False", "False", "True", "True", "True", "True", "True", "True", "True", "True", "True", "True", "True", "True", "True", "False", "True", "True", "True", "False", "True", "True", "True", "True", "True", "True", "True", "True")
df = data.frame(A=da, B=db, C=dc) # df is a data frame


network <- createNetworkNoLinks() # we manually construct the network here, but it could be loaded from a file

learning = new(PCStructuralLearning)

dataTable <- toDataTable(df)

dataReaderCommand <- new(DataTableDataReaderCommand, dataTable)

variableReferences = lapply(network$getVariables(), function(v) {
return(new(VariableReference, v, ColumnValueType$NAME, v$getName()))
})

evidenceReaderCommand <- new(
DefaultEvidenceReaderCommand,
dataReaderCommand,
toVariableReferenceList(variableReferences),
new(ReaderOptions)
)

options <- new(PCStructuralLearningOptions)

# You can add link constraints as follows, if required...
# a <- network$getNodes()$get('A', TRUE)
# b <- network$getNodes()$get('B', TRUE)
# constraintAToB <- new(LinkConstraint, a, b, LinkConstraintMethod$A_TO_B, LinkConstraintFailureMode$THROW_EXCEPTION)
# options$getLinkConstraints()$add(constraintAToB)

output <- learning$learn(evidenceReaderCommand, network$getNodes(), options)

lapply(output$getLinkOutputs(), function(linkOutput) {
print(sprintf("Link added from %s -> %s", linkOutput$getLink()$getFrom()$getName(), linkOutput$getLink()$getTo()$getName()))
})