;gnu clisp 2.49.60
;;
;; STARTER FILE FOR CSC 4240/5240 PROGRAM #1: Eliza
;;==========================================================================
;;----------------------------------------------------------------------------
;; eliza: top-level function which, when given a sentence (no
;; punctuation, please!), comes back with a response like you would.
( defun eliza ( sentence )
;(format t "Input type: ~a, value: ~a~%" (type-of sentence) sentence)
( respond ( change-pros sentence ) database ) )
;;----------------------------------------------------------------------------
;; change-pros: changes the pronouns of the sentence so that Eliza can
;; come back with the appropriately switched first and second person
;; references.
( defun change-pros ( sentence )
( cond
( ( null sentence ) nil )
( ( equal ( car sentence ) 'you )
( cons 'I ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'I )
( cons 'you ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'am )
( cons 'are ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'my )
( cons 'your ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'your )
( cons 'my ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'mine )
( cons 'yours ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'yours )
( cons 'mine ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'he )
( cons 'him ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'him )
( cons 'he ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'she )
( cons 'she ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'her )
( cons 'hers ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'hers )
( cons 'her ( change-pros ( cdr sentence ) ) ) )
( ( equal ( car sentence ) 'it )
( cons 'it ( change-pros ( cdr sentence ) ) ) )
;; CHANGE THIS: add more cases here of pronouns or other words
;; that should flip in order for this to work well
( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
;;----------------------------------------------------------------------------
( defun get-random-index ( len )
;; random-idx is the variable that will store the random index we will return to the caller function. Initially is = 0
(setq random-idx 0)
;; We keep iterating until we have a value for our index which does not equal to 0 (it will be > 0 and < len)
;; We apply mod operation to get an index from 0 to (len - 1) to choose a response to return
(loop while (= random-idx 0) do
;; I thought of an easy way how to get a random value to act as our seed and the timestamp would work perfect for this case
;; get current timestamp as if its our seed, and we are sure it is a dynamic value and it will always lead to random results
(setq modu (get-universal-time))
;; We apply the mod (remainder) operation to get an index that lies within the possible range: [1, len - 1] (inclusive)
(setq random-idx (mod modu len))
)
;; This is a safe-check. If for any reason the random index had value of 0, we return the first response we had
;; since index 0 does not contain a response, it's just a placeholder for pattern-matching
(if (= random-idx 0)
(setq random-idx 1)
(princ ""))
;; We return the random index value we got to the caller function to use the response we have at our database at that index
random-idx)
;; respond: given a sentence, looks through the database in search of
;; a matching pattern and the response; given the database response,
;; uses 'instantiate' to fill in the blanks, and returns the completed
;; response
( defun respond ( sentence db )
( cond
;; end of DB, return nil - should never really happen
( ( null db ) nil )
;; if the result of matching the sentence against the current
;; pattern is a success, produce this response
(
( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
(setq random-index (get-random-index (length (car db))))
( instantiate result ( nth random-index ( car db ) ) )
)
;; otherwise, keep looking through the DB
( t ( respond sentence ( cdr db ) ) ) ) )
;;----------------------------------------------------------------------------
;; match: if there is not a match between this pattern and this data,
;; returns 'fail;' otherwise, returns the sentence in partitioned
;; format
( defun match ( data pattern )
( cond
;; end of both data and pattern; a match
( ( and ( null data ) ( null pattern ) ) nil )
;; end of pattern, but not end of data; no match
( ( null pattern ) fail )
;; end of data, but not end of pattern; if the pattern starts with
;; a variable, eat it and try and match the rest of the pattern to
;; the null sentence (will only work if all variables); otherwise,
;; fail
( ( null data )
( cond
( ( variablep ( car pattern ) )
( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
result
fail ) )
( t fail ) ) )
;; first item of data and pattern are identical; if the rest of it
;; matched, return the first item cons'ed with the rest of the
;; partitioned sentence; otherwise, fail
( ( equal ( car data ) ( car pattern ) )
( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
( cons ( list ( car data ) ) result )
fail ) )
;; first item of pattern is a variable; if the rest of the data
;; (minus the first word, matched to the variable) is a match with
;; all of the pattern, return the appropriate stuff; if all of the
;; data (variable eats nothing) matches the rest of the pattern,
;; return appropriate stuff; else, fail.
( ( variablep ( car pattern ) )
( cond
;; variable eats nothing; () is put in partitioned sentence
( ( success ( setq result ( match data ( cdr pattern ) ) ) )
( cons () result ) )
;; variable eats one word; word is cons'ed into the first
;; element of the partitioned sentence, assuming that the step
;; before an actual match word would be a ()
( ( success ( setq result ( match ( cdr data ) pattern ) ) )
( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
;; otherwise, fail
( t fail ) ) )
( t fail ) ) )
;;----------------------------------------------------------------------------
;; instantiate: takes a partitioned sentence and the response it has
;; been matched to and generates the appropriated completed response
( defun instantiate ( partitioned response )
( cond
( ( null response ) nil )
;; numbers indicate what part of the partitioned sentence to
;; insert into the response
( ( numberp ( car response ) )
( setq index ( - ( car response ) 1 ) )
( append ( nth index partitioned )
( instantiate partitioned ( cdr response ) ) ) )
( t ( cons ( car response )
( instantiate partitioned ( cdr response ) ) ) ) ) )
;;---------------------------------------------------------------------------
;;
;; helping functions
;;
;;---------------------------------------------------------------------------
( setq fail '-1 )
( defun success ( result )
( not ( equal result fail ) ) )
( defun variablep ( word )
( equal word '0 ) )
;;---------------------------------------------------------------------------
;;
;; database
;;
;;---------------------------------------------------------------------------
;; CHANGE THIS: add more to this database so that the interaction is
;; more interesting and communicative and so that Eliza sounds like you
;; would sound in the same conversation!
;;---------------------------------------------------------------------------
;; Here I show the extra rules I added to the previous rules we already had at the starter file.
;; I tried adding different rules covering different cases, scenarios, and different emotions.
;; For the generic response, I added multiple ones in order to have multiple random ones that can be used needed
( setq database
'(
;; example greetings/farewells -- change them to sound like you
(
(Hello 0)
("Hello - have a seat and tell me how you feel today.")
)
( (0 Goodbye 0)
("Goodbye - I hope you enjoyed this session.") )
( (0 You came here because 0)
(A lot of people come here for that reason so you are not alone.) )
;; normal open questions
((0 your day 0)
("Great! I would love to hear that, tell me how was your day?")
)
;; personal information about favourite things
(
(0 my favourite team won 0)
("I'm glad to hear that! Tell me how's your health?" )
)
;; feelings
( (0 you think 0)
(And just why do you think 4 ? ) )
( (0 you are happy 0)
(That's wonderful! What’s making you happy today? ) )
(
(0 you feel joyful 0)
("I'm glad to hear that! Tell me more what makes you feel joyful?" )
)
((0 feel excited 0)
("I'm glad to hear that! Tell me more what makes you feel excited?")
)
((0 too much work 0)
("Try getting some rest please, maybe get tomorrow as vacation")
)
((0 go to the gym 0)
("Oh that is great! This is really very important to maintain a good health.")
)
((0 feel tired 0)
("Sad to hear that. What happened?")
)
((0 you feel sad 0)
("I'm sorry to hear that. Why do you think you are sad?"
"Tell me more about what’s troubling you."))
((0 you are angry 0)
("Why do you think you’re feeling so angry?" )
)
;; recognize certain keywords and respond
((0 try rescheduling 0)
("That would be great! I hope you find another appointement soon")
)
((0 you are late 0)
("It is never too late. Try to catch up.")
)
((0 laptop not working 0)
("It is frustrating to hear that.. do you have a backup of your data?")
)
;; actions/acts
((0 password 0)
("You can reset your password if you forgot it")
)
((0 got lost 0)
("Try calling 911 or go to nearest police station! Take care!")
)
((0 have breakfast 0)
("Bon appétit! What will you eat?")
)
((0 will eat 0)
("I do not know this food. What is it about?")
)
((0 have lunch 0)
("Bon appétit! What will you eat?")
)
((0 have dinner 0)
("Bon appétit! What will you eat?")
)
((0 delicious food 0)
("Aha! That sounds tasty, enjoy your meal!")
)
((0 missed your appointment 0)
("Uhh.. Can you try rescheduling it?")
)
((0 information 0)
("Thanks for the new information. Glad that you feel happy. So how is everything else?")
)
;; the catch-alls
(
(0)
("Could you expand on that?")
("Hmmm.. Is it possible to elaborate more on that please?")
("Hmmm.. I feel I didn't get what you mean. Can you explain again in other terms?")
("Uhh.. I fear I don't understand what are you talking about..")
("Ops, didn't get it, please expand on that.")
("Sorry, I could not understand that. Can you elaborate more?")
)
)
)
(princ (eliza '(I feel sad)))