Build and Propagate

'Build a Bayesian network and propagate evidence.

Dim Dom As Domain
Dim vbafactory As New HVBA

'The factory made above is used to create a domain,
'on which we build a network with 3 nodes.
'The network is saved as a net file and compiled
'before evidence is propagated and beliefs are
'written to the document.
Public Sub BAP()

    Set Dom = vbafactory.Domain

    Call BuildNetwork

    Call Dom.SaveAsNet("builddomain.net")
    Call Dom.Compile

    Call PropagateEvidenceInNetwork

End Sub

'Used by BAP to propagate evidence in the network
'and write the new beliefs to the worksheet.
Private Sub PropagateEvidenceInNetwork()

    Call Dom.Propagate(Equilibrium_H_EQUILIBRIUM_SUM, EvidenceMode_H_EVIDENCE_MODE_NORMAL)
    Call PrintNodeMarginals(Dom)

End Sub

'Writes information to a worksheet named "Output".
'Note that this method is solely used to give the
'user insight in what is happening.
'It does not make use of the hugin engine and is
'not strictly needed niether for building nor
'propagating to work.
Public Sub WriteToWorksheet(text As String)
    Dim OutPut As Worksheet
    On Error Resume Next
    Set OutPut = Sheets("Output")
    On Error GoTo 0
    If OutPut Is Nothing Then
        Sheets.Add().name = "Output"
    End If
    Set OutPut = Sheets("Output")
    Dim v
    Dim n As Long
    v = OutPut.Range("a1")
    If IsEmpty(v) Then
       OutPut.Cells(1, 1) = 2
       v = 2
    End If
    n = v
    OutPut.Cells(v, 1) = text
    OutPut.Cells(1, 1) = v + 1
End Sub

'Used by PropagateEvidenceInNetwork to write out
'the new beliefs after evidence has been propagated.
Private Sub PrintNodeMarginals(d As Domain)

    Dim nlist As NodeList
    Set nlist = d.GetNodes

    For Each n In nlist
        Dim node As DiscreteChanceNode
        Set node = n
        Dim nState As LongPtr
        WriteToWorksheet ("")
        WriteToWorksheet (node.GetLabel)
        For nState = 0 To node.GetNumberOfStates - 1
            WriteToWorksheet ("-" & node.GetStateLabel(nState) & " " & node.GetBelief(nState))
        Next
    Next

End Sub

'Constructs a numbered discrete chance node
'with the given label, name and number of
'state values.
Private Function ConstructNDC(label As String, name As String, n As LongPtr) As NumberedDCNode

    Dim node As NumberedDCNode
    Set node = vbafactory.NumberedDCNode(Dom)

    Call node.SetNumberOfStates(n)

    Dim i As LongPtr
    For i = 0 To n - 1
        Call node.SetStateValue(i, i)
    Next
    Call node.SetLabel(label)
    Call node.SetName(name)

    Set ConstructNDC = node

End Function

'Posistions the nodes in the net (purely
'graphical in case you should wish to inspect it
'in the hugin GUI after creating it)
'and assigns the relationships between
'the nodes in the network.
Private Sub BuildStructure(A As NumberedDCNode, B As NumberedDCNode, C As NumberedDCNode)

    Call C.AddParent(A)
    Call C.AddParent(B)

    Call A.SetPosition(vbafactory.Point(100, 200))
    Call B.SetPosition(vbafactory.Point(200, 200))
    Call C.SetPosition(vbafactory.Point(150, 50))

End Sub

'An expression for C is made using A and B.
'The list of model nodes is empty and used
'solely to construct the model.
'As there are no model nodes, 0 is the
'only viable configuration used in
'setExpression.
Private Sub BuildExpressionForC(A As NumberedDCNode, B As NumberedDCNode, C As NumberedDCNode)

    Dim modelNodes As NodeList
    Set modelNodes = vbafactory.NodeList

    Dim model As HModel
    Set model = vbafactory.HModel(C, modelNodes)

    Dim exprA As NodeExpression
    Set exprA = vbafactory.NodeExpression(A)
    Dim exprB As NodeExpression
    Set exprB = vbafactory.NodeExpression(B)

    Dim exprC As AddExpression
    Set exprC = vbafactory.AddExpression(exprA, exprB)

    Call model.SetExpression(0, exprC)

End Sub

'Specify the prior distribution of A and B.
'This is currently done by assigning a value to
'all table entries individually.
Private Sub SpecifyDistributions(A As NumberedDCNode, B As NumberedDCNode)

    Dim table As table
    Set table = A.GetTable
    Call table.SetDataItem(0, 0.1)
    Call table.SetDataItem(1, 0.2)
    Call table.SetDataItem(2, 0.7)

    Set table = B.GetTable

    Call table.SetDataItem(0, 0.2)
    Call table.SetDataItem(1, 0.2)
    Call table.SetDataItem(2, 0.6)

End Sub

'Builds the Bayesian network.
'This is done by first constructing 3 different nodes.
'Then they are assigninged posision within the network
'and their parent/child relations are specified.
'Then an expression for the node "C" is made.
'And finally distributions of A and B are made before
'the network is ready for propagation.
Public Sub BuildNetwork()

'Dom.SetNodeSize - Size class?
    Dim A As NumberedDCNode
    Set A = ConstructNDC("A1234567890123", "A", 3)
    Dim B As NumberedDCNode
    Set B = ConstructNDC("B", "B", 3)
    Dim C As NumberedDCNode
    Set C = ConstructNDC("C", "C", 5)

    Call BuildStructure(A, B, C)

    Call BuildExpressionForC(A, B, C)

    Call SpecifyDistributions(A, B)

End Sub

'Build a Bayesian network and perform a propagation of evidence.
'Print the results.
Public Sub Main()

    On Error GoTo ErrorHandler
    Call BAP

Exit Sub
ErrorHandler:
    Call MsgBox("An Error Occurred in your Script" & vbNewLine & TypeName(vbafactory.lastExceptionHugin) & vbNewLine & vbafactory.lastExceptionHugin.Message, vbCritical, "Error")

End Sub
Close