[Arjen Markus] The program "Eliza" is famous as an example of ''artificial intelligence'', even though there is nothing particularly intelligent about the program itself. The idea is brilliant: the program can be described as emulating "a non-reactive psychiatrist, that is, a person who never answered your any of your questions, but merely turned the answers back upon you." (quote from B. Allan, "Introducing LOGO").

I implemented a simple version with just a few phrases and keywords, relying on the sample code in the above book. To be run using tclsh (not wish!). 

The educational aspects: 

   * It is easy to extend with different phrases
   * It can be simplified, because now you can have multiple replies to the same keyword
   * It shows how to work with lists
   * It shows how to "massage" the input from the user via [[regsub]]

----
 # eliza.tcl --
 #    A very basic implementation of the famous Eliza program
 #    (Idea copied from the book Introducing LOGO by Boris Allan)
 #

 namespace eval ::Talk {
    variable keywords [list]
    variable phrases  [list]
    variable dummies  [list]
 }

 # response --
 #    Link a response to a keyword (group multiple responses to
 #    the same keyword)
 #
 # Arguments:
 #    keyword   Keyword to respond to
 #    phrase    The phrase to print
 # Result:
 #    None
 # Side effects:
 #    Update of the lists keywords and phrases
 #
 proc ::Talk::response { keyword phrase } {
    variable keywords
    variable phrases

    set keyword [string tolower $keyword]
    set idx [lsearch $keywords $keyword]

    #
    # The keyword is new, then add it.
    # Otherwise only extend the list of responses
    #
    if { $idx == -1 } {
       lappend keywords $keyword
       lappend phrases  [list $phrase]
    } else {
       set prev_phrases [lindex $phrases $idx]
       set new_phrases  [concat $prev_phrases [list $phrase]]
       set phrases      [lreplace $phrases $idx $idx $new_phrases]
       puts $phrases
    }
 }

 # dummy --
 #    Register dummy phrases (used when no response is suitable)
 #
 # Arguments:
 #    phrase    The phrase to print
 # Result:
 #    None
 # Side effects:
 #    Update of the list dummies
 #
 proc ::Talk::dummy { phrase } {
    variable dummies

    lappend dummies $phrase
 }

 # replyto --
 #    Reply to the user (based on the given phrase)
 #
 # Arguments:
 #    phrase    The phrase the user typed in
 # Result:
 #    None
 # Side effects:
 #    Update of the lists keywords and phrases
 #
 proc ::Talk::replyto { phrase } {
    variable keywords
    variable phrases
    variable dummies

    regsub -all {[^A-Za-z]} $phrase " " phrase
    set idx    -1
    set phrase [string tolower $phrase]
    foreach word $phrase {
       set idx [lsearch $keywords $word]
       if { $idx > -1 } {
          set responses [lindex $phrases $idx]
          set which     [expr {int([llength $responses]*rand())}]
          set answer    [lindex $responses $which]
          break
       }
    }
    if { $idx == -1 } {
       set which     [expr {int([llength $dummies]*rand())}]
       set answer    [lindex $dummies $which]
    }

    puts $answer
 }

 # main code --
 #    Get the script going:
 #    - Create a little database of responses
 #    - Start the question-answer loop
 #
 ::Talk::response computer  "Are you worried about machines?"
 ::Talk::response computers "We are intelligent!"
 ::Talk::response program   "I just love Tcl - I was written in it"
 ::Talk::response off       "No, sorry"
 ::Talk::response no        "Tell me, why not?"
 ::Talk::response life      "Life - do not talk to me about life!"
 ::Talk::response you       "We are considering you, not me"
 ::Talk::response I         "Do you often talk about yourself?"
 ::Talk::response I         "Do you like talking about yourself?"
 ::Talk::dummy    "So ... ?"
 ::Talk::dummy    "Shall we continue?"
 ::Talk::dummy    "What do you want to talk about?"
 ::Talk::dummy    "Anything specific?"

 puts "What is your problem? (End this conversation with: QUIT)"
 while { 1 } {
    gets stdin line
    if { $line == "QUIT" } {
       break
    } else {
       ::Talk::replyto $line
    }
 }
----
[Category Education]