;;==========================================================================
;;
;; 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?"
"What’s making you feel sad?"
"Tell me more about what’s troubling you."))
;; 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. So how is everything else?")
)
((0 you are angry 0)
("Why do you think you’re feeling so angry?" )
("Can you tell me more about what’s making you angry?"))
;; 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 understand that. Can you elaborate more?")
)
)
)
(princ (eliza '(hello)))