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)