eliza.scm

   1 ;;;  eliza.scm    Dave Reed    1/28/03
   2 ;;;
   3 ;;;  This program implements the Eliza psychologist as described in
   4 ;;;  "Paradigms in Artificial Intelligence Programming" by Norvig.
   5 ;;;  The call  (eliza)  starts up the psychologist and produces the
   6 ;;;  "Eliza>" prompt.  The user then must type questions/statements to
   7 ;;;  which Eliza responds.  As is, the user must type questions/statements
   8 ;;;  as words in a list (letter case is not important).  Punctuation should
   9 ;;;  not be included, as this can sometimes impede matching.  To stop the
  10 ;;;  program, the user must enter a BREAK.  (Clearly, there are lots
  11 ;;;  of improvements to be made).
  12 ;;;
  13
  14 (define (eliza)
  15   (begin (display 'Eliza>)
  16          (display (apply-rule ELIZA-RULES (read)))
  17          (newline)
  18          (eliza)))
  19
  20 (define (apply-rule rules input)
  21   (let ((result (pattern-match (caar rules) input '())))
  22     (if (equal? result 'failed)
  23         (apply-rule (cdr rules) input)
  24         (apply-substs (switch-viewpoint result)
  25                       (random-ele (cdar rules))))))
  26
  27 (define (apply-substs substs target)
  28   (cond ((null? target) '())
  29         ((and (list? (car target)) (not (variable? (car target))))
  30          (cons (apply-substs substs (car target))
  31                (apply-substs substs (cdr target))))
  32         (else (let ((value (assoc (car target) substs)))
  33                 (if (list? value)
  34                     (append (cddr value)
  35                             (apply-substs substs (cdr target)))
  36                     (cons (car target)
  37                           (apply-substs substs (cdr target))))))))
  38
  39 (define (switch-viewpoint words)
  40   (apply-substs '((i <-- you) (you <-- i) (me <-- you)
  41                   (you <-- me) (am <-- are) (are <-- am)
  42                   (my <-- your) (your <-- my)
  43                   (yourself <-- myself) (myself <-- yourself)) words))
  44
  45
  46 (define (variable? x)
  47   (and (list? x) (equal? (car x) 'VAR)))
  48
  49
  50
  51 ;;;
  52 ;;; This function performs pattern matching, where the pattern (containing
  53 ;;; variables represented as (VAR X)) is matched with the input, resulting
  54 ;;; in the appropriate substitutions.
  55 ;;;
  56
  57 (define (pattern-match pattern input substs)
  58
  59   (define (match-variable var input substs)
  60     (let ((subst (assoc var substs)))
  61       (cond ((equal? subst #f)
  62              (if (symbol? input)
  63                  (cons (list var input) substs)
  64                  (cons (cons var (cons '<-- input)) substs)))
  65             ((equal? input (cdr subst)) substs)
  66             (else 'failed))))
  67
  68   (define (segment-match pattern input substs start)
  69     (let ((var (car pattern)) (pat (cdr pattern)))
  70       (if (null? pat)
  71           (match-variable var input substs)
  72           (let ((pos (position-from (car pat) input start)))
  73             (if (zero? pos)
  74                 'failed
  75                 (let ((b2 (pattern-match
  76                                    pat
  77                                    (subseq input pos (length input))
  78                                    (match-variable
  79                                        var
  80                                        (subseq input 1 (- pos 1))
  81                                        substs))))
  82                     (if (equal? b2 'failed)
  83                         (segment-match pattern input substs (+ pos 1))
  84                         b2)))))))
  85
  86   (cond
  87     ((equal? substs 'failed) 'failed)
  88     ((equal? pattern input) substs)
  89     ((and (list? pattern) (not (null? pattern))
  90           (variable? (car pattern)))
  91      (segment-match pattern input substs 1))
  92     ((and (list? pattern) (not (null? pattern))
  93           (list? input)   (not (null? input)))
  94      (pattern-match (cdr pattern) (cdr input)
  95                     (pattern-match (car pattern) (car input) substs)))
  96     (else 'failed)))
  97
  98
  99
 100 ;;;
 101 ;;;  Utilities
 102 ;;;
 103
 104
 105 (define (random-ele elelist)
 106   (list-ref elelist (random (length elelist))))
 107
 108 (define (position-from ele elelist start)
 109   (define (position-from-help count cdrlist)
 110     (cond ((null? cdrlist) 0)
 111           ((and (>= count start) (equal? ele (car cdrlist))) count)
 112           (else (position-from-help (+ 1 count) (cdr cdrlist)))))
 113     (position-from-help 1 elelist))
 114
 115 (define (subseq elelist i j)
 116   (define (subseq-help count cdrlist)
 117     (cond ((or (null? cdrlist) (> count j)) '())
 118           ((< count i) (subseq-help (+ 1 count) (cdr cdrlist)))
 119           (else (cons (car cdrlist)
 120                       (subseq-help (+ 1 count) (cdr cdrlist))))))
 121   (subseq-help 1 elelist))
 122
 123
 124
 125 ;;;
 126 ;;;  These are the original rules for the Eliza pyschologist as described in
 127 ;;;  "Paradigms in Artificial Intelligence Programming" by Norvig.
 128 ;;;
 129
 130 (define ELIZA-RULES
 131   '((((VAR X) hello (VAR Y))
 132      (how do you do.  please state your problem))
 133     (((VAR X) computer (VAR Y))
 134      (do computers worry you)
 135      (what do you think about machines)
 136      (why do you mention computers)
 137      (what do you think machines have to do with your problem))
 138     (((VAR X) name (VAR Y))
 139      (i am not interested in names))
 140     (((VAR X) sorry (VAR Y))
 141      (please don't apologize)
 142      (apologies are not necessary)
 143      (what feelings do you have when you apologize))
 144     (((VAR X) i remember (VAR Y))
 145      (do you often think of (VAR Y))
 146      (does thinking of (VAR Y) bring anything else to mind)
 147      (what else do you remember?)
 148      (why do you recall (VAR Y) right now)
 149      (what in this present situation reminds you of (VAR Y))
 150      (what is the connection between me and (VAR Y)))
 151     (((VAR X) do you remember (VAR Y))
 152      (did you think i would forget (VAR Y))
 153      (why do you think i should recall (VAR Y))
 154      (what about (VAR Y))
 155      (you mentioned (VAR Y)))
 156     (((VAR X) if (VAR Y))
 157      (do you really think it is likely that (VAR Y))
 158      (do you wish that (VAR Y))
 159      (what do you think about (VAR Y))
 160      (really -- if (VAR Y)))
 161     (((VAR X) i dreamt (VAR Y))
 162      (really -- (VAR Y))
 163      (have you ever fantasized (VAR Y) while you were awake)
 164      (have you dreamt (VAR Y) before))
 165     (((VAR X) i dreamed (VAR Y))
 166      (really -- (VAR Y))
 167      (have you ever fantasized (VAR Y) while you were awake)
 168      (have you dreamed (VAR Y) before))
 169     (((VAR X) dream (VAR Y))
 170      (what does this dream suggest to you)
 171      (do you dream often)
 172      (what persons appear in your dreams)
 173      (don't you believe that dream has to do with your problem))
 174     (((VAR X) my mother (VAR Y))
 175      (who else is in your family (VAR Y))
 176      (tell me more about your family))
 177     (((VAR X) my father (VAR Y))
 178      (your father)
 179      (does he influence you strongly)
 180      (what else comes to mind when you think of your father))
 181     (((VAR X) i want (VAR Y))
 182      (what would it mean if you got (VAR Y))
 183      (why do you want (VAR Y))
 184      (suppose you got (VAR Y) soon))
 185     (((VAR X) i am glad (VAR Y))
 186      (how have i helped you to be (VAR Y))
 187      (what makes you happy just now)
 188      (can you explain why you are suddenly (VAR Y)))
 189     (((VAR X) i am happy (VAR Y))
 190      (how have i helped you to be (VAR Y))
 191      (what makes you glad just now)
 192      (can you explain why you are suddenly (VAR Y)))
 193     (((VAR X) i am sad (VAR Y))
 194      (i am sorry to hear you are depressed)
 195      (i'm sure it's not pleasant to be sad))
 196     (((VAR X) i am unhappy (VAR Y))
 197      (i am sorry to hear you are depressed)
 198      (i'm sure it's not pleasant to be unhappy))
 199     (((VAR X) are like (VAR Y))
 200      (what resemblence do you see between (VAR X) and (VAR Y)))
 201     (((VAR X) is like (VAR Y))
 202      (in what way is it that (VAR X) is like (VAR Y))
 203      (what resemblence do you see)
 204      (could there really be some connection)
 205      (how))
 206     (((VAR X) alike (VAR Y))
 207      (in what way)
 208      (what similarities are there))
 209     (((VAR X) same (VAR Y))
 210      (what other connections do you see))
 211     (((VAR X) i was (VAR Y))
 212      (were you really)
 213      (perhaps i already knew you were (VAR Y))
 214      (why do you tell me you were (VAR Y) now))
 215     (((VAR X) was i (VAR Y))
 216      (what if you were (VAR Y))
 217      (do you think you were (VAR Y))
 218      (what would it mean if you were (VAR Y)))
 219     (((VAR X) i am (VAR Y))
 220      (in what way are you (VAR Y))
 221      (do you want to be (VAR Y)))
 222     (((VAR X) am i (VAR Y))
 223      (do you believe you are (VAR Y))
 224      (would you want to be (VAR Y))
 225      (you wish i would tell you you are (VAR Y))
 226      (what would it mean if you were (VAR Y)))
 227     (((VAR X) am (VAR Y))
 228      (why do you say "am")
 229      (i don't understand that))
 230     (((VAR X) are you (VAR Y))
 231      (why are you interested in whether i am (VAR Y) or not)
 232      (would you prefer it if i weren't (VAR Y))
 233      (perhaps i am (VAR Y) in your fantasies))
 234     (((VAR X) you are (VAR Y))
 235      (what makes you think i am (VAR Y)))
 236     (((VAR X) because (VAR Y))
 237      (is that the real reason)
 238      (what other reason might there be)
 239      (does that reason seem to explain anything else))
 240     (((VAR X) were you (VAR Y))
 241      (perhaps i was (VAR Y))
 242      (what do you think)
 243      (what if i had been (VAR Y)))
 244     (((VAR X) i can't (VAR Y))
 245      (maybe you could (VAR Y) now)
 246      (what if you could (VAR Y)))
 247     (((VAR X) i feel (VAR Y))
 248      (do you often feel (VAR Y)))
 249     (((VAR X) i felt (VAR Y))
 250      (what other feelings do you have))
 251     (((VAR X) i (VAR Y) you (VAR Z))
 252      (perhaps in your fantasies we (VAR Y) each other))
 253     (((VAR X) why don't you (VAR Y))
 254      (should you (VAR Y) yourself)
 255      (do you believe i don't (VAR Y))
 256      (perhaps i will (VAR Y) in good time))
 257     (((VAR X) yes (VAR Y))
 258      (you seem quite positive)
 259      (you are sure)
 260      (i understand))
 261     (((VAR X) no (VAR Y))
 262      (why not)
 263      (you are being a bit negative)
 264      (are you saying "no" just to be negative))
 265     (((VAR X) someone (VAR Y))
 266      (can you be more specific))
 267     (((VAR X) everyone (VAR Y))
 268      (surely not everyone)
 269      (can you think of anyone in particular)
 270      (who for example)
 271      (you are thinking of a special person))
 272     (((VAR X) always (VAR Y))
 273      (can you think of a specific example)
 274      (when)
 275      (what incident are you thinking of)
 276      (really -- always))
 277     (((VAR X) what (VAR Y))
 278      (why do you ask)
 279      (does that question interest you)
 280      (what is it you really want to know)
 281      (what do you think)
 282      (what comes to your mind when you ask that))
 283     (((VAR X) perhaps (VAR Y))
 284      (you do not seem quite certain))
 285     (((VAR X) are (VAR Y))
 286      (do you think they might not be (VAR Y))
 287      (possibly they are (VAR Y)))
 288     (((VAR X))
 289      (very interesting)
 290      (i am not sure i understand you fully)
 291      (what does that suggest to you)
 292      (please continue)
 293      (go on)
 294      (do you feel strongly about discussing such things))))
 295