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. 	   (Then you have to keep trying!) )
  188. 	 ( (0 No 0)
  189. 	   (Try harder!) )
  190.  
  191.  
  192. 	 ;; feelings
  193. 	 ( (0 you think you 0)
  194. 	   ( why do you think you 5 ?) )
  195.  
  196.  
  197. 	 ;; trying to find a solution
  198. 	 ( (0 because you 0)
  199. 	   ( have you tried to not 4 ?) )
  200. 	 ( (0 because the 0)
  201. 	   ( what makes you feel like the 4 ?) )
  202. 	 ( (0 but 0)
  203. 	   ( but what if it isn't that bad 4 ?) )
  204.  
  205.  
  206.  
  207. 	 ;; the catch-alls
  208. 	 ( (0) 
  209. 	   (Okay. Help me understand your feelings better. Tell me more.) ) ) )
  210. 	 ;;( (0) 
  211. 	  ;; (Do you want a solution or do you prefer I listen?) ) ) )
  212.  
  213. 	 ;; trying to reach a solution
  214.  	 ;;( (0 because you 0)
  215. 	   ;;( have you thought about not 3 ) )
  216.  
  217.  
  218. ;; response input 
  219. (format t "~a~%" (eliza '(hello)))
  220. (format t "~a~%" (eliza '(i dont know)))
  221. (format t "~a~%" (eliza '(i think i am late)))
  222. (format t "~a~%" (eliza '(because i messed up)))
  223. (format t "~a~%" (eliza '(yes)))
  224. (format t "~a~%" (eliza '(but life is so hard)))
  225.  
  226.  
  227. ;;(format t "~a~%" (eliza '(thank you goodbye)))
Success #stdin #stdout #stderr 0.01s 9556KB
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 LATE ?)
(HAVE YOU TRIED TO NOT MESS UP ?)
(THEN YOU HAVE TO KEEP TRYING!)
(BUT WHAT IF IT ISN 'T THAT BAD ?)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x154184600000 - 0x1541848e4fff
  0x154184a15000 - 0x154184a39fff
  0x154184a3a000 - 0x154184bacfff
  0x154184bad000 - 0x154184bf5fff
  0x154184bf6000 - 0x154184bf8fff
  0x154184bf9000 - 0x154184bfbfff
  0x154184bfc000 - 0x154184bfffff
  0x154184c00000 - 0x154184c02fff
  0x154184c03000 - 0x154184e01fff
  0x154184e02000 - 0x154184e02fff
  0x154184e03000 - 0x154184e03fff
  0x154184e80000 - 0x154184e8ffff
  0x154184e90000 - 0x154184ec3fff
  0x154184ec4000 - 0x154184ffafff
  0x154184ffb000 - 0x154184ffbfff
  0x154184ffc000 - 0x154184ffefff
  0x154184fff000 - 0x154184ffffff
  0x154185000000 - 0x154185003fff
  0x154185004000 - 0x154185203fff
  0x154185204000 - 0x154185204fff
  0x154185205000 - 0x154185205fff
  0x15418530a000 - 0x15418530dfff
  0x15418530e000 - 0x15418530efff
  0x15418530f000 - 0x154185310fff
  0x154185311000 - 0x154185311fff
  0x154185312000 - 0x154185312fff
  0x154185313000 - 0x154185313fff
  0x154185314000 - 0x154185321fff
  0x154185322000 - 0x15418532ffff
  0x154185330000 - 0x15418533cfff
  0x15418533d000 - 0x154185340fff
  0x154185341000 - 0x154185341fff
  0x154185342000 - 0x154185342fff
  0x154185343000 - 0x154185348fff
  0x154185349000 - 0x15418534afff
  0x15418534b000 - 0x15418534bfff
  0x15418534c000 - 0x15418534cfff
  0x15418534d000 - 0x15418534dfff
  0x15418534e000 - 0x15418537bfff
  0x15418537c000 - 0x15418538afff
  0x15418538b000 - 0x154185430fff
  0x154185431000 - 0x1541854c7fff
  0x1541854c8000 - 0x1541854c8fff
  0x1541854c9000 - 0x1541854c9fff
  0x1541854ca000 - 0x1541854ddfff
  0x1541854de000 - 0x154185505fff
  0x154185506000 - 0x15418550ffff
  0x154185510000 - 0x154185511fff
  0x154185512000 - 0x154185517fff
  0x154185518000 - 0x15418551afff
  0x15418551d000 - 0x15418551dfff
  0x15418551e000 - 0x15418551efff
  0x15418551f000 - 0x15418551ffff
  0x154185520000 - 0x154185520fff
  0x154185521000 - 0x154185521fff
  0x154185522000 - 0x154185528fff
  0x154185529000 - 0x15418552bfff
  0x15418552c000 - 0x15418552cfff
  0x15418552d000 - 0x15418554dfff
  0x15418554e000 - 0x154185555fff
  0x154185556000 - 0x154185556fff
  0x154185557000 - 0x154185557fff
  0x154185558000 - 0x154185558fff
  0x55e0abfc6000 - 0x55e0ac0b6fff
  0x55e0ac0b7000 - 0x55e0ac1c0fff
  0x55e0ac1c1000 - 0x55e0ac220fff
  0x55e0ac222000 - 0x55e0ac250fff
  0x55e0ac251000 - 0x55e0ac281fff
  0x55e0ac282000 - 0x55e0ac285fff
  0x55e0ae0f6000 - 0x55e0ae116fff
  0x7ffec2701000 - 0x7ffec2721fff
  0x7ffec2782000 - 0x7ffec2785fff
  0x7ffec2786000 - 0x7ffec2787fff
https://ideone.com/uNvorF
language:
Common Lisp (clisp 2.49.92)
created:
3 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!