Posted to tcl by aspect at Wed Feb 12 12:43:10 GMT 2014view raw
- # 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)