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:
Here is a link to what seems the original publication [L1 ]
(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