Eliza

General Background on Eliza

Eliza (Weizenbaum 1966, MIT)

Men Are all alike.
IN WHAT WAY.
They're always bugging us about something or another.
CAN YOU BE MORE SPECIFIC.
Well, my boyfriend made me come here.
YOUR BOYFRIEND MADE YOU COME HERE.
He says I'm depressed much of the time.
I AM SORRY TO HEAR YOU ARE DEPRESSED.
It's true. I'm unhappy.
DO YOU THINK COMING HERE WILL HELP YOU NOT TO BE UNHAPPY.
I need some help, that much is certain.
WHAT WOULD IT MEAN TO YOU IF YOU GOT SOME HELP.
Perhaps I could learn to get along with my mother.
TELL ME MORE ABOUT YOUR FAMILY.

Amazingly:

• practising psychiatrists believed ELIZA could be an automatic form of psychotherapy.
• people became emotionally involved with the computer.
• there was a belief that the program demonstrated a general solution to the problem of computer understanding of NL.

Now - the Program itself

Pattern Matching and Unification

Specification:

1. Read input.
2. Find a pattern matching input.
3. Transform input into a response.
4. Print response.

Pattern matching:

(i need a X)

(what would it mean to you if you got a X ?)

(defun simple-equal (x y)
 "Simple recursive equal, not for inside strings"
 (if (or (atom x) (atom y))
     (eql x y)
     (and (simple-equal (first x) (first y))
          (simple-equal (rest x) (rest y)))))

(defun pat-match (pattern input)
  "Does pattern match input? Any variable can match anything."
  (if (variable-p pattern)
    t
    (if (or (atom pattern) (atom input))
      (eql pattern input)
      (and (pat-match (first pattern) (first input))
           (pat-match (rest pattern) (rest input))))))

Representing variables:

(defun variable-p (x)
  "Is x a variable (a symbol beginning with '?')?"
  (and (symbolp x) (equal (char (symbol-name x) 0) #\?)))

Extracting information from the match

(sublis '((?X . vacation)) '(what would it mean to you if you got a ?X ?)) 
(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)

(defun pat-match (pattern input)
  "Does pattern match input? BUGGY VERSION."
  (if (variable-p pattern)
    (list (cons pattern input))
    (if (or (atom pattern) (atom input))
      (eql pattern input)
      (append (pat-match (first pattern) (first input))
              (pat-match (rest pattern) (rest input))))))

1. (eql pattern input) can return T and append will die.
2. (eql pattern input) can return NIL meaning failure, and be interpreted as an empty binding (semi-predicate problem).
3. We want the bindings of variables to agree: (?X ?X) (1 2) fails.
4. Inefficient to check first and rest when we know that first fails.

Bindings Management

• pass them as parameter to pat-match (pat-match pat input bindings)
• distinguish between failure and no-bindings.

(defconstant fail nil)
(defconstant no-bindings '((t . t)))

(defun get-binding (var bindings)
  "Find a (var . value) pair in a binding list."
  (assoc var bindings))

(defun binding-val (binding) 
  "Get the value part of a binding."
  (cdr binding))

(defun lookup (var bindings)
  "Get the value part (for var) from a binding list."
  (binding-val (get-binding var bindings)))

(defun extend-bindings (var val bindings)
  "Add a (var . value) pair to a binding list."
  (cons (cons var val) bindings))

A (first) correct version of pat-match with binding management

(defun pat-match (pattern input &optional (bindings no-bindings))
  "Match pattern against input in the context of the bindings."
  (cond ((eq bindings fail) fail)
        ((variable-p pattern) 
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((and (consp pattern) (consp input))
         (pat-match (rest pattern) (rest input)
                    (pat-match (first pattern) (first input) bindings))) 
        (t fail)))

(defun match-variable (var input bindings)
  "Does VAR match input? Uses (or updates) and returns bindings."
  (let ((binding (get-binding var bindings)))
    (cond ((not binding) (extend-bindings var input bindings))
          ((equal input (binding-val binding)) bindings)
          (t fail))))

> (pat-match '(i need a ?X) '(i need a vacation))
((?X . vacation) (t . t))

(defun extend-bindings (var val bindings)
  "Add a (var . val) pair to a binding list."
  (cons (var val)
        (if (eq bindings no-bindings) nil bindings)))

> (pat-match '(1 2 3) '(1 2 3))
((t . t))
> (pat-match '(?X is ?X) '((2 + 2) is 4))
nil
> (pat-match '(?X is ?X) '((2 + 2) is (2 + 2)))
((?X 2 + 2))
> (pat-match '(?p need ?x) '(I need a long vacation))
((?x a long vacation) (?p I))

Segment pattern matching

• Similar to kleene-star notation in regular expressions: want to match any number of elements in a list.
• Choose a syntax to write segment variables: (?* ?var)

(defun segment-pattern-p (pattern)
  (and (consp pattern) (starts-with (first pattern) '?*)))

> (pat-match '((?* ?x) is (?* ?p) ?) '(1 + 2 * 3 is 5 + 2 ?))
((?x 1 + 2 * 3) (?p 5 + 2))

(defun pat-match (pattern input &optional (bindings no-bindings))
  "Match pattern against input in the context of the bindings."
  (cond ((eq bindings fail) fail)
        ((variable-p pattern) 
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((segment-pattern-p pattern)                       ;; ***
         (segment-pattern-match pattern input bindings))   ;; ***
        ((and (consp pattern) (consp input))
         (pat-match (rest pattern) (rest input)
                    (pat-match (first pattern) (first input) bindings))) 
        (t fail)))

Segment Pattern Matching and backtracking

((?* ?p) C p2...))

(... C i2 ...)

b2 = (pat-match (p2...) (r2 ...))

> (pat-match '((?* ?p) is a (?* ?x)) '(what he is is a fool))
((?p what he is) (?x fool))

> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b)) 

(defun segment-match (pattern input bindings &optional (start 0))
  "Match segment pattern ((?* var) . pat) against input."
  (let ((var (second (first pattern)))
        (pat (rest pattern)))
    (if (null pat)
      (match-variable var input bindings)
      ;; assume pat starts with a constant
      (let ((pos (position (first pat) input :start start :test #'equal))) 
        (if (null pos)
          fail
          (let ((b2 (pat-match pat (subseq input pos) 
                               (match-variable var (subseq input 0 pos)       
                                               bindings))))
            ;; If this one failed, try a longer segment
            (if (eq b2 fail)
              (segment-match pattern input bindings (+ pos 1))
              b2)))))))

> (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b))
((?X 1 2 A B))

Lisp Note:

One of a set of "Searching Sequences for Items" functions.

Examples:
(find item sequence &key :from-end :test :test-not :start :end :key)
(find-if-not predicate sequence &key :from-end :start :end :key)
(position item sequence &key  :from-end  :test :test-not 
          :start :end :key)
(count-if predicate sequence &key :from-end :start :end :key )

(subseq sequence start &optional end)

This returns the subsequence of sequence specified by start and end. subseq always allocates a
new sequence for a result; it never shares storage with an old sequence. The result subsequence is
always of the same type as the argument sequence. 

ELIZA: A Rule-based translator

(defun rule-pattern (rule) (first rule))

(defun rule-responses (rule) (rest rule))

((?* ?x) I want (?* ?y))
 (What would it mean if you got ?y)
 (Why do you want ?y)
 (Suppose you got ?y soon))

How to handle a set of rules?
Several rules match, what to do?

• Option 1: accept the first matching rule.
• Option 2: choose one rule randomly among the matching rules.
• Option 3: combine the responses from several matching rules.

(defparameter *eliza-rules*
  '((((?* ?x) hello (?* ?y))
     (How do you do. Please state you problem.))
    (((?* ?x) I want (?* ?y))
     (What would it mean if you got ?y)
     (Why do you want ?y) (Suppose you got ?y soon))
    (((?* ?x) if (?* ?y))
     (Do you really think it is likely that ?y) (Do you wish that ?y)
     (What do you think about ?y) (Really -- if ?y))))

A rule-based interpreter

(defun eliza ()
  "Respond to user input using pattern matching rules."
  (loop
    (print 'eliza>)
    (write (flatten (use-eliza-rules (read))) :pretty t)))


(defun use-eliza-rules (input)
  "Find some rule with which to transform the input."
  (some #'(lambda (rule)
            (let ((result (pat-match (rule-pattern rule) input)))
              (if (not (eq result fail))
                (sublis (switch-viewpoint result)
                        (random-elt (rule-responses rule))))))
        *eliza-rules*))


(defun switch-viewpoint (words)
  "Change I to you and vice-versa, and so on."
  (sublis '((I . you) (you . I) (me . you) (am . are)) words))


(defun flatten (the-list)
  "Append together elements or lists in the-list"
  (mappend #'mklist the-list))

(defun mklist (x)
  "Return x if it is a list, otherwise (x)"
  (if (listp x) x (list x)))

(defun random-elt (choices)
  (elt choices (random (length choices))))

For any question, contact me: yaeln@cs.bgu.ac.il
Back to course homepage

Last modified , 2000