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 9548KB
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
  0x14f11d000000 - 0x14f11d2e4fff
  0x14f11d415000 - 0x14f11d439fff
  0x14f11d43a000 - 0x14f11d5acfff
  0x14f11d5ad000 - 0x14f11d5f5fff
  0x14f11d5f6000 - 0x14f11d5f8fff
  0x14f11d5f9000 - 0x14f11d5fbfff
  0x14f11d5fc000 - 0x14f11d5fffff
  0x14f11d600000 - 0x14f11d602fff
  0x14f11d603000 - 0x14f11d801fff
  0x14f11d802000 - 0x14f11d802fff
  0x14f11d803000 - 0x14f11d803fff
  0x14f11d880000 - 0x14f11d88ffff
  0x14f11d890000 - 0x14f11d8c3fff
  0x14f11d8c4000 - 0x14f11d9fafff
  0x14f11d9fb000 - 0x14f11d9fbfff
  0x14f11d9fc000 - 0x14f11d9fefff
  0x14f11d9ff000 - 0x14f11d9fffff
  0x14f11da00000 - 0x14f11da03fff
  0x14f11da04000 - 0x14f11dc03fff
  0x14f11dc04000 - 0x14f11dc04fff
  0x14f11dc05000 - 0x14f11dc05fff
  0x14f11dc63000 - 0x14f11dc66fff
  0x14f11dc67000 - 0x14f11dc67fff
  0x14f11dc68000 - 0x14f11dc69fff
  0x14f11dc6a000 - 0x14f11dc6afff
  0x14f11dc6b000 - 0x14f11dc6bfff
  0x14f11dc6c000 - 0x14f11dc6cfff
  0x14f11dc6d000 - 0x14f11dc7afff
  0x14f11dc7b000 - 0x14f11dc88fff
  0x14f11dc89000 - 0x14f11dc95fff
  0x14f11dc96000 - 0x14f11dc99fff
  0x14f11dc9a000 - 0x14f11dc9afff
  0x14f11dc9b000 - 0x14f11dc9bfff
  0x14f11dc9c000 - 0x14f11dca1fff
  0x14f11dca2000 - 0x14f11dca3fff
  0x14f11dca4000 - 0x14f11dca4fff
  0x14f11dca5000 - 0x14f11dca5fff
  0x14f11dca6000 - 0x14f11dca6fff
  0x14f11dca7000 - 0x14f11dcd4fff
  0x14f11dcd5000 - 0x14f11dce3fff
  0x14f11dce4000 - 0x14f11dd89fff
  0x14f11dd8a000 - 0x14f11de20fff
  0x14f11de21000 - 0x14f11de21fff
  0x14f11de22000 - 0x14f11de22fff
  0x14f11de23000 - 0x14f11de36fff
  0x14f11de37000 - 0x14f11de5efff
  0x14f11de5f000 - 0x14f11de68fff
  0x14f11de69000 - 0x14f11de6afff
  0x14f11de6b000 - 0x14f11de70fff
  0x14f11de71000 - 0x14f11de73fff
  0x14f11de76000 - 0x14f11de76fff
  0x14f11de77000 - 0x14f11de77fff
  0x14f11de78000 - 0x14f11de78fff
  0x14f11de79000 - 0x14f11de79fff
  0x14f11de7a000 - 0x14f11de7afff
  0x14f11de7b000 - 0x14f11de81fff
  0x14f11de82000 - 0x14f11de84fff
  0x14f11de85000 - 0x14f11de85fff
  0x14f11de86000 - 0x14f11dea6fff
  0x14f11dea7000 - 0x14f11deaefff
  0x14f11deaf000 - 0x14f11deaffff
  0x14f11deb0000 - 0x14f11deb0fff
  0x14f11deb1000 - 0x14f11deb1fff
  0x560f985a3000 - 0x560f98693fff
  0x560f98694000 - 0x560f9879dfff
  0x560f9879e000 - 0x560f987fdfff
  0x560f987ff000 - 0x560f9882dfff
  0x560f9882e000 - 0x560f9885efff
  0x560f9885f000 - 0x560f98862fff
  0x560f98d65000 - 0x560f98d85fff
  0x7ffd4a970000 - 0x7ffd4a990fff
  0x7ffd4a997000 - 0x7ffd4a99afff
  0x7ffd4a99b000 - 0x7ffd4a99cfff