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.     (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. 	 ( (Hey 0)
  150. 	   (Hey Mario come in how are you? ) )
  151. 	 ( (0 you wanted to talk about 0)
  152. 	   ( Oh what's going on ) )
  153. 	 ( (0 there he is again 0)
  154. 	   ( I hear you that can't be easy  ) )
  155. 	 ( (0 you just saved her 0)
  156. 	   ( Oh is she ok should we call someone ) )
  157. 	 ( (0 endless cycle 0)
  158. 	   ( Wow that sound really rough Im not sure on how to stop him maybe you can try having someone with you to lessen the work load) )
  159. 	 ( (0 Thanks 0)
  160. 	   (No problem i'm open to talk anytime.) )
  161. 	 ( (0 See ya 0)
  162. 	   (Goodbye) )
  163.  
  164. 	 ;; feelings
  165. 	 ( (0 you think 0)
  166. 	   (lonelness still isn't a reason to kidnap someone 4 ?) )
  167. 	 ( (0 you just want 0)
  168. 	   (I get it you should have to deal with this  4 ?) )
  169.  
  170. 	 ;; the catch-alls
  171. 	 ( (0) 
  172. 	   (ok well go ahead an continue then ) ) 
  173. 	 ( (0) 
  174. 	   (thats so weird ) )))
  175.  
  176. (print(eliza'(Hey)))
  177. (print (eliza '(I'm ok I guess I wanted to talk about the Bowser )))
  178. (print(eliza'(I can not keep doing this it’s been years. Every time I feel like it’s over there he is again Bowser. I’m so tired)))
  179. (print(eliza'(He somehow continous to kidnap princess peach I mean how does someone gets kinapped so much)))
  180. (print(eliza'(no she's fine I just saved her before you left  )))
  181. (print(eliza'(It’s like I’m stuck in an endless cycle !)))
  182. (print(eliza'(Luigi thinks it because he's loney you think it baloney)))
  183. (print(eliza'(you don't know yu just want it to be over )))
  184. (print(eliza'(Well thanks for listening Doc just needed to rant a bit)))
  185. (print(eliza'(See ya Doc ))); your code goes here
Success #stdin #stdout #stderr 0.01s 9720KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(HEY MARIO COME IN HOW ARE YOU?) 
(OH WHAT 'S GOING ON) 
(I HEAR YOU THAT CAN 'T BE EASY) 
(OK WELL GO AHEAD AN CONTINUE THEN) 
(OH IS SHE OK SHOULD WE CALL SOMEONE) 
(WOW THAT SOUND REALLY ROUGH IM NOT SURE ON HOW TO STOP HIM MAYBE YOU CAN TRY
 HAVING SOMEONE WITH YOU TO LESSEN THE WORK LOAD) 
(OK WELL GO AHEAD AN CONTINUE THEN) 
(OK WELL GO AHEAD AN CONTINUE THEN) 
(NO PROBLEM I 'M OPEN TO TALK ANYTIME.) 
(GOODBYE)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x1533e5c00000 - 0x1533e5ee4fff
  0x1533e6000000 - 0x1533e6002fff
  0x1533e6003000 - 0x1533e6201fff
  0x1533e6202000 - 0x1533e6202fff
  0x1533e6203000 - 0x1533e6203fff
  0x1533e6215000 - 0x1533e6239fff
  0x1533e623a000 - 0x1533e63acfff
  0x1533e63ad000 - 0x1533e63f5fff
  0x1533e63f6000 - 0x1533e63f8fff
  0x1533e63f9000 - 0x1533e63fbfff
  0x1533e63fc000 - 0x1533e63fffff
  0x1533e6400000 - 0x1533e6403fff
  0x1533e6404000 - 0x1533e6603fff
  0x1533e6604000 - 0x1533e6604fff
  0x1533e6605000 - 0x1533e6605fff
  0x1533e6616000 - 0x1533e6617fff
  0x1533e6618000 - 0x1533e6627fff
  0x1533e6628000 - 0x1533e665bfff
  0x1533e665c000 - 0x1533e6792fff
  0x1533e6793000 - 0x1533e6793fff
  0x1533e6794000 - 0x1533e6796fff
  0x1533e6797000 - 0x1533e6797fff
  0x1533e6798000 - 0x1533e6799fff
  0x1533e679a000 - 0x1533e679afff
  0x1533e679b000 - 0x1533e679cfff
  0x1533e679d000 - 0x1533e679dfff
  0x1533e679e000 - 0x1533e679efff
  0x1533e679f000 - 0x1533e679ffff
  0x1533e67a0000 - 0x1533e67adfff
  0x1533e67ae000 - 0x1533e67bbfff
  0x1533e67bc000 - 0x1533e67c8fff
  0x1533e67c9000 - 0x1533e67ccfff
  0x1533e67cd000 - 0x1533e67cdfff
  0x1533e67ce000 - 0x1533e67cefff
  0x1533e67cf000 - 0x1533e67d4fff
  0x1533e67d5000 - 0x1533e67d6fff
  0x1533e67d7000 - 0x1533e67d7fff
  0x1533e67d8000 - 0x1533e67d8fff
  0x1533e67d9000 - 0x1533e67d9fff
  0x1533e67da000 - 0x1533e6807fff
  0x1533e6808000 - 0x1533e6816fff
  0x1533e6817000 - 0x1533e68bcfff
  0x1533e68bd000 - 0x1533e6953fff
  0x1533e6954000 - 0x1533e6954fff
  0x1533e6955000 - 0x1533e6955fff
  0x1533e6956000 - 0x1533e6969fff
  0x1533e696a000 - 0x1533e6991fff
  0x1533e6992000 - 0x1533e699bfff
  0x1533e699c000 - 0x1533e699dfff
  0x1533e699e000 - 0x1533e69a3fff
  0x1533e69a4000 - 0x1533e69a6fff
  0x1533e69a9000 - 0x1533e69a9fff
  0x1533e69aa000 - 0x1533e69aafff
  0x1533e69ab000 - 0x1533e69abfff
  0x1533e69ac000 - 0x1533e69acfff
  0x1533e69ad000 - 0x1533e69adfff
  0x1533e69ae000 - 0x1533e69b4fff
  0x1533e69b5000 - 0x1533e69b7fff
  0x1533e69b8000 - 0x1533e69b8fff
  0x1533e69b9000 - 0x1533e69d9fff
  0x1533e69da000 - 0x1533e69e1fff
  0x1533e69e2000 - 0x1533e69e2fff
  0x1533e69e3000 - 0x1533e69e3fff
  0x1533e69e4000 - 0x1533e69e4fff
  0x55bcfdb42000 - 0x55bcfdc32fff
  0x55bcfdc33000 - 0x55bcfdd3cfff
  0x55bcfdd3d000 - 0x55bcfdd9cfff
  0x55bcfdd9e000 - 0x55bcfddccfff
  0x55bcfddcd000 - 0x55bcfddfdfff
  0x55bcfddfe000 - 0x55bcfde01fff
  0x55bcff0ba000 - 0x55bcff0dafff
  0x7ffe6b914000 - 0x7ffe6b934fff
  0x7ffe6b9cf000 - 0x7ffe6b9d2fff
  0x7ffe6b9d3000 - 0x7ffe6b9d4fff
https://ideone.com/gUmrVN
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!