Updated 2016-03-02 18:16:13 by escargo

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 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]

Here is a link to what seems the original publication [1]

(Mental note: This can be the basis for a different kind of game - one that explores the possibilities of state machines. The metaphor I used is "tamagotchi", but it would be a creature with various moods and needs that talks to the user)

TV (jun 2 03) Excellent program idea, I didn't know it comes from such early computer days, I knew it from the trs80. I'm sure it is not all that can be done with tcl, but I thought I'd first let Recursing Eliza happen, and then do a multiple personality leading game in bwise, by having separate state elizas do supervized talking in various network configurations... Maybe after that a distributed version.
 # 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 Death  "Is this worry you?"
 ::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?"
 ::Talk::dummy    "Talk about something more interesting?"
 #
 # First version, simple and straightforward
 #
 set version 2
 if { $version == 1 } {
    puts "What is your problem? (End this conversation with: QUIT)"
    while { 1 } {
       gets stdin line
       if { $line == "QUIT" } {
          break
       } else {
          ::Talk::replyto $line
       }
    }
 }

 #
 # Second version, more complicated but with a modern twist :)
 #
 if { $version == 2 } {
    proc oneline {} {
       global responsive
       global forever
       if { $responsive == 1 } {
          gets stdin line
          if { $line == "QUIT" } {
             set forever 1
             break
          } else {
             ::Talk::replyto $line
             after 0 oneline
          }
       } else {
          after 1000 oneline
       }
    }
    proc phonecall {} {
       global responsive
       puts "Trrriiiing!"
       set responsive 0
       after  300 {puts "Damn"}
       after  600 {puts "Excuse me"}
       after 2600 {puts "Hm ...? At the office!"}
       after 4600 {puts "Yes"}
       after 5600 {puts "No"}
       after 6000 {puts "Eh, ..., no"}
       after 8000 {puts "Okay, bye"}
       after 8100 {puts "\nNow, where were we?"}
       after 8250 {set responsive 1}
    }

    puts "What is your problem? (End this conversation with: QUIT)"
    set responsive 1
    after [expr {int((10+10*rand())*1000)}] phonecall
    after 0 oneline

    vwait forever
 }

See also: Classic Eliza