Posted to tcl by arjen at Wed Feb 12 12:28:26 GMT 2014view raw
- # 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)