Net Construction Sample

Dim vbafactory As New HVBA
Public cellX As Integer
Public cellY As Integer

'This example constructs a net containing two nodes
'to demonstrate the effect on one by altering
'the evidence in the other.

'Constructs a labelled discrete chance node.
'Note that name should be unique for each call to
'this function although no checks are made for it.
Private Function ConstructNode(Dom As Domain, name As String, numberOfStates As Integer)

    Dim theNode As LabelledDCNode
    Set theNode = vbafactory.LabelledDCNode(Dom)
    theNode.SetLabel (name)
    theNode.SetName (name)
    theNode.SetNumberOfStates (numberOfStates)
    For i = 0 To numberOfStates - 1
        Call theNode.SetStateLabel(i, "state " & i)
    Next
    Set ConstructNode = theNode

End Function

'Constructs a table for the given discrete chance node
Private Sub MakeTable(ownerNode As node)

    Dim theNodesTable As Table
    Set theNodesTable = ownerNode.GetTable
    For i = 0 To theNodesTable.GetSize - 1
        Call theNodesTable.SetDataItem(i, i + 1)
    Next

End Sub

'Provides evidence for a state in the input node,
'propagates and then prints the new value of the
'output node.
Private Sub NewEvidence(Dom As Domain, inputNode As LabelledDCNode, outputNode As LabelledDCNode, theState As Integer)

    cellY = cellY + 2
    WriteToWorksheet (inputNode.GetName & "=state " & theState)
    cellY = cellY + 2
    inputNode.SelectState (theState)
    Call Dom.Propagate(Equilibrium_H_EQUILIBRIUM_SUM, EvidenceMode_H_EVIDENCE_MODE_NORMAL)
    For i = 0 To outputNode.GetNumberOfStates - 1
        WriteToWorksheet ("P(" & outputNode.GetName & "=" & outputNode.GetStateLabel(i) & "|e)=" & outputNode.GetBelief(i))
       cellY = cellY + 1
   Next

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 or the net to be constructed.
Public Sub WriteToWorksheet(text As String)
    Dim output As Worksheet
    On Error Resume Next
    Set output = Sheets("Output")
    On Error GoTo 0
    Set output = Sheets("Output")
    output.Cells(cellY, cellX) = text
End Sub

Public Sub Main()

    cellX = 1
    cellY = 1
    Dim output As Worksheet
    On Error Resume Next
    Set output = Sheets("Output")
    On Error GoTo ErrorHandler
    If output Is Nothing Then
        Sheets.Add().name = "Output"
    Else
        Sheets("Output").Cells.Clear
    End If

    'Construct empty domain
    Dim Dom As Domain
    Set Dom = vbafactory.Domain

    'Construct node A
    Dim A As LabelledDCNode
    Set A = ConstructNode(Dom, "A", 2)
    Call MakeTable(A)

    'Construnct node B
    Dim B As LabelledDCNode
   Set B = ConstructNode(Dom, "B", 4)

    'Make A parent of B (A->B)
    Call B.AddParent(A)
    Call MakeTable(B)

    'Compile domain
    Dom.Compile

    'Write out probabilities for B
    WriteToWorksheet ("No evidence")
    cellY = cellY + 2
    For i = 0 To B.GetNumberOfStates - 1
        WriteToWorksheet ("P(B=" & B.GetStateLabel(i) & "|e)=" & B.GetBelief(i))
        cellY = cellY + 1
    Next

    'Enter evidence for A and write out probabilities for B
    Call NewEvidence(Dom, A, B, 0)

    'Enter some other evidence for A and write out probabilities for B
    Call NewEvidence(Dom, A, B, 1)

    'Clean up (release all reasources allocated by domain)
    Dom.Delete

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

End Sub
Close