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.   ( respond ( change-pros sentence ) database ) )
  12.  
  13. ;;----------------------------------------------------------------------------
  14. ;; change-pros: changes the pronouns of the sentence so that Eliza can
  15. ;; come back with the appropriately switched first and second person
  16. ;; references.
  17.  
  18. ( defun change-pros ( sentence )
  19.   ( cond 
  20.     ( ( null sentence ) nil )
  21.     ( ( equal ( car sentence ) 'you )
  22.       ( cons 'I ( change-pros ( cdr sentence ) ) ) )
  23.     ( ( equal ( car sentence ) 'I )
  24.       ( cons 'you ( change-pros ( cdr sentence ) ) ) )
  25.  
  26.     ;; CHANGE THIS: add more cases here of pronouns or other words
  27.     ;; that should flip in order for this to work well
  28.  
  29.     ( ( equal ( car sentence ) 'am )
  30.       ( cons 'are ( change-pros ( cdr sentence ) ) ) )
  31.     ( ( equal ( car sentence ) 'are )
  32.       ( cons 'am ( change-pros ( cdr sentence ) ) ) )
  33.  
  34.      ( ( equal ( car sentence ) 'me )
  35.       ( cons 'you ( change-pros ( cdr sentence ) ) ) )
  36.      ( ( equal ( car sentence ) 'you )
  37.       ( cons 'me ( change-pros ( cdr sentence ) ) ) )
  38.  
  39.      ( ( equal ( car sentence ) 'my )
  40.       ( cons 'your ( change-pros ( cdr sentence ) ) ) )
  41.      ( ( equal ( car sentence ) 'your )
  42.       ( cons 'my ( change-pros ( cdr sentence ) ) ) )
  43.  
  44.      ( ( equal ( car sentence ) 'messed )
  45.       ( cons 'mess ( change-pros ( cdr sentence ) ) ) )  
  46.      ( ( equal ( car sentence ) 'mess )
  47.       ( cons 'messed ( change-pros ( cdr sentence ) ) ) )  
  48.  
  49.      ( ( equal ( car sentence ) 'because )
  50.       ( cons 'because ( change-pros ( cdr sentence ) ) ) )
  51.      ( ( equal ( car sentence ) 'so )
  52.       ( cons 'because ( change-pros ( cdr sentence ) ) ) )
  53.  
  54.  
  55.  
  56.     ( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
  57.  
  58. ;;----------------------------------------------------------------------------
  59. ;; respond: given a sentence, looks through the database in search of
  60. ;; a matching pattern and the response; given the database response,
  61. ;; uses 'instantiate' to fill in the blanks, and returns the completed
  62. ;; response
  63.  
  64. ( defun respond ( sentence db )
  65.   ( cond
  66.     ;; end of DB, return nil - should never really happen
  67.     ( ( null db ) nil )
  68.  
  69.     ;; if the result of matching the sentence against the current
  70.     ;; pattern is a success, produce this response
  71.     ( ( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
  72.       ( instantiate result ( second ( car db ) ) ) )
  73.  
  74.     ;; otherwise, keep looking through the DB
  75.     ( t ( respond sentence ( cdr db ) ) ) ) )
  76.  
  77. ;;----------------------------------------------------------------------------
  78. ;; match: if there is not a match between this pattern and this data,
  79. ;; returns 'fail;' otherwise, returns the sentence in partitioned
  80. ;; format
  81.  
  82. ( defun match ( data pattern )
  83.   ( cond
  84.     ;; end of both data and pattern; a match
  85.     ( ( and ( null data ) ( null pattern ) ) nil )
  86.  
  87.     ;; end of pattern, but not end of data; no match
  88.     ( ( null pattern ) fail )
  89.  
  90.     ;; end of data, but not end of pattern; if the pattern starts with
  91.     ;; a variable, eat it and try and match the rest of the pattern to
  92.     ;; the null sentence (will only work if all variables); otherwise,
  93.     ;; fail
  94.     ( ( null data ) 
  95.       ( cond
  96. 	( ( variablep ( car pattern ) )
  97. 	  ( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
  98. 	      result
  99. 	    fail ) )
  100. 	( t fail ) ) )
  101.  
  102.  
  103.     ;; first item of data and pattern are identical; if the rest of it
  104.     ;; matched, return the first item cons'ed with the rest of the
  105.     ;; partitioned sentence; otherwise, fail
  106.     ( ( equal ( car data ) ( car pattern ) )
  107.       ( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
  108. 	  ( cons ( list ( car data ) ) result )
  109. 	fail ) )
  110.  
  111.     ;; first item of pattern is a variable; if the rest of the data
  112.     ;; (minus the first word, matched to the variable) is a match with
  113.     ;; all of the pattern, return the appropriate stuff; if all of the
  114.     ;; data (variable eats nothing) matches the rest of the pattern,
  115.     ;; return appropriate stuff; else, fail.
  116.     ( ( variablep ( car pattern ) ) 
  117.       ( cond
  118. 	;; variable eats nothing;  () is put in partitioned sentence
  119. 	( ( success ( setq result ( match data ( cdr pattern ) ) ) )
  120. 	  ( cons () result ) )
  121. 	;; variable eats one word; word is cons'ed into the first
  122. 	;; element of the partitioned sentence, assuming that the step
  123. 	;; before an actual match word would be a ()
  124. 	( ( success ( setq result ( match ( cdr data ) pattern ) ) )
  125. 	  ( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
  126. 	;; otherwise, fail
  127. 	( t fail ) ) )
  128.  
  129.     ( t fail ) ) )
  130.  
  131. ;;----------------------------------------------------------------------------
  132. ;; instantiate: takes a partitioned sentence and the response it has
  133. ;; been matched to and generates the appropriated completed response
  134.  
  135. ( defun instantiate ( partitioned response )
  136.   ( cond
  137.     ( ( null response ) nil )
  138.     ;; numbers indicate what part of the partitioned sentence to
  139.     ;; insert into the response
  140.     ( ( numberp ( car response ) )
  141.       ( setq index ( - ( car response ) 1 ) )
  142.       ( append ( nth index partitioned )
  143. 	     ( instantiate partitioned ( cdr response ) ) ) )
  144.     ( t ( cons ( car response )
  145. 	     ( instantiate partitioned ( cdr response ) ) ) ) ) )
  146.  
  147. ;;---------------------------------------------------------------------------
  148. ;;
  149. ;;  			     helping functions
  150. ;;
  151. ;;---------------------------------------------------------------------------
  152.  
  153. ( setq fail '-1 )
  154.  
  155. ( defun success ( result )
  156.   ( not ( equal result fail ) ) )
  157.  
  158. ( defun variablep ( word )
  159.   ( equal word '0 ) )
  160.  
  161.  
  162. ;;---------------------------------------------------------------------------
  163. ;;
  164. ;;  			         database
  165. ;;
  166. ;;---------------------------------------------------------------------------
  167.  
  168. ;; CHANGE THIS: add more to this database so that the interaction is
  169. ;; more interesting and communicative and so that Eliza sounds like you 
  170. ;; would sound in the same conversation!
  171. ;;---------------------------------------------------------------------------
  172.  
  173. ( setq database
  174.        '(
  175. 	 ;; example greetings/farewells -- change them to sound like you
  176. 	 ( (Hello 0)
  177. 	   (Heyyy - how are you feeling today?) )
  178. 	 ( (0 you came here because 0)
  179. 	   (Many times we simply need to talk things out so I am here for you. Talk to me.) )
  180. 	 ( (0 Goodbye 0)
  181. 	   (Goodbye - I hope you are feeling better. I am here for you anytime.) )
  182.      ( (0 Sad 0)
  183. 	   (Why do you feel sad?) )
  184. 	 ( (0 Mad 0)
  185. 	   (What has caused you to be mad ?) )
  186. 	 ( (0 Yes 0)
  187. 	   (You have to keep trying and move forward!) )
  188. 	 ( (0 a little bit 0)
  189. 	   (You have to keep trying and move forward!) )
  190. 	 ( (0 No 0)
  191. 	   (Try harder!) )
  192.  
  193. 	 ;; feelings
  194. 	 ( (0 you think you 0)
  195. 	   ( why do you think you 5 ?) )
  196. 	 ;;( (0 you want to be 0) 
  197. 	  ;; (Would you want a solution or are you looking for me to listen?) ) ) )
  198.  
  199.  
  200. 	 ;; trying to find a solution
  201. 	 ( (0 because you 0)
  202. 	   ( have you tried to not 4 ?) )
  203. 	 ( (0 because the 0)
  204. 	   ( what makes you feel like the 4 ?) )
  205. 	 ( (0 but 0)
  206. 	   ( but what if it isn't that bad 4 ?) )
  207.  
  208.  
  209.  
  210. 	 ;; the catch-alls
  211. 	 ( (0) 
  212. 	   (Okay. Help me understand your feelings better. Tell me more.) ) ) )
  213.  
  214.  
  215. ;; response input 
  216. (format t "~a~%" (eliza '(hello)))
  217. (format t "~a~%" (eliza '(i dont know)))
  218. (format t "~a~%" (eliza '(i think i am failing)))
  219. (format t "~a~%" (eliza '(because i messed up)))
  220. (format t "~a~%" (eliza '(a little bit)))
  221. (format t "~a~%" (eliza '(but life is so hard)))
  222. (format t "~a~%" (eliza '(i want to be better)))
Success #stdin #stdout #stderr 0.02s 9684KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(HEYYY - HOW ARE YOU FEELING TODAY?)
(OKAY. HELP ME UNDERSTAND YOUR FEELINGS BETTER. TELL ME MORE.)
(WHY DO YOU THINK YOU ARE FAILING ?)
(HAVE YOU TRIED TO NOT MESS UP ?)
(YOU HAVE TO KEEP TRYING AND MOVE FORWARD!)
(BUT WHAT IF IT ISN 'T THAT BAD ?)
(OKAY. HELP ME UNDERSTAND YOUR FEELINGS BETTER. TELL ME MORE.)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x1525cca00000 - 0x1525ccce4fff
  0x1525cce15000 - 0x1525cce39fff
  0x1525cce3a000 - 0x1525ccfacfff
  0x1525ccfad000 - 0x1525ccff5fff
  0x1525ccff6000 - 0x1525ccff8fff
  0x1525ccff9000 - 0x1525ccffbfff
  0x1525ccffc000 - 0x1525ccffffff
  0x1525cd000000 - 0x1525cd002fff
  0x1525cd003000 - 0x1525cd201fff
  0x1525cd202000 - 0x1525cd202fff
  0x1525cd203000 - 0x1525cd203fff
  0x1525cd280000 - 0x1525cd28ffff
  0x1525cd290000 - 0x1525cd2c3fff
  0x1525cd2c4000 - 0x1525cd3fafff
  0x1525cd3fb000 - 0x1525cd3fbfff
  0x1525cd3fc000 - 0x1525cd3fefff
  0x1525cd3ff000 - 0x1525cd3fffff
  0x1525cd400000 - 0x1525cd403fff
  0x1525cd404000 - 0x1525cd603fff
  0x1525cd604000 - 0x1525cd604fff
  0x1525cd605000 - 0x1525cd605fff
  0x1525cd66f000 - 0x1525cd672fff
  0x1525cd673000 - 0x1525cd673fff
  0x1525cd674000 - 0x1525cd675fff
  0x1525cd676000 - 0x1525cd676fff
  0x1525cd677000 - 0x1525cd677fff
  0x1525cd678000 - 0x1525cd678fff
  0x1525cd679000 - 0x1525cd686fff
  0x1525cd687000 - 0x1525cd694fff
  0x1525cd695000 - 0x1525cd6a1fff
  0x1525cd6a2000 - 0x1525cd6a5fff
  0x1525cd6a6000 - 0x1525cd6a6fff
  0x1525cd6a7000 - 0x1525cd6a7fff
  0x1525cd6a8000 - 0x1525cd6adfff
  0x1525cd6ae000 - 0x1525cd6affff
  0x1525cd6b0000 - 0x1525cd6b0fff
  0x1525cd6b1000 - 0x1525cd6b1fff
  0x1525cd6b2000 - 0x1525cd6b2fff
  0x1525cd6b3000 - 0x1525cd6e0fff
  0x1525cd6e1000 - 0x1525cd6effff
  0x1525cd6f0000 - 0x1525cd795fff
  0x1525cd796000 - 0x1525cd82cfff
  0x1525cd82d000 - 0x1525cd82dfff
  0x1525cd82e000 - 0x1525cd82efff
  0x1525cd82f000 - 0x1525cd842fff
  0x1525cd843000 - 0x1525cd86afff
  0x1525cd86b000 - 0x1525cd874fff
  0x1525cd875000 - 0x1525cd876fff
  0x1525cd877000 - 0x1525cd87cfff
  0x1525cd87d000 - 0x1525cd87ffff
  0x1525cd882000 - 0x1525cd882fff
  0x1525cd883000 - 0x1525cd883fff
  0x1525cd884000 - 0x1525cd884fff
  0x1525cd885000 - 0x1525cd885fff
  0x1525cd886000 - 0x1525cd886fff
  0x1525cd887000 - 0x1525cd88dfff
  0x1525cd88e000 - 0x1525cd890fff
  0x1525cd891000 - 0x1525cd891fff
  0x1525cd892000 - 0x1525cd8b2fff
  0x1525cd8b3000 - 0x1525cd8bafff
  0x1525cd8bb000 - 0x1525cd8bbfff
  0x1525cd8bc000 - 0x1525cd8bcfff
  0x1525cd8bd000 - 0x1525cd8bdfff
  0x55eed6da5000 - 0x55eed6e95fff
  0x55eed6e96000 - 0x55eed6f9ffff
  0x55eed6fa0000 - 0x55eed6ffffff
  0x55eed7001000 - 0x55eed702ffff
  0x55eed7030000 - 0x55eed7060fff
  0x55eed7061000 - 0x55eed7064fff
  0x55eed7715000 - 0x55eed7735fff
  0x7fffa464e000 - 0x7fffa466efff
  0x7fffa478f000 - 0x7fffa4792fff
  0x7fffa4793000 - 0x7fffa4794fff
https://ideone.com/73iLqf
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!