fork download
copy 
  1. (defun splitStr (str)
  2.   "Appends characters from str to my-string unless the character is a space. When a space is encountered, add the current my-string to a new list."
  3.   (setq my-string "")  ;; Initialize my-string as an empty global string
  4.   (setq result-list '())  ;; Initialize an empty list to store parts of the string
  5.   (setq len (length str))  ;; Get the length of the input string
  6.  
  7.   (dotimes (i len)
  8.     (setq curr-char (char str i))  ;; Get the character at index `i`
  9.     (if (char/= #\Space curr-char)  ;; If the character is not a space
  10.         (setq my-string (concatenate 'string my-string (string curr-char)))  ;; Append character to my-string
  11.         (when (> (length my-string) 0)  ;; If my-string is not empty
  12.           (push my-string result-list)  ;; Add my-string to result-list
  13.           (setq my-string ""))))  ;; Reset my-string to empty string
  14.  
  15.   ;; After the loop, add the final my-string if it's not empty
  16.   (when (> (length my-string) 0)
  17.     (push my-string result-list))
  18.  
  19.   (nreverse result-list))  ;; Return the reversed list to maintain original order
  20.  
  21.  
  22.  
  23. ;;==========================================================================
  24. ;;
  25. ;; STARTER FILE FOR CSC 4240/5240 PROGRAM #1: Eliza
  26. ;;==========================================================================
  27.  
  28. ;;----------------------------------------------------------------------------
  29. ;; eliza: top-level function which, when given a sentence (no
  30. ;; punctuation, please!), comes back with a response like you would.
  31.  
  32. ( defun eliza ( sentence )
  33.   ;(format t "Input type: ~a, value: ~a~%" (type-of sentence) sentence)
  34.   ( respond ( change-pros sentence ) database ) )
  35.  
  36. ;;----------------------------------------------------------------------------
  37. ;; change-pros: changes the pronouns of the sentence so that Eliza can
  38. ;; come back with the appropriately switched first and second person
  39. ;; references.
  40.  
  41. ( defun change-pros ( sentence )
  42.   ( cond 
  43.     ( ( null sentence ) nil )
  44.  
  45.     ( ( equal ( car sentence ) 'you )
  46.       ( cons 'I ( change-pros ( cdr sentence ) ) ) )
  47.     ( ( equal ( car sentence ) 'I )
  48.       ( cons 'you ( change-pros ( cdr sentence ) ) ) )
  49.  
  50.     ( ( equal ( car sentence ) 'my )
  51.       ( cons 'your ( change-pros ( cdr sentence ) ) ) )
  52.     ( ( equal ( car sentence ) 'your )
  53.       ( cons 'my ( change-pros ( cdr sentence ) ) ) )
  54.  
  55.     ( ( equal ( car sentence ) 'mine )
  56.       ( cons 'yours ( change-pros ( cdr sentence ) ) ) )
  57.     ( ( equal ( car sentence ) 'yours )
  58.       ( cons 'mine ( change-pros ( cdr sentence ) ) ) )
  59.  
  60.     ( ( equal ( car sentence ) 'he )
  61.       ( cons 'him ( change-pros ( cdr sentence ) ) ) )
  62.     ( ( equal ( car sentence ) 'him )
  63.       ( cons 'he ( change-pros ( cdr sentence ) ) ) )
  64.  
  65.     ( ( equal ( car sentence ) 'she )
  66.       ( cons 'she ( change-pros ( cdr sentence ) ) ) )
  67.     ( ( equal ( car sentence ) 'her )
  68.       ( cons 'hers ( change-pros ( cdr sentence ) ) ) )
  69.     ( ( equal ( car sentence ) 'hers )
  70.       ( cons 'her ( change-pros ( cdr sentence ) ) ) )
  71.  
  72.     ( ( equal ( car sentence ) 'it )
  73.       ( cons 'it ( change-pros ( cdr sentence ) ) ) )
  74.  
  75.     ;; CHANGE THIS: add more cases here of pronouns or other words
  76.     ;; that should flip in order for this to work well
  77.  
  78.     ( t ( cons ( car sentence ) ( change-pros ( cdr sentence ) ) ) ) ) )
  79.  
  80. ;;----------------------------------------------------------------------------
  81. ;; respond: given a sentence, looks through the database in search of
  82. ;; a matching pattern and the response; given the database response,
  83. ;; uses 'instantiate' to fill in the blanks, and returns the completed
  84. ;; response
  85.  
  86. ( defun respond ( sentence db )
  87.   ( cond
  88.     ;; end of DB, return nil - should never really happen
  89.     ( ( null db ) nil )
  90.  
  91.     ;; if the result of matching the sentence against the current
  92.     ;; pattern is a success, produce this response
  93.     ( 
  94.         ( success ( setq result ( match sentence ( first ( car db ) ) ) ) )
  95.  
  96.         (setf *random-state* (make-random-state t))
  97.  
  98.         (setq idx ( length (car db) ))
  99.         (setq rndm ( random idx ))
  100.  
  101.         (if (= rndm 0)
  102.           (setq rndm 1)
  103.           (princ ""))
  104.  
  105.         ; (princ rndm)
  106.         ; (princ #\Newline) 
  107.         ( instantiate result ( nth rndm ( car db ) ) )
  108.     )
  109.  
  110.     ;; otherwise, keep looking through the DB
  111.     ( t ( respond sentence ( cdr db ) ) ) ) )
  112.  
  113. ;;----------------------------------------------------------------------------
  114. ;; match: if there is not a match between this pattern and this data,
  115. ;; returns 'fail;' otherwise, returns the sentence in partitioned
  116. ;; format
  117.  
  118. ( defun match ( data pattern )
  119.   ( cond
  120.     ;; end of both data and pattern; a match
  121.     ( ( and ( null data ) ( null pattern ) ) nil )
  122.  
  123.     ;; end of pattern, but not end of data; no match
  124.     ( ( null pattern ) fail )
  125.  
  126.     ;; end of data, but not end of pattern; if the pattern starts with
  127.     ;; a variable, eat it and try and match the rest of the pattern to
  128.     ;; the null sentence (will only work if all variables); otherwise,
  129.     ;; fail
  130.     ( ( null data ) 
  131.       ( cond
  132. 	( ( variablep ( car pattern ) )
  133. 	  ( if ( success ( setq result ( match data ( cdr pattern ) ) ) )
  134. 	      result
  135. 	    fail ) )
  136. 	( t fail ) ) )
  137.  
  138.  
  139.     ;; first item of data and pattern are identical; if the rest of it
  140.     ;; matched, return the first item cons'ed with the rest of the
  141.     ;; partitioned sentence; otherwise, fail
  142.     ( ( equal ( car data ) ( car pattern ) )
  143.       ( if ( success ( setq result ( match ( cdr data ) ( cdr pattern ) ) ) )
  144. 	  ( cons ( list ( car data ) ) result )
  145. 	fail ) )
  146.  
  147.     ;; first item of pattern is a variable; if the rest of the data
  148.     ;; (minus the first word, matched to the variable) is a match with
  149.     ;; all of the pattern, return the appropriate stuff; if all of the
  150.     ;; data (variable eats nothing) matches the rest of the pattern,
  151.     ;; return appropriate stuff; else, fail.
  152.     ( ( variablep ( car pattern ) ) 
  153.       ( cond
  154. 	;; variable eats nothing;  () is put in partitioned sentence
  155. 	( ( success ( setq result ( match data ( cdr pattern ) ) ) )
  156. 	  ( cons () result ) )
  157. 	;; variable eats one word; word is cons'ed into the first
  158. 	;; element of the partitioned sentence, assuming that the step
  159. 	;; before an actual match word would be a ()
  160. 	( ( success ( setq result ( match ( cdr data ) pattern ) ) )
  161. 	  ( cons ( cons ( car data ) ( car result ) ) ( cdr result ) ) )
  162. 	;; otherwise, fail
  163. 	( t fail ) ) )
  164.  
  165.     ( t fail ) ) )
  166.  
  167. ;;----------------------------------------------------------------------------
  168. ;; instantiate: takes a partitioned sentence and the response it has
  169. ;; been matched to and generates the appropriated completed response
  170.  
  171. ( defun instantiate ( partitioned response )
  172.   ( cond
  173.     ( ( null response ) nil )
  174.     ;; numbers indicate what part of the partitioned sentence to
  175.     ;; insert into the response
  176.     ( ( numberp ( car response ) )
  177.       ( setq index ( - ( car response ) 1 ) )
  178.       ( append ( nth index partitioned )
  179. 	     ( instantiate partitioned ( cdr response ) ) ) )
  180.     ( t ( cons ( car response )
  181. 	     ( instantiate partitioned ( cdr response ) ) ) ) ) )
  182.  
  183. ;;---------------------------------------------------------------------------
  184. ;;
  185. ;;  			     helping functions
  186. ;;
  187. ;;---------------------------------------------------------------------------
  188.  
  189. ( setq fail '-1 )
  190.  
  191. ( defun success ( result )
  192.   ( not ( equal result fail ) ) )
  193.  
  194. ( defun variablep ( word )
  195.   ( equal word '0 ) )
  196.  
  197.  
  198. ;;---------------------------------------------------------------------------
  199. ;;
  200. ;;  			         database
  201. ;;
  202. ;;---------------------------------------------------------------------------
  203.  
  204. ;; CHANGE THIS: add more to this database so that the interaction is
  205. ;; more interesting and communicative and so that Eliza sounds like you 
  206. ;; would sound in the same conversation!
  207. ;;---------------------------------------------------------------------------
  208.  
  209. ( setq database
  210.     '(
  211.         ;; example greetings/farewells -- change them to sound like you
  212.  
  213.         (
  214.         (Hello 0)
  215.         (Hello - have a seat and tell me how you feel today.) 
  216.         )
  217.  
  218.         ( (0 You came here because 0)
  219.         (A lot of people come here for that reason so you are not alone.) )
  220.  
  221.         ((0 your day 0)
  222.         ("Great! I would love to hear that, tell me how was your day?")
  223.         )
  224.  
  225.         ( (0 Goodbye 0)
  226.         (Goodbye - I hope you enjoyed this session.) )
  227.  
  228.         ;; feelings
  229.         ( (0 you think 0)
  230.         (And just why do you think 4 ? ) )
  231.  
  232.         ( (0 you are happy 0) 
  233.         (That's wonderful! What’s making you happy today? ) )
  234.  
  235.         (
  236.           (0 you feel joyful 0)
  237.           ("I'm glad to hear that! Tell me more what makes you feel joyful?" )
  238.         )
  239.  
  240.         ((0 you are excited 0)
  241.         (
  242.           "I'm glad to hear that! Tell me more what makes you feel excited?" 
  243.         ))
  244.  
  245.         ((0 password 0)
  246.           "You can reset your password if you forgot it"
  247.         )
  248.  
  249.         ((0 got lost 0)
  250.           "Try calling 911 or go to nearest police station! Take care!"
  251.         )
  252.  
  253.         ((0 missed your appointment 0)
  254.           "I know how it feels, but can you try rescheduling it?"
  255.         )
  256.  
  257.         ((0 laptop not working 0)
  258.           "It is frustrating to hear that.. do you have a backup of your data?"
  259.         )
  260.  
  261.         ((0 too much work 0)
  262.           "Try getting some rest please"
  263.         )
  264.  
  265.         ((0 feel tired 0)
  266.           "Why do you feel tired?"
  267.         )
  268.  
  269.         ((0 you feel sad 0) 
  270.         ("I'm sorry to hear that. Why do you think you are sad?" 
  271.           "What’s making you feel sad?" 
  272.           "Tell me more about what’s troubling you."))
  273.  
  274.         ((0 you are angry 0)
  275.         ("I see. What made you feel this way?" 
  276.           "Why do you think you’re feeling so angry?" 
  277.           "Can you tell me more about what’s making you angry?"))
  278.  
  279.         ;; the catch-alls
  280.         (
  281.           (0) 
  282.           (Could you expand on that?)
  283.           ("Hmmm.. Is it possible to elaborate more on that please?")
  284.           ("Hmmm.. I feel I didn't get what you mean. Can you explain again in other terms?")
  285.           ("Uhh.. I fear I don't understand what are you talking about..")
  286.           ("Ops, didn't get it, please expand on that.")
  287.  
  288.         )
  289.     )
  290. )
  291.  
  292. ; (princ (eliza '(I feel joyful)))
  293. ; (princ #\Newline)
  294. ; (princ "#############")
  295.  
  296. ; ; (princ inn)
  297. ; ; (princ (splitStr "I feel joy"))
  298. ; (princ res)
  299. ; (princ #\Newline)
  300. ; (princ (eliza res))
  301. ; (princ res)
  302.  
  303.  
  304.  
  305. ;; Convert the splitStr result from strings to symbols
  306.  
  307. ;; Call eliza with the list of symbols and print the result
  308. ; (princ (eliza res)
  309.  
  310. (dotimes (i 4)  ; Loop 10 times with `i` from 0 to 9
  311. 	(setq inn (read-line))
  312. 	(setq inn-uppercase (string-upcase inn))
  313. 	(print inn-uppercase)
  314. 	(setq res (mapcar #'intern (splitStr inn-uppercase)))
  315. 	(print (eliza res))
  316. )
  317.  
Success #stdin #stdout #stderr 0.01s 9636KB
comments (?)
stdin
copy 
I feel joyful
HELLo
a
b
stdout
copy 
"I FEEL JOYFUL" 
("I'm glad to hear that! Tell me more what makes you feel joyful?") 
"HELLO" 
(HELLO - HAVE A SEAT AND TELL ME HOW YOU FEEL TODAY.) 
"A" 
("Uhh.. I fear I don't understand what are you talking about..") 
"B" 
(COULD YOU EXPAND ON THAT?)
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14a5ab200000 - 0x14a5ab4e4fff
  0x14a5ab615000 - 0x14a5ab639fff
  0x14a5ab63a000 - 0x14a5ab7acfff
  0x14a5ab7ad000 - 0x14a5ab7f5fff
  0x14a5ab7f6000 - 0x14a5ab7f8fff
  0x14a5ab7f9000 - 0x14a5ab7fbfff
  0x14a5ab7fc000 - 0x14a5ab7fffff
  0x14a5ab800000 - 0x14a5ab802fff
  0x14a5ab803000 - 0x14a5aba01fff
  0x14a5aba02000 - 0x14a5aba02fff
  0x14a5aba03000 - 0x14a5aba03fff
  0x14a5aba80000 - 0x14a5aba8ffff
  0x14a5aba90000 - 0x14a5abac3fff
  0x14a5abac4000 - 0x14a5abbfafff
  0x14a5abbfb000 - 0x14a5abbfbfff
  0x14a5abbfc000 - 0x14a5abbfefff
  0x14a5abbff000 - 0x14a5abbfffff
  0x14a5abc00000 - 0x14a5abc03fff
  0x14a5abc04000 - 0x14a5abe03fff
  0x14a5abe04000 - 0x14a5abe04fff
  0x14a5abe05000 - 0x14a5abe05fff
  0x14a5abf1e000 - 0x14a5abf21fff
  0x14a5abf22000 - 0x14a5abf22fff
  0x14a5abf23000 - 0x14a5abf24fff
  0x14a5abf25000 - 0x14a5abf25fff
  0x14a5abf26000 - 0x14a5abf26fff
  0x14a5abf27000 - 0x14a5abf27fff
  0x14a5abf28000 - 0x14a5abf35fff
  0x14a5abf36000 - 0x14a5abf43fff
  0x14a5abf44000 - 0x14a5abf50fff
  0x14a5abf51000 - 0x14a5abf54fff
  0x14a5abf55000 - 0x14a5abf55fff
  0x14a5abf56000 - 0x14a5abf56fff
  0x14a5abf57000 - 0x14a5abf5cfff
  0x14a5abf5d000 - 0x14a5abf5efff
  0x14a5abf5f000 - 0x14a5abf5ffff
  0x14a5abf60000 - 0x14a5abf60fff
  0x14a5abf61000 - 0x14a5abf61fff
  0x14a5abf62000 - 0x14a5abf8ffff
  0x14a5abf90000 - 0x14a5abf9efff
  0x14a5abf9f000 - 0x14a5ac044fff
  0x14a5ac045000 - 0x14a5ac0dbfff
  0x14a5ac0dc000 - 0x14a5ac0dcfff
  0x14a5ac0dd000 - 0x14a5ac0ddfff
  0x14a5ac0de000 - 0x14a5ac0f1fff
  0x14a5ac0f2000 - 0x14a5ac119fff
  0x14a5ac11a000 - 0x14a5ac123fff
  0x14a5ac124000 - 0x14a5ac125fff
  0x14a5ac126000 - 0x14a5ac12bfff
  0x14a5ac12c000 - 0x14a5ac12efff
  0x14a5ac131000 - 0x14a5ac131fff
  0x14a5ac132000 - 0x14a5ac132fff
  0x14a5ac133000 - 0x14a5ac133fff
  0x14a5ac134000 - 0x14a5ac134fff
  0x14a5ac135000 - 0x14a5ac135fff
  0x14a5ac136000 - 0x14a5ac13cfff
  0x14a5ac13d000 - 0x14a5ac13ffff
  0x14a5ac140000 - 0x14a5ac140fff
  0x14a5ac141000 - 0x14a5ac161fff
  0x14a5ac162000 - 0x14a5ac169fff
  0x14a5ac16a000 - 0x14a5ac16afff
  0x14a5ac16b000 - 0x14a5ac16bfff
  0x14a5ac16c000 - 0x14a5ac16cfff
  0x55a5b8944000 - 0x55a5b8a34fff
  0x55a5b8a35000 - 0x55a5b8b3efff
  0x55a5b8b3f000 - 0x55a5b8b9efff
  0x55a5b8ba0000 - 0x55a5b8bcefff
  0x55a5b8bcf000 - 0x55a5b8bfffff
  0x55a5b8c00000 - 0x55a5b8c03fff
  0x55a5ba593000 - 0x55a5ba5b3fff
  0x7ffe921cb000 - 0x7ffe921ebfff
  0x7ffe921f6000 - 0x7ffe921f9fff
  0x7ffe921fa000 - 0x7ffe921fbfff
https://ideone.com/ev6YQs
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!