[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]] Here is a link to what seems the original publication [http://i5.nyu.edu/~mm64/x52.9265/january1966.html] (Mental note: This can be the basis for a different kind of game - one that explores the possibilities of state machines. The metaphore I used is "tamagochi", 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 seperate 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 } ---- [Category Education] - [Category Toys]