Posted to tcl by aspect at Wed Feb 12 12:43:10 GMT 2014view pretty
# Small-scale experiments with Bayesian networks: # Do I understand the technique? # package require TclOO namespace import oo::* oo::class create Static { method static {args} { if {![llength $args]} return set callclass [lindex [self caller] 0] oo::objdefine $callclass export varname foreach vname $args { lappend pairs [$callclass varname $vname] $vname } uplevel 1 upvar {*}$pairs } } class create logicalNode { mixin Static variable myname variable depends variable table variable probabilityTrue constructor {name {dependencies {}} {conditions {}}} { my static 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} { 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} { my static 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 {} { my static nodes 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)