[Arjen Markus] (30 june 2006) Fuzzy logic, whatever you may think of it, is a useful modelling technique for 
certain kinds of practical problems. I want to keep things practical indeed, as much of the literature
on the subject may divert into almost esoteric discourses on the meaning of fuzzy inference and the like.

I consider myself a fairly practical programmer, so I have chosen a very straightforward implementation.
It is not finished yet - I want to add a decent example to this script, but it is a nice beginning in
my opinion. 

----
 # fuzzylogic.tcl --
 #     Experiment with fuzzy logic
 #
 #     Note:
 #     I wanted something fast and easy to write, so my design
 #     decisions have been guided by that. In particular:
 #     - no hedges
 #     - simply min-max rules
 #     - simple trapezoid membership functions
 #

 namespace eval ::FuzzyLogic {
     variable vars
     variable types

     namespace export fuzzyvar fuzzytype
 }

 # fuzzyvar --
 #     Register a fuzzy variable
 # Arguments:
 #     name        Name of the variable
 #     type        Type to be used for (de)fuzzification
 # Result:
 #     None
 # Side effects:
 #     The variable is actually a _global_ variable, to keep the code
 #     simple
 #
 proc ::FuzzyLogic::fuzzyvar {name type} {
     variable vars

     set vars($name) $type
     global $name
 }

 # fuzzytype --
 #     Register a fuzzy type
 # Arguments:
 #     type        Name of the type
 #     classes     List of class names and bounds
 # Result:
 #     None
 # Side effects:
 #     The type is stored in a convenient way
 #
 proc ::FuzzyLogic::fuzzytype {type classes} {
     variable types

     set types($type) {}

     set length [expr {[llength $classes]/3}]

     set worklist {}
     for {set i 0} {$i < $length} {incr i} {
         puts $worklist
         set class [lindex $classes [expr {$i*3}]]
         set typical {}
         if { $i == 0 } {
             set min1    [lindex $classes 1]
             if { $min1 == {} } {
                 set typical [lindex $classes 2]
             }
         } else {
             set min1 [lindex $classes [expr {$i*3-1}]]
         }
         set min2 [lindex $classes [expr {$i*3+1}]]
         set max2 [lindex $classes [expr {$i*3+2}]]
         if { $i == $length-1 } {
             set max1 [lindex $classes [expr {$i*3+2}]]
             if { $max1 == {} } {
                 set typical $min2
             }
         } else {
             set max1 [lindex $classes [expr {$i*3+4}]]
         }
         if { $typical == {} } {
             set typical [expr {($min2+$max2)/2.0}]
         }
         lappend worklist $class $min1 $min2 $typical $max2 $max1
     }

     set types($type) $worklist
 }

 # Type definition:
 # c1   Min1  Max1
 # c2   Min2  Max2
 # c3   Min3  Max3
 # c4   Min4  Max4
 #
 # Schematically:
 # min1 min2 max2 max1
 # Min1 Min1 Typ1 Max1 Min2
 # Max1 Min2 Typ2 Max2 Min3
 # Max2 Min3 Typ3 Max3 Min4
 # Max3 Min4 Typ4 Max4 Max4
 #

 # fuzzyrule --
 #     Register a fuzzy rule or set of rules
 # Arguments:
 #     rule        Name of the rule
 #     body        List of IF/AND/OR/THEN clauses
 # Result:
 #     None
 # Side effects:
 #     The rule is stored for later use
 #
 proc ::FuzzyLogic::fuzzyrule {rule body} {
     variable rules

     set rules($rule) [split $body "\n"]
 }

 # applyrule --
 #     Apply a particular rule or set of rules
 # Arguments:
 #     rule        Name of the rule
 # Result:
 #     None
 # Side effects:
 #     The various fuzzy variables are defuzzified and set
 #     to the new values
 # Note:
 #     The evaluation is simplistic - no parentheses and AND/OR
 #     treated sequentially - so do not mix them!
 #
 proc ::FuzzyLogic::applyrule {rule} {
     variable rules

     set possibility {}
     set assigns     {}
     foreach line $rules($rule) {
         switch -- [lindex $line 0] {
         "IF" {
              set possibility [EvalCondition [lrange $line 1 end]]
         }
         "AND" {
              set newpos [EvalCondition [lrange $line 1 end]]
              if { $newpos < $possibility } {
                  set possibility $newpos
              }
         }
         "OR"  {
              set newpos [EvalCondition [lrange $line 1 end]]
              if { $newpos > $possibility } {
                  set possibility $newpos
              }
         }
         "THEN"  {
              set assigns [concat $assigns $possibility [EvalAssign [lrange $line 1 end]]]
         }
         "" -
         "#" {
             # Do nothing
         }
         default {
              return -code error "Unknown keyword - $line"
         }
         }
    }

    Defuzzify $assigns
 }

 # Membership --
 #     Determine the membership
 # Arguments:
 #     name        Name of the variable
 #     class       Class for which the membership must be determined
 # Result:
 #     Membership
 #
 proc ::FuzzyLogic::Membership {name class} {
     variable vars
     variable types

     set type $vars($name)
     set value [set ::$name]

     set cidx [lsearch $types($type) $class]

     foreach {min1 min2 typical max2 max1} \
         [lrange $types($type) [expr {$cidx+1}] [expr {$cidx+5}]] {break}

     if { $min1 == {} } {
         if { $value < $max2 } {
             return 1.0
         }
     } else {
         if { $value < $min1 } {
             return 0.0
         }
     }
     if { $max1 == {} } {
         if { $value > $min2 } {
             return 1.0
         }
     } else {
         if { $value > $max1 } {
             return 0.0
         }
     }

     if { $value >= $min2 && $value <= $max2 } {
         return 1.0
     }

     if { $value >= $min1 && $value <= $min2 } {
         return [expr {($min1-$value)/($min1-$min2)}]
     }

     if { $value >= $max2 && $value <= $max1 } {
         return [expr {($max1-$value)/($max1-$max2)}]
     }
 }

 # EvalCondition --
 #     Evaluate the possibility of a condition
 # Arguments:
 #     line        Line of text containing the condition
 # Result:
 #     Membership/possibility
 # Note:
 #     Simply assumes the format "variable is class"
 #
 proc ::FuzzyLogic::EvalCondition {line} {
     set var   [lindex $line 0]
     set class [lindex $line 2]

     return [Membership $var $class]
 }

 # EvalAssign --
 #     Analyse an assignment and arrange its later effectuation
 # Arguments:
 #     line        Line of text containing the condition
 # Result:
 #     List with variable name and typical value
 # Note:
 #     Simply assumes the format "variable is class"
 #
 proc ::FuzzyLogic::EvalAssign {line} {
     variable vars
     variable types

     set var     [lindex $line 0]
     set class   [lindex $line 2]
     set cidx    [lsearch $types($vars($var)) $class]
     set typical [lindex $types($vars($var)) [expr {$cidx+3}]]

     return [list $var $typical]
 }

 # Defuzzify --
 #     Defuzzify the variables
 # Arguments:
 #     assigns     List of possible assignments
 # Result:
 #     None
 # Side effects:
 #     Variables are set
 #
 proc ::FuzzyLogic::Defuzzify {assigns} {

     puts "$assigns ...."
     foreach {possibility var value} $assigns {
         if { ! [info exists sum($var)] } {
             set sum($var)    0.0
             set weight($var) 0.0
         }
         set sum($var)    [expr {$sum($var)    + $possibility * $value}]
         set weight($var) [expr {$weight($var) + $possibility }]
     }

     foreach var [array names sum] {
         global $var
         if { $weight($var) != 0.0 } {
             set $var [expr {$sum($var)/$weight($var)}]
         } else {
             return -code error "Weight for variable '$var' is zero! Check the rules"
         }
     }
 }

 # main --
 #

 # Test code
 if { 0 } {
 ::FuzzyLogic::fuzzytype temperature {
     Cold    {}    0.0
     Medium  10.0 20.0
     Hot     25.0 35.0
     VeryHot 40.0 {}
 }

 puts $::FuzzyLogic::types(temperature)

 ::FuzzyLogic::fuzzyvar T temperature

 foreach T {-1.0 0.0 1.0 5.0 9.0} \
         E { 1.0 1.0 0.9 0.5 0.1} {
     puts "[::FuzzyLogic::Membership T Cold] - $E - $T"
 }
 foreach T {-1.0 2.0 5.0 10.0 20.0 24.0 30.0} \
         E { 0.0 0.2 0.5  1.0  1.0  0.2  0.0} {
     puts "[::FuzzyLogic::Membership T Medium] - $E - $T"
 }
 foreach T { 5.0 10.0 20.0 36.0 40.0 60.0} \
         E { 0.0  0.0  0.0  0.2  1.0  1.0} {
     puts "[::FuzzyLogic::Membership T VeryHot] - $E - $T"
 }

 ::FuzzyLogic::fuzzyvar temp temperature
 ::FuzzyLogic::fuzzyvar heating heating
 ::FuzzyLogic::fuzzytype heating {
     None    0   0
     Low   100 500
     High 1000  {}
 }

 set temp 4.0
 ::FuzzyLogic::fuzzyrule heating {
     IF temp is Cold
        THEN heating is High
     IF temp is Medium
        THEN heating is Low
     IF temp is Hot
        OR temp is VeryHot
           THEN heating is None
 }

 ::FuzzyLogic::applyrule heating
 puts "Heating: $heating"
 }

 # A small application: a thermostat
 # The idea is simple:
 # - The room should be at a reasonable temperature during the
 #   day, but can be anything at night.
 # - The heater needs to take care of this in a smooth way,
 #   as little fluctuations as possible.
 # - Compare the fuzzy approach with a more classical one
 #
 # Still to be done!

----
[[
[[Category ?]]
]]