fork download
copy 
  1. ;;==========================================================================
  2. ;;
  3. ;; STARTER FILE FOR CSC 4240/5240 PROGRAM #1: Eliza
  4. ;;
  5. ;;==========================================================================
  6. ;;----------------------------------------------------------------------------
  7. ;; 
  8. ;; eliza: top-level function which, when given a sentence (no
  9. ;; punctuation, please!), comes back with a response like you would.
  10.  
  11. ( defun eliza ( 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. ( 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.     ;; CHANGE THIS: add more cases here of pronouns or other words
  26.     ;; that should flip in order for this to work well
  27.     ( ( equal ( car sentence ) 'am )
  28.       ( cons 'are ( change-pros ( cdr sentence ) ) ) )
  29.     ( ( equal ( car sentence ) 'are )
  30.       ( cons 'am ( change-pros ( cdr sentence ) ) ) )
  31.      ( ( equal ( car sentence ) 'me )
  32.       ( cons 'you ( change-pros ( cdr sentence ) ) ) )
  33.      ( ( equal ( car sentence ) 'you )
  34.       ( cons 'me ( change-pros ( cdr sentence ) ) ) )
  35.      ( ( equal ( car sentence ) 'my )
  36.       ( cons 'your ( change-pros ( cdr sentence ) ) ) )
  37.      ( ( equal ( car sentence ) 'your )
  38.       ( cons 'my ( change-pros ( cdr sentence ) ) ) )
  39.      ( ( equal ( car sentence ) 'messed )
  40.       ( cons 'mess ( change-pros ( cdr sentence ) ) ) )  
  41.      ( ( equal ( car sentence ) 'mess )
  42.       ( cons 'messed ( change-pros ( cdr sentence ) ) ) )  
  43.     ( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
  44.  
  45. ;;----------------------------------------------------------------------------
  46. ;; respond: given a sentence, looks through the database in search of
  47. ;; a matching pattern and the response; given the database response,
  48. ;; uses 'instantiate' to fill in the blanks, and returns the completed
  49. ;; response
  50.  
  51. ( defun respond ( sentence db )
  52.   ( cond
  53.     ;; end of DB, return nil - should never really happen
  54.     ( ( null db ) nil )
  55.  
  56.     ;; if the result of matching the sentence against the current
  57.     ;; pattern is a success, produce this response
  58.     ( ( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
  59.       ;;( instantiate result ( second ( car db ) ) ) ) 
  60.  
  61.       ;; Random response function for catch-alls
  62.     (instantiate result (random-pick (second (car db)))))
  63.  
  64.     ;; otherwise, keep looking through the DB
  65.     ( t ( respond sentence ( cdr db ) ) ) ) )
  66.  
  67.  ( defun random-pick (variable-response-list)
  68.    (nth (random (length variable-response-list)) variable-response-list))
  69.  
  70. ;;----------------------------------------------------------------------------
  71. ;; match: if there is not a match between this pattern and this data,
  72. ;; returns 'fail;' otherwise, returns the sentence in partitioned
  73. ;; format
  74.  
  75. ( defun match ( data pattern )
  76.   ( cond
  77.     ;; end of both data and pattern; a match
  78.     ( ( and ( null data ) ( null pattern ) ) nil )
  79.     ;; end of pattern, but not end of data; no match
  80.     ( ( null pattern ) fail )
  81.     ;; end of data, but not end of pattern; if the pattern starts with
  82.     ;; a variable, eat it and try and match the rest of the pattern to
  83.     ;; the null sentence (will only work if all variables); otherwise,
  84.     ;; fail
  85.     ( ( null data )
  86.       ( cond
  87.   ( ( variablep ( car pattern ) )
  88.     ( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
  89.         result
  90.       fail ) )
  91.   ( t fail ) ) )
  92.  
  93.     ;; first item of data and pattern are identical; if the rest of it
  94.     ;; matched, return the first item cons'ed with the rest of the
  95.     ;; partitioned sentence; otherwise, fail
  96.     ( ( equal ( car data ) ( car pattern ) )
  97.       ( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
  98.     ( cons ( list ( car data ) ) result )
  99.   fail ) )
  100.     ;; first item of pattern is a variable; if the rest of the data
  101.     ;; (minus the first word, matched to the variable) is a match with
  102.     ;; all of the pattern, return the appropriate stuff; if all of the
  103.     ;; data (variable eats nothing) matches the rest of the pattern,
  104.     ;; return appropriate stuff; else, fail.
  105.     ( ( variablep ( car pattern ) )
  106.       ( cond
  107.   ;; variable eats nothing;  () is put in partitioned sentence
  108.   ( ( success ( setq result ( match data ( cdr pattern ) ) ) )
  109.     ( cons () result ) )
  110.   ;; variable eats one word; word is cons'ed into the first
  111.   ;; element of the partitioned sentence, assuming that the step
  112.   ;; before an actual match word would be a ()
  113.   ( ( success ( setq result ( match ( cdr data ) pattern ) ) )
  114.     ( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
  115.   ;; otherwise, fail
  116.   ( t fail ) ) )
  117.     ( t fail ) ) )
  118.  
  119. ;;----------------------------------------------------------------------------
  120. ;; instantiate: takes a partitioned sentence and the response it has
  121. ;; been matched to and generates the appropriated completed response
  122.  
  123. ( defun instantiate ( partitioned response )
  124.   ( cond
  125.     ( ( null response ) nil )
  126.     ;; numbers indicate what part of the partitioned sentence to
  127.     ;; insert into the response
  128.     ( ( numberp ( car response ) )
  129.       ( setq index ( - ( car response ) 1 ) )
  130.       ( append ( nth index partitioned )
  131.        ( instantiate partitioned ( cdr response ) ) ) )
  132.     ( t ( cons ( car response )
  133.        ( instantiate partitioned ( cdr response ) ) ) ) ) )
  134.  
  135. ;;---------------------------------------------------------------------------
  136. ;;
  137. ;;             helping functions
  138. ;;
  139. ;;---------------------------------------------------------------------------
  140.  
  141. ( setq fail '-1 )
  142. ( defun success ( result )
  143.   ( not ( equal result fail ) ) )
  144. ( defun variablep ( word )
  145.   ( equal word '0 ) )
  146.  
  147. ;;---------------------------------------------------------------------------
  148. ;;
  149. ;;                 database
  150. ;;
  151. ;;---------------------------------------------------------------------------
  152. ;; CHANGE THIS: add more to this database so that the interaction is
  153. ;; more interesting and communicative and so that Eliza sounds like you
  154. ;; would sound in the same conversation!
  155. ;;---------------------------------------------------------------------------
  156.  
  157. ( setq database '(
  158.    ;; example greetings/farewells -- change them to sound like you
  159.    ( (Hello 0)
  160.      ((Heyyy - how are you feeling today?) ))
  161.    ( (0 you came here because 0)
  162.      ((Many times we simply need to talk things out so I am here for you. Talk to me.) ))
  163.    ( (0 Goodbye 0)
  164.      ((Goodbye - I hope you are feeling better. I am here for you anytime.) ))
  165.      ( (0 Sad 0)
  166.      ((Why do you feel sad?) ))
  167.    ( (0 Mad 0)
  168.      ((What has caused you to be mad ?) ))
  169.    ( (0 Yes 0)
  170.      ((You have to keep trying and move forward!)) )
  171.    ( (0 a little bit 0)
  172.      ((You have to keep trying and move forward!) ))
  173.    ( (0 No 0)
  174.      ((Try harder!) ))
  175.    ( (0 Not really 0)
  176.      ((But why? Do better!) ))
  177.    ( (0 can be 0)
  178.      ((In what way ?) ))
  179.    ( (0 and 0)
  180.      ((So how do you think you can resolve that ?) ))
  181.    ( (0 maybe 0)
  182.      ((There is a possibility.) ))
  183.    ( (0 Thanks 0)
  184.      ((Anytime friend. Is there anything else you want to talk about ?) ))
  185.    ( (0 im okay 0)
  186.      ((Sounds good. Have a good rest of your day!) ))
  187.  
  188.    ;; feelings
  189.    ( (0 you think you 0)
  190.      ((why do you think you 5 ?) ))
  191.    ( (0 you want to 0)
  192.      (T(ake one step at a time but start somewhere and 5) ))
  193.  
  194.    ;; trying to find a solution
  195.    ( (0 because you 0)
  196.      (( have you tried to not 4 ?) ))
  197.    ( (0 because the 0)
  198.      (( what makes you feel like the 4 ?) ))
  199.    ( (0 but 0)
  200.      (( but what if it isn't that bad 4 ?) ))
  201.  
  202.     ;;the catch-alls
  203.    ((0)
  204.     ((Okay. Help me understand your feelings better. Tell me more.)
  205.     (Can you elaborate on that ?)
  206.     (Thats interesting! Expand on that.)
  207.     (Im starting to understand. Please continue) ))
  208.     ))
  209.  
  210.  
  211. ;; response input
  212. (format t "~a~%" (eliza '(hello)))
  213. (format t "~a~%" (eliza '(i dont know)))
  214. (format t "~a~%" (eliza '(i think i am failing at life)))
  215. (format t "~a~%" (eliza '(because i messed up)))
  216. (format t "~a~%" (eliza '(not really but i didnt mean to)))
  217. (format t "~a~%" (eliza '(but life is so hard)))
  218. (format t "~a~%" (eliza '(i want to improve)))
  219. (format t "~a~%" (eliza '(People can be really mean)))
  220. (format t "~a~%" (eliza '(They are mean and then expect me to be nice all the time)))
  221. (format t "~a~%" (eliza '(Maybe i can ask them to be nicer)))
  222. (format t "~a~%" (eliza '(Thanks)))
  223. (format t "~a~%" (eliza '(I think Im okay)))
  224. (format t "~a~%" (eliza '(Goodbye)))
Success #stdin #stdout #stderr 0.02s 9776KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(HEYYY - HOW ARE YOU FEELING TODAY?)
(CAN YOU ELABORATE ON THAT ?)
(WHY DO YOU THINK YOU ARE FAILING AT LIFE ?)
(HAVE YOU TRIED TO NOT MESS UP ?)
(BUT WHY? DO BETTER!)
(BUT WHAT IF IT ISN 'T THAT BAD ?)
(AKE ONE STEP AT A TIME BUT START SOMEWHERE AND IMPROVE)
(IN WHAT WAY ?)
(SO HOW DO YOU THINK YOU CAN RESOLVE THAT ?)
(THERE IS A POSSIBILITY.)
(ANYTIME FRIEND. IS THERE ANYTHING ELSE YOU WANT TO TALK ABOUT ?)
(SOUNDS GOOD. HAVE A GOOD REST OF YOUR DAY!)
(GOODBYE - I HOPE YOU ARE FEELING BETTER. I AM HERE FOR YOU ANYTIME.)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14f7d0a00000 - 0x14f7d0ce4fff
  0x14f7d0e00000 - 0x14f7d0e02fff
  0x14f7d0e03000 - 0x14f7d1001fff
  0x14f7d1002000 - 0x14f7d1002fff
  0x14f7d1003000 - 0x14f7d1003fff
  0x14f7d1015000 - 0x14f7d1039fff
  0x14f7d103a000 - 0x14f7d11acfff
  0x14f7d11ad000 - 0x14f7d11f5fff
  0x14f7d11f6000 - 0x14f7d11f8fff
  0x14f7d11f9000 - 0x14f7d11fbfff
  0x14f7d11fc000 - 0x14f7d11fffff
  0x14f7d1200000 - 0x14f7d1203fff
  0x14f7d1204000 - 0x14f7d1403fff
  0x14f7d1404000 - 0x14f7d1404fff
  0x14f7d1405000 - 0x14f7d1405fff
  0x14f7d140f000 - 0x14f7d1410fff
  0x14f7d1411000 - 0x14f7d1420fff
  0x14f7d1421000 - 0x14f7d1454fff
  0x14f7d1455000 - 0x14f7d158bfff
  0x14f7d158c000 - 0x14f7d158cfff
  0x14f7d158d000 - 0x14f7d158ffff
  0x14f7d1590000 - 0x14f7d1590fff
  0x14f7d1591000 - 0x14f7d1592fff
  0x14f7d1593000 - 0x14f7d1593fff
  0x14f7d1594000 - 0x14f7d1595fff
  0x14f7d1596000 - 0x14f7d1596fff
  0x14f7d1597000 - 0x14f7d1597fff
  0x14f7d1598000 - 0x14f7d1598fff
  0x14f7d1599000 - 0x14f7d15a6fff
  0x14f7d15a7000 - 0x14f7d15b4fff
  0x14f7d15b5000 - 0x14f7d15c1fff
  0x14f7d15c2000 - 0x14f7d15c5fff
  0x14f7d15c6000 - 0x14f7d15c6fff
  0x14f7d15c7000 - 0x14f7d15c7fff
  0x14f7d15c8000 - 0x14f7d15cdfff
  0x14f7d15ce000 - 0x14f7d15cffff
  0x14f7d15d0000 - 0x14f7d15d0fff
  0x14f7d15d1000 - 0x14f7d15d1fff
  0x14f7d15d2000 - 0x14f7d15d2fff
  0x14f7d15d3000 - 0x14f7d1600fff
  0x14f7d1601000 - 0x14f7d160ffff
  0x14f7d1610000 - 0x14f7d16b5fff
  0x14f7d16b6000 - 0x14f7d174cfff
  0x14f7d174d000 - 0x14f7d174dfff
  0x14f7d174e000 - 0x14f7d174efff
  0x14f7d174f000 - 0x14f7d1762fff
  0x14f7d1763000 - 0x14f7d178afff
  0x14f7d178b000 - 0x14f7d1794fff
  0x14f7d1795000 - 0x14f7d1796fff
  0x14f7d1797000 - 0x14f7d179cfff
  0x14f7d179d000 - 0x14f7d179ffff
  0x14f7d17a2000 - 0x14f7d17a2fff
  0x14f7d17a3000 - 0x14f7d17a3fff
  0x14f7d17a4000 - 0x14f7d17a4fff
  0x14f7d17a5000 - 0x14f7d17a5fff
  0x14f7d17a6000 - 0x14f7d17a6fff
  0x14f7d17a7000 - 0x14f7d17adfff
  0x14f7d17ae000 - 0x14f7d17b0fff
  0x14f7d17b1000 - 0x14f7d17b1fff
  0x14f7d17b2000 - 0x14f7d17d2fff
  0x14f7d17d3000 - 0x14f7d17dafff
  0x14f7d17db000 - 0x14f7d17dbfff
  0x14f7d17dc000 - 0x14f7d17dcfff
  0x14f7d17dd000 - 0x14f7d17ddfff
  0x558c21a45000 - 0x558c21b35fff
  0x558c21b36000 - 0x558c21c3ffff
  0x558c21c40000 - 0x558c21c9ffff
  0x558c21ca1000 - 0x558c21ccffff
  0x558c21cd0000 - 0x558c21d00fff
  0x558c21d01000 - 0x558c21d04fff
  0x558c2306b000 - 0x558c2308bfff
  0x7ffe15876000 - 0x7ffe15896fff
  0x7ffe15953000 - 0x7ffe15956fff
  0x7ffe15957000 - 0x7ffe15958fff
https://ideone.com/cqSwdS
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!