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)