fork download
copy 
  1. ;;==========================================================================
  2. ;;
  3. ;; STARTER FILE FOR CSC 4240/5240 PROGRAM #1: Eliza
  4. ;;==========================================================================
  5.  
  6. ;;----------------------------------------------------------------------------
  7. ;; eliza: top-level function which, when given a sentence (no
  8. ;; punctuation, please!), comes back with a response like you would.
  9.  
  10. ( defun eliza ( sentence )
  11.   ;(format t "Input type: ~a, value: ~a~%" (type-of sentence) sentence)
  12.   ( respond ( change-pros sentence ) database ) )
  13.  
  14. ;;----------------------------------------------------------------------------
  15. ;; change-pros: changes the pronouns of the sentence so that Eliza can
  16. ;; come back with the appropriately switched first and second person
  17. ;; references.
  18.  
  19. ( defun change-pros ( sentence )
  20.   ( cond 
  21.     ( ( null sentence ) nil )
  22.  
  23.     ( ( equal ( car sentence ) 'you )
  24.       ( cons 'I ( change-pros ( cdr sentence ) ) ) )
  25.     ( ( equal ( car sentence ) 'I )
  26.       ( cons 'you ( change-pros ( cdr sentence ) ) ) )
  27.  
  28.     ( ( equal ( car sentence ) 'am )
  29.       ( cons 'are ( change-pros ( cdr sentence ) ) ) )
  30.  
  31.     ( ( equal ( car sentence ) 'my )
  32.       ( cons 'your ( change-pros ( cdr sentence ) ) ) )
  33.     ( ( equal ( car sentence ) 'your )
  34.       ( cons 'my ( change-pros ( cdr sentence ) ) ) )
  35.  
  36.     ( ( equal ( car sentence ) 'mine )
  37.       ( cons 'yours ( change-pros ( cdr sentence ) ) ) )
  38.     ( ( equal ( car sentence ) 'yours )
  39.       ( cons 'mine ( change-pros ( cdr sentence ) ) ) )
  40.  
  41.     ( ( equal ( car sentence ) 'he )
  42.       ( cons 'him ( change-pros ( cdr sentence ) ) ) )
  43.     ( ( equal ( car sentence ) 'him )
  44.       ( cons 'he ( change-pros ( cdr sentence ) ) ) )
  45.  
  46.     ( ( equal ( car sentence ) 'she )
  47.       ( cons 'she ( change-pros ( cdr sentence ) ) ) )
  48.     ( ( equal ( car sentence ) 'her )
  49.       ( cons 'hers ( change-pros ( cdr sentence ) ) ) )
  50.     ( ( equal ( car sentence ) 'hers )
  51.       ( cons 'her ( change-pros ( cdr sentence ) ) ) )
  52.  
  53.     ( ( equal ( car sentence ) 'it )
  54.       ( cons 'it ( change-pros ( cdr sentence ) ) ) )
  55.  
  56.     ;; CHANGE THIS: add more cases here of pronouns or other words
  57.     ;; that should flip in order for this to work well
  58.  
  59.     ( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
  60.  
  61. ;;----------------------------------------------------------------------------
  62. ( defun get-random-index ( len )
  63.  
  64.     ;; random-idx is the variable that will store the random index we will return to the caller function. Initially is = 0
  65.     (setq random-idx 0)
  66.  
  67.     ;; We keep iterating until we have a value for our index which does not equal to 0 (it will be > 0 and < len)
  68.     ;; We apply mod operation to get an index from 0 to (len - 1) to choose a response to return
  69.     (loop while (= random-idx 0) do
  70.  
  71.         ;; 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
  72.         ;; 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
  73.         (setq modu (get-universal-time))
  74.  
  75.         ;; We apply the mod (remainder) operation to get an index that lies within the possible range: [1, len - 1] (inclusive)
  76. 	    (setq random-idx (mod modu len))
  77.     )
  78.  
  79.     ;; This is a safe-check. If for any reason the random index had value of 0, we return the first response we had
  80.     ;; since index 0 does not contain a response, it's just a placeholder for pattern-matching
  81.     (if (= random-idx 0)
  82.         (setq random-idx 1)
  83.         (princ ""))
  84.  
  85. 	;; We return the random index value we got to the caller function to use the response we have at our database at that index
  86. random-idx)
  87.  
  88.  
  89. ;; respond: given a sentence, looks through the database in search of
  90. ;; a matching pattern and the response; given the database response,
  91. ;; uses 'instantiate' to fill in the blanks, and returns the completed
  92. ;; response
  93.  
  94. ( defun respond ( sentence db )
  95.   ( cond
  96.     ;; end of DB, return nil - should never really happen
  97.     ( ( null db ) nil )
  98.  
  99.     ;; if the result of matching the sentence against the current
  100.     ;; pattern is a success, produce this response
  101.     ( 
  102.         ( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
  103.  
  104.         (setq random-index (get-random-index (length (car db))))
  105.  
  106.         ( instantiate result ( nth random-index ( car db ) ) )
  107.     )
  108.  
  109.     ;; otherwise, keep looking through the DB
  110.     ( t ( respond sentence ( cdr db ) ) ) ) )
  111.  
  112. ;;----------------------------------------------------------------------------
  113. ;; match: if there is not a match between this pattern and this data,
  114. ;; returns 'fail;' otherwise, returns the sentence in partitioned
  115. ;; format
  116.  
  117. ( defun match ( data pattern )
  118.   ( cond
  119.     ;; end of both data and pattern; a match
  120.     ( ( and ( null data ) ( null pattern ) ) nil )
  121.  
  122.     ;; end of pattern, but not end of data; no match
  123.     ( ( null pattern ) fail )
  124.  
  125.     ;; end of data, but not end of pattern; if the pattern starts with
  126.     ;; a variable, eat it and try and match the rest of the pattern to
  127.     ;; the null sentence (will only work if all variables); otherwise,
  128.     ;; fail
  129.     ( ( null data ) 
  130.       ( cond
  131. 	( ( variablep ( car pattern ) )
  132. 	  ( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
  133. 	      result
  134. 	    fail ) )
  135. 	( t fail ) ) )
  136.  
  137.  
  138.     ;; first item of data and pattern are identical; if the rest of it
  139.     ;; matched, return the first item cons'ed with the rest of the
  140.     ;; partitioned sentence; otherwise, fail
  141.     ( ( equal ( car data ) ( car pattern ) )
  142.       ( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
  143. 	  ( cons ( list ( car data ) ) result )
  144. 	fail ) )
  145.  
  146.     ;; first item of pattern is a variable; if the rest of the data
  147.     ;; (minus the first word, matched to the variable) is a match with
  148.     ;; all of the pattern, return the appropriate stuff; if all of the
  149.     ;; data (variable eats nothing) matches the rest of the pattern,
  150.     ;; return appropriate stuff; else, fail.
  151.     ( ( variablep ( car pattern ) ) 
  152.       ( cond
  153. 	;; variable eats nothing;  () is put in partitioned sentence
  154. 	( ( success ( setq result ( match data ( cdr pattern ) ) ) )
  155. 	  ( cons () result ) )
  156. 	;; variable eats one word; word is cons'ed into the first
  157. 	;; element of the partitioned sentence, assuming that the step
  158. 	;; before an actual match word would be a ()
  159. 	( ( success ( setq result ( match ( cdr data ) pattern ) ) )
  160. 	  ( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
  161. 	;; otherwise, fail
  162. 	( t fail ) ) )
  163.  
  164.     ( t fail ) ) )
  165.  
  166. ;;----------------------------------------------------------------------------
  167. ;; instantiate: takes a partitioned sentence and the response it has
  168. ;; been matched to and generates the appropriated completed response
  169.  
  170. ( defun instantiate ( partitioned response )
  171.   ( cond
  172.     ( ( null response ) nil )
  173.     ;; numbers indicate what part of the partitioned sentence to
  174.     ;; insert into the response
  175.     ( ( numberp ( car response ) )
  176.       ( setq index ( - ( car response ) 1 ) )
  177.       ( append ( nth index partitioned )
  178. 	     ( instantiate partitioned ( cdr response ) ) ) )
  179.     ( t ( cons ( car response )
  180. 	     ( instantiate partitioned ( cdr response ) ) ) ) ) )
  181.  
  182. ;;---------------------------------------------------------------------------
  183. ;;
  184. ;;  			     helping functions
  185. ;;
  186. ;;---------------------------------------------------------------------------
  187.  
  188. ( setq fail '-1 )
  189.  
  190. ( defun success ( result )
  191.   ( not ( equal result fail ) ) )
  192.  
  193. ( defun variablep ( word )
  194.   ( equal word '0 ) )
  195.  
  196.  
  197. ;;---------------------------------------------------------------------------
  198. ;;
  199. ;;  			         database
  200. ;;
  201. ;;---------------------------------------------------------------------------
  202.  
  203. ;; CHANGE THIS: add more to this database so that the interaction is
  204. ;; more interesting and communicative and so that Eliza sounds like you 
  205. ;; would sound in the same conversation!
  206. ;;---------------------------------------------------------------------------
  207.  
  208. ;; Here I show the extra rules I added to the previous rules we already had at the starter file.
  209. ;; I tried adding different rules covering different cases, scenarios, and different emotions.
  210. ;; For the generic response, I added multiple ones in order to have multiple random ones that can be used needed
  211.  
  212. ( setq database
  213.     '(
  214.         ;; example greetings/farewells -- change them to sound like you
  215.         (
  216.         (Hello 0)
  217.         ("Hello - have a seat and tell me how you feel today.") 
  218.         )
  219.  
  220.         ( (0 Goodbye 0)
  221.         ("Goodbye - I hope you enjoyed this session.") )
  222.  
  223.         ( (0 You came here because 0)
  224.         (A lot of people come here for that reason so you are not alone.) )
  225.  
  226.         ;; normal open questions
  227.         ((0 your day 0)
  228.         ("Great! I would love to hear that, tell me how was your day?")
  229.         )
  230.  
  231.         ;; personal information about favourite things
  232.         (
  233.           (0 my favourite team won 0)
  234.           ("I'm glad to hear that! Tell me how's your health?" )
  235.         )
  236.  
  237.         ;; feelings
  238.         ( (0 you think 0)
  239.         (And just why do you think 4 ? ) )
  240.  
  241.         ( (0 you are happy 0) 
  242.         (That's wonderful! What’s making you happy today? ) )
  243.  
  244.         (
  245.           (0 you feel joyful 0)
  246.           ("I'm glad to hear that! Tell me more what makes you feel joyful?" )
  247.         )
  248.  
  249.         ((0 feel excited 0)
  250.         ("I'm glad to hear that! Tell me more what makes you feel excited?")
  251.         )
  252.  
  253.  
  254.         ((0 too much work 0)
  255.           ("Try getting some rest please, maybe get tomorrow as vacation")
  256.         )
  257.  
  258.         ((0 go to the gym 0)
  259.         ("Oh that is great! This is really very important to maintain a good health.")
  260.         )
  261.  
  262.         ((0 feel tired 0)
  263.           ("Sad to hear that. What happened?")
  264.         )
  265.  
  266.         ((0 you feel sad 0) 
  267.         ("I'm sorry to hear that. Why do you think you are sad?" 
  268.           "What’s making you feel sad?" 
  269.           "Tell me more about what’s troubling you."))
  270.  
  271.         ;; recognize certain keywords and respond
  272.         ((0 try rescheduling 0)
  273.           ("That would be great! I hope you find another appointement soon")
  274.         )
  275.  
  276.         ((0 you are late 0)
  277.           ("It is never too late. Try to catch up.")
  278.         )
  279.  
  280.         ((0 laptop not working 0)
  281.           ("It is frustrating to hear that.. do you have a backup of your data?")
  282.         )
  283.  
  284.         ;; actions/acts
  285.         ((0 password 0)
  286.           ("You can reset your password if you forgot it")
  287.         )
  288.  
  289.         ((0 got lost 0)
  290.           ("Try calling 911 or go to nearest police station! Take care!")
  291.         )
  292.  
  293.         ((0 have breakfast 0)
  294.         ("Bon appétit! What will you eat?")
  295.         )
  296.  
  297.         ((0 will eat 0)
  298.         ("I do not know this food. What is it about?")
  299.         )
  300.  
  301.         ((0 have lunch 0)
  302.         ("Bon appétit! What will you eat?")
  303.         )
  304.  
  305.         ((0 have dinner 0)
  306.         ("Bon appétit! What will you eat?")
  307.         )
  308.  
  309.         ((0 delicious food 0)
  310.         ("Aha! That sounds tasty, enjoy your meal!")
  311.         )
  312.  
  313.         ((0 missed your appointment 0)
  314.         ("Uhh.. Can you try rescheduling it?")
  315.         )
  316.  
  317.         ((0 information 0)
  318.         ("Thanks for the new information. So how is everything else?")
  319.         )
  320.  
  321.         ((0 you are angry 0)
  322.         ("Why do you think you’re feeling so angry?" )
  323.           ("Can you tell me more about what’s making you angry?"))
  324.  
  325.         ;; the catch-alls
  326.         (
  327.           (0) 
  328.           ("Could you expand on that?")
  329.           ("Hmmm.. Is it possible to elaborate more on that please?")
  330.           ("Hmmm.. I feel I didn't get what you mean. Can you explain again in other terms?")
  331.           ("Uhh.. I fear I don't understand what are you talking about..")
  332.           ("Ops, didn't get it, please expand on that.")
  333.           ("Sorry, I could understand that. Can you elaborate more?")
  334.         )
  335.     )
  336. )
  337.  
  338. (princ (eliza '(I am late)))
  339.  
Success #stdin #stdout #stderr 0.02s 9676KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(It is never too late. Try to catch up.)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x151fb0c00000 - 0x151fb0ee4fff
  0x151fb1015000 - 0x151fb1039fff
  0x151fb103a000 - 0x151fb11acfff
  0x151fb11ad000 - 0x151fb11f5fff
  0x151fb11f6000 - 0x151fb11f8fff
  0x151fb11f9000 - 0x151fb11fbfff
  0x151fb11fc000 - 0x151fb11fffff
  0x151fb1200000 - 0x151fb1202fff
  0x151fb1203000 - 0x151fb1401fff
  0x151fb1402000 - 0x151fb1402fff
  0x151fb1403000 - 0x151fb1403fff
  0x151fb1480000 - 0x151fb148ffff
  0x151fb1490000 - 0x151fb14c3fff
  0x151fb14c4000 - 0x151fb15fafff
  0x151fb15fb000 - 0x151fb15fbfff
  0x151fb15fc000 - 0x151fb15fefff
  0x151fb15ff000 - 0x151fb15fffff
  0x151fb1600000 - 0x151fb1603fff
  0x151fb1604000 - 0x151fb1803fff
  0x151fb1804000 - 0x151fb1804fff
  0x151fb1805000 - 0x151fb1805fff
  0x151fb1867000 - 0x151fb186afff
  0x151fb186b000 - 0x151fb186bfff
  0x151fb186c000 - 0x151fb186dfff
  0x151fb186e000 - 0x151fb186efff
  0x151fb186f000 - 0x151fb186ffff
  0x151fb1870000 - 0x151fb1870fff
  0x151fb1871000 - 0x151fb187efff
  0x151fb187f000 - 0x151fb188cfff
  0x151fb188d000 - 0x151fb1899fff
  0x151fb189a000 - 0x151fb189dfff
  0x151fb189e000 - 0x151fb189efff
  0x151fb189f000 - 0x151fb189ffff
  0x151fb18a0000 - 0x151fb18a5fff
  0x151fb18a6000 - 0x151fb18a7fff
  0x151fb18a8000 - 0x151fb18a8fff
  0x151fb18a9000 - 0x151fb18a9fff
  0x151fb18aa000 - 0x151fb18aafff
  0x151fb18ab000 - 0x151fb18d8fff
  0x151fb18d9000 - 0x151fb18e7fff
  0x151fb18e8000 - 0x151fb198dfff
  0x151fb198e000 - 0x151fb1a24fff
  0x151fb1a25000 - 0x151fb1a25fff
  0x151fb1a26000 - 0x151fb1a26fff
  0x151fb1a27000 - 0x151fb1a3afff
  0x151fb1a3b000 - 0x151fb1a62fff
  0x151fb1a63000 - 0x151fb1a6cfff
  0x151fb1a6d000 - 0x151fb1a6efff
  0x151fb1a6f000 - 0x151fb1a74fff
  0x151fb1a75000 - 0x151fb1a77fff
  0x151fb1a7a000 - 0x151fb1a7afff
  0x151fb1a7b000 - 0x151fb1a7bfff
  0x151fb1a7c000 - 0x151fb1a7cfff
  0x151fb1a7d000 - 0x151fb1a7dfff
  0x151fb1a7e000 - 0x151fb1a7efff
  0x151fb1a7f000 - 0x151fb1a85fff
  0x151fb1a86000 - 0x151fb1a88fff
  0x151fb1a89000 - 0x151fb1a89fff
  0x151fb1a8a000 - 0x151fb1aaafff
  0x151fb1aab000 - 0x151fb1ab2fff
  0x151fb1ab3000 - 0x151fb1ab3fff
  0x151fb1ab4000 - 0x151fb1ab4fff
  0x151fb1ab5000 - 0x151fb1ab5fff
  0x55b7f71c2000 - 0x55b7f72b2fff
  0x55b7f72b3000 - 0x55b7f73bcfff
  0x55b7f73bd000 - 0x55b7f741cfff
  0x55b7f741e000 - 0x55b7f744cfff
  0x55b7f744d000 - 0x55b7f747dfff
  0x55b7f747e000 - 0x55b7f7481fff
  0x55b7f7fcd000 - 0x55b7f7fedfff
  0x7ffc7f1e2000 - 0x7ffc7f202fff
  0x7ffc7f2d7000 - 0x7ffc7f2dafff
  0x7ffc7f2db000 - 0x7ffc7f2dcfff
https://ideone.com/7j6wGg
language:
Common Lisp (clisp 2.49.92)
created:
2 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!