fork download
  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. ( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
  30.  
  31. ;;----------------------------------------------------------------------------
  32. ;; respond: given a sentence, looks through the database in search of
  33. ;; a matching pattern and the response; given the database response,
  34. ;; uses 'instantiate' to fill in the blanks, and returns the completed
  35. ;; response
  36.  
  37. ( defun respond ( sentence db )
  38. ( cond
  39. ;; end of DB, return nil - should never really happen
  40. ( ( null db ) nil )
  41.  
  42. ;; if the result of matching the sentence against the current
  43. ;; pattern is a success, produce this response
  44. ( ( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
  45. ( instantiate result ( second ( car db ) ) ) )
  46.  
  47. ;; otherwise, keep looking through the DB
  48. ( t ( respond sentence ( cdr db ) ) ) ) )
  49.  
  50. ;;----------------------------------------------------------------------------
  51. ;; match: if there is not a match between this pattern and this data,
  52. ;; returns 'fail;' otherwise, returns the sentence in partitioned
  53. ;; format
  54.  
  55. ( defun match ( data pattern )
  56. ( cond
  57. ;; end of both data and pattern; a match
  58. ( ( and ( null data ) ( null pattern ) ) nil )
  59.  
  60. ;; end of pattern, but not end of data; no match
  61. ( ( null pattern ) fail )
  62.  
  63. ;; end of data, but not end of pattern; if the pattern starts with
  64. ;; a variable, eat it and try and match the rest of the pattern to
  65. ;; the null sentence (will only work if all variables); otherwise,
  66. ;; fail
  67. ( ( null data )
  68. ( cond
  69. ( ( variablep ( car pattern ) )
  70. ( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
  71. result
  72. fail ) )
  73. ( t fail ) ) )
  74.  
  75.  
  76. ;; first item of data and pattern are identical; if the rest of it
  77. ;; matched, return the first item cons'ed with the rest of the
  78. ;; partitioned sentence; otherwise, fail
  79. ( ( equal ( car data ) ( car pattern ) )
  80. ( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
  81. ( cons ( list ( car data ) ) result )
  82. fail ) )
  83.  
  84. ;; first item of pattern is a variable; if the rest of the data
  85. ;; (minus the first word, matched to the variable) is a match with
  86. ;; all of the pattern, return the appropriate stuff; if all of the
  87. ;; data (variable eats nothing) matches the rest of the pattern,
  88. ;; return appropriate stuff; else, fail.
  89. ( ( variablep ( car pattern ) )
  90. ( cond
  91. ;; variable eats nothing; () is put in partitioned sentence
  92. ( ( success ( setq result ( match data ( cdr pattern ) ) ) )
  93. ( cons () result ) )
  94. ;; variable eats one word; word is cons'ed into the first
  95. ;; element of the partitioned sentence, assuming that the step
  96. ;; before an actual match word would be a ()
  97. ( ( success ( setq result ( match ( cdr data ) pattern ) ) )
  98. ( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
  99. ;; otherwise, fail
  100. ( t fail ) ) )
  101.  
  102. ( t fail ) ) )
  103.  
  104. ;;----------------------------------------------------------------------------
  105. ;; instantiate: takes a partitioned sentence and the response it has
  106. ;; been matched to and generates the appropriated completed response
  107.  
  108. ( defun instantiate ( partitioned response )
  109. ( cond
  110. ( ( null response ) nil )
  111. ;; numbers indicate what part of the partitioned sentence to
  112. ;; insert into the response
  113. ( ( numberp ( car response ) )
  114. ( setq index ( - ( car response ) 1 ) )
  115. ( append ( nth index partitioned )
  116. ( instantiate partitioned ( cdr response ) ) ) )
  117. ( t ( cons ( car response )
  118. ( instantiate partitioned ( cdr response ) ) ) ) ) )
  119.  
  120. ;;---------------------------------------------------------------------------
  121. ;;
  122. ;; helping functions
  123. ;;
  124. ;;---------------------------------------------------------------------------
  125.  
  126. ( setq fail '-1 )
  127.  
  128. ( defun success ( result )
  129. ( not ( equal result fail ) ) )
  130.  
  131. ( defun variablep ( word )
  132. ( equal word '0 ) )
  133.  
  134.  
  135. ;;---------------------------------------------------------------------------
  136. ;;
  137. ;; database
  138. ;;
  139. ;;---------------------------------------------------------------------------
  140.  
  141. ;; CHANGE THIS: add more to this database so that the interaction is
  142. ;; more interesting and communicative and so that Eliza sounds like you
  143. ;; would sound in the same conversation!
  144. ;;---------------------------------------------------------------------------
  145.  
  146. ( setq database
  147. '(
  148. ;; example greetings/farewells -- change them to sound like you
  149. ( (Hello 0)
  150. (Hello - have a seat and tell me how you feel today.) )
  151. ( (0 you came here because 0)
  152. (A lot of people come here for that reason so you are not alone.) )
  153. ( (0 Goodbye 0)
  154. (Goodbye - I hope you enjoyed this session.) )
  155.  
  156. ;; feelings
  157. ( (0 you think 0)
  158. (And just why do you think 4 ?) )
  159.  
  160. ;; the catch-alls
  161. ( (0)
  162. (Could you expand on that?) ) ) )
  163.  
  164. (eliza '(hello))
Success #stdin #stdout #stderr 0.01s 9604KB
stdin
"hello how are you"
stdout
Standard output is empty
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14f94be00000 - 0x14f94c0e4fff
  0x14f94c200000 - 0x14f94c202fff
  0x14f94c203000 - 0x14f94c401fff
  0x14f94c402000 - 0x14f94c402fff
  0x14f94c403000 - 0x14f94c403fff
  0x14f94c415000 - 0x14f94c439fff
  0x14f94c43a000 - 0x14f94c5acfff
  0x14f94c5ad000 - 0x14f94c5f5fff
  0x14f94c5f6000 - 0x14f94c5f8fff
  0x14f94c5f9000 - 0x14f94c5fbfff
  0x14f94c5fc000 - 0x14f94c5fffff
  0x14f94c600000 - 0x14f94c603fff
  0x14f94c604000 - 0x14f94c803fff
  0x14f94c804000 - 0x14f94c804fff
  0x14f94c805000 - 0x14f94c805fff
  0x14f94c822000 - 0x14f94c823fff
  0x14f94c824000 - 0x14f94c833fff
  0x14f94c834000 - 0x14f94c867fff
  0x14f94c868000 - 0x14f94c99efff
  0x14f94c99f000 - 0x14f94c99ffff
  0x14f94c9a0000 - 0x14f94c9a2fff
  0x14f94c9a3000 - 0x14f94c9a3fff
  0x14f94c9a4000 - 0x14f94c9a5fff
  0x14f94c9a6000 - 0x14f94c9a6fff
  0x14f94c9a7000 - 0x14f94c9a8fff
  0x14f94c9a9000 - 0x14f94c9a9fff
  0x14f94c9aa000 - 0x14f94c9aafff
  0x14f94c9ab000 - 0x14f94c9abfff
  0x14f94c9ac000 - 0x14f94c9b9fff
  0x14f94c9ba000 - 0x14f94c9c7fff
  0x14f94c9c8000 - 0x14f94c9d4fff
  0x14f94c9d5000 - 0x14f94c9d8fff
  0x14f94c9d9000 - 0x14f94c9d9fff
  0x14f94c9da000 - 0x14f94c9dafff
  0x14f94c9db000 - 0x14f94c9e0fff
  0x14f94c9e1000 - 0x14f94c9e2fff
  0x14f94c9e3000 - 0x14f94c9e3fff
  0x14f94c9e4000 - 0x14f94c9e4fff
  0x14f94c9e5000 - 0x14f94c9e5fff
  0x14f94c9e6000 - 0x14f94ca13fff
  0x14f94ca14000 - 0x14f94ca22fff
  0x14f94ca23000 - 0x14f94cac8fff
  0x14f94cac9000 - 0x14f94cb5ffff
  0x14f94cb60000 - 0x14f94cb60fff
  0x14f94cb61000 - 0x14f94cb61fff
  0x14f94cb62000 - 0x14f94cb75fff
  0x14f94cb76000 - 0x14f94cb9dfff
  0x14f94cb9e000 - 0x14f94cba7fff
  0x14f94cba8000 - 0x14f94cba9fff
  0x14f94cbaa000 - 0x14f94cbaffff
  0x14f94cbb0000 - 0x14f94cbb2fff
  0x14f94cbb5000 - 0x14f94cbb5fff
  0x14f94cbb6000 - 0x14f94cbb6fff
  0x14f94cbb7000 - 0x14f94cbb7fff
  0x14f94cbb8000 - 0x14f94cbb8fff
  0x14f94cbb9000 - 0x14f94cbb9fff
  0x14f94cbba000 - 0x14f94cbc0fff
  0x14f94cbc1000 - 0x14f94cbc3fff
  0x14f94cbc4000 - 0x14f94cbc4fff
  0x14f94cbc5000 - 0x14f94cbe5fff
  0x14f94cbe6000 - 0x14f94cbedfff
  0x14f94cbee000 - 0x14f94cbeefff
  0x14f94cbef000 - 0x14f94cbeffff
  0x14f94cbf0000 - 0x14f94cbf0fff
  0x55ba6e5da000 - 0x55ba6e6cafff
  0x55ba6e6cb000 - 0x55ba6e7d4fff
  0x55ba6e7d5000 - 0x55ba6e834fff
  0x55ba6e836000 - 0x55ba6e864fff
  0x55ba6e865000 - 0x55ba6e895fff
  0x55ba6e896000 - 0x55ba6e899fff
  0x55ba6eb32000 - 0x55ba6eb52fff
  0x7ffd00824000 - 0x7ffd00844fff
  0x7ffd0086b000 - 0x7ffd0086efff
  0x7ffd0086f000 - 0x7ffd00870fff