Posted to tcl by arjen at Wed Feb 12 12:28:26 GMT 2014view pretty

# bayesian.tcl --
#     Small-scale experiments with Bayesian networks:
#     Do I understand the technique?
#

package require TclOO
namespace import oo::*

class create logicalNode {
    variable nodes

    constructor {name {dependencies {}} {conditions {}}} {
        my variable myname
        my variable depends
        my variable table
        my variable probabilityTrue
        variable nodes

        #CheckDependencies $dependencies
        #CheckTable        $conditions
        set depends [my GetObjects $dependencies]
        set table   $conditions

        set probabilityTrue 0.5

        set myname       $name
        set nodes($name) [self object]
    }

    method set {args} {
        my variable probabilityTrue

        foreach {value probability} $args {
            if { $probability < 0.0 || $probability > 1.0 } {
                return -code error "Probability must be between 0 and 1 - found: $probability"
            }
            if { $value == "true" } {
                set probabilityTrue $probability
            }
            if { $value == "false" } {
                set probabilityTrue [expr {1.0 - $probability}]
            }
        }
    }

    method GetObjects {names} {
        variable nodes
        puts "Available nodes: [array names nodes]"
        set objects {}
        foreach name $names {
            if { [info exists nodes($name)] } {
                lappend objects $nodes($name)
            } else {
                return -code error "Node $name not defined yet"
            }
        }
    }

    method print {} {
        variable nodes
        my variable myname
        my variable probabilityTrue
        puts "Name: $myname"
        puts "    True:  $probabilityTrue"
        puts "    False: [expr {1.0 - $probabilityTrue}]"
        puts "    [array names nodes]"
    }
}

set b [logicalNode new "B"]
$b print
set a [logicalNode new "A" "B"]
$a set true 0.1
$a print

#
# Result: why the error?
#
Available nodes: 
Name: B
    True:  0.5
    False: 0.5
    B
Available nodes: 
Node B not defined yet
    while executing
"my GetObjects $dependencies"
    (class "::logicalNode" constructor line 10)
    invoked from within
"logicalNode new "A" "B""
    invoked from within
"set a [logicalNode new "A" "B"]"
    (file "bayesian_error.tcl" line 72)