Homework 2: Production Systems

Due Tuesday, 25 February

This assignment is worth 20% of your grade. You will write a simple forward-chaining production system.
  1. Write a set of rules that embody the following knowledge. For variables, you can use ?var-name. (See below for code to test whether a symbol is a variable.) Each rule consists of a name or number, a left-hand side, and a right-hand side. The left-hand and right-hand sides can each take the form of a list of expressions, each of which is a list.
    • If a patient has a very high fever, the patient has a high fever.
    • If a patient has whooping cough, the patient has a cough.
    • If a patient has poison ivy, the patient has a rash.
    • If a patient has a high fever and congestion, the patient has the flu.
    • If a patient has a rash and no high fever, the patient has poison ivy.
    • If a patient has a cough and a very high fever, the patient has whooping cough.
    • If a patient has no fever, no cough, and no rash, the patient is healthy.
    • If one patient has a particular disease which is contagious and that patient contacts another patient, then the other patient has the disease.
    • If a doctor says that a patient has a particular disease or is healthy, then what the doctor says is true.
    • If a person says that a patient has a particular disease or is healthy and that is not true of the patient, then that person is not a doctor.

    Create a working memory consisting of the following assertions:

    Use these rules and this working memory to test the procedures you write for the questions below.

  2. Write a procedure substitute which takes a substitution and a pattern and returns the patttern with the variables from the substitution substituted into it. A substitution is just a list of lists, each representing a variable binding. For example,
    > (substitute '((?y . mary) (?x . john))
                  '(?x gave (son-of ?y) ?z))
    =>
    (john gave (son-of mary) ?z)
    
    > (substitute '((?y . ?z) (?z . ?x))
    	      '(drop arnold (class ?y 351)))
    =>
    (drop arnold (class ?x 351))
    > 
    

    Notice in the second example that the procedure should continue to replace variables until this is no longer possible. To make matters simple, you can assume that cycles are not possible in your substitution. Thus you would never have ((?y . ?x) (?x . ?y)) as a substitution.

    Use the following procedure to test whether an item is a variable, that is, whether it is a symbol beginning with ?. Notice that the ? is left on in the substitution.

    (define var?
      (lambda (obj)
        (and (symbol? obj)
    	 (char=? (string-ref (symbol->string obj) 0) #\?))))
    

  3. Write a procedure unify which takes two patterns and a substitution and returns either an updated substitution (possibly the empty list) or #f. Here are the algorithm and some examples, as discussed in the lecture. In your program, you can ignore the occurs-check part of unify-var.

  4. To do forward chaining using depth-first search, we need a procedure to extend a state. (We can represent nodes in the search tree as states rather than complete paths.) Each state will consist of a list of antecedents still to be matched and a substitution. Write the state-extending procedure, match-antecedent. It takes a state (a list of remaining antecedents and a substitution) and a working memory and returns all possible new states which can be reached by matching the first antecedent in the list. It uses unify to attempt to match the antecedent against each pattern in the working memory.
    (define match-antecedent
      (lambda (anteceds wm subs)
        (let ((antec (car anteceds)))
          (letrec
    	  ((ma-helper
    	    (lambda (states wm-left)
                 ;; If wm-left is empty return states.
                 ...
                 ;; Otherwise attempt to unify antec with the
                 ;; the next pattern in wm-left in the context
                 ;; of subs.
                 ;; If unification fails, call ma-helper on the
                 ;; same list of states and the rest of wm-left.
                 ;; If unification succeeds, call ma-helper
                 ;; with the new state consed onto states and
                 ;; the rest of wm-left.
                 ;; The new state includes the remaining
                 ;; antecedents and whatever new substitution
                 ;; resulted from the unification.
                 ...)))
    	(ma-helper '() wm)))))
    

  5. Write a procedure execute which takes a substitution, the right-hand side of a rule (one or more consequents), and a working memory. Execute applies the substitution to each of the consequents in the right-hand side, using substitute; for each checks whether the instantiated consequent is already in working memory; and if it is not, adds it to an accumulated list of new patterns. Execute returns the list of new patterns (which is not added to the working memory yet).

  6. Write a procedure match-rule which takes the name of a rule, the left-hand side of a rule (a list of antecedents), the right-hand side of the rule (a list of consequents), and a working memory. Match-rule uses exhaustive depth-first search to find all possible ways to satisfy the rule using patterns in the working memory. It maintains a queue of states (each consisting of a set of antecedents left to match and a current substitution). It removes the first state from the queue, checks to see whether this is a goal state (that is, whether there are no more antecedents), and if so, attempts to create new patterns by applying execute to the right-hand side using the substitution in the state. If the state is not a goal state, it is extended using match-antecedent, and the new states are appended onto the front of the queue. Since this is exhaustive search, we do not stop when a goal state is found but continue until all states in the queue are tried. Match-rule returns the list of new patterns to be added to working memory as a result of matching the rule. The list will be empty if either the rule fails to be matched or all of the instantiated consequents which result are already in the working memory. Here is a template for match-rule.
    (define match-rule
      (lambda (name lhs rhs wm)
        ;; Print out some useful messages here.
        (letrec
    	((mr-helper
    	  (lambda (queue new-wm)
    	    ;; Each state in queue is:
    	    ;; (anteceds-left subs)
                ;; If the queue is empty, return new-wm.
                ...
                ;; Else examine the first item on the queue (state1)
                ;;   If state1 has no antecedents, state1 is a goal
                ;;   state (the rule is matched);
                ;;   call "execute" on rhs using the substitution in
                ;;   state1.
                ...
                ;;      But don't stop here (this is exhaustive):
                ;;      call mr-helper on the rest of the queue, appending
                ;;      whatever new WM assertions "execute" returned.
                ...
                ;;   Else if state1 does have antecedents, use
                ;;   "match-antecedent" on them, along with
                ;;   wm and the substitutions in state1.
                ...
                ;;      If "match-antecedent" returns no new states,
                ;;      call mr-helper on the rest of the queue without
                ;;      changing states.
                ...
                ;;      Else call mr-helper on the updated queue,
                ;;      that is, the old one with the new states found
                ;;      by "match-antecedent" replacing state1.
                ...)))
          (mr-helper (match-antecedent lhs wm '()) '()))))
    

  7. Write a procedure match-rules which takes a list of rules and a working memory, calls match-rule on each of the rules, and returns a list of new patterns resulting from matching rules.

  8. Write a procedure run-ps which takes a list of rules and a working memory and calls match-rules repeatedly, appending the new patterns that are returned onto the working memory, until no new patterns are found on an iteration. Run-ps returns the updated working memory. Here is a partial trace of a run of run-ps:
    > (run-ps *wm1* *rules1*)
    
    CYCLE 1
    
    Current WM:
    ((fever ed very-high)
     ...)
    
    Attempting to match rule 1
    Failing
    
    Attempting to match rule 2
    Match succeeds
    Adding assertions to WM:
    ((disease don none))
    
    Attempting to match rule 3
    Match succeeds
    Adding assertions to WM:
    ...
    
    Attempting to match rule 4
    Failing
    
    ...
    
    
    CYCLE 2
    
    Current WM:
    ...
    
    Attempting to match rule 1
    Failing
    
    Attempting to match rule 2
    Match succeeds
    No new WM assertions
    
    Attempting to match rule 3
    Match succeeds
    No new WM assertions
    
    Attempting to match rule 4
    Failing
    
    Attempting to match rule 5
    Match succeeds
    Adding assertions to WM:
    ...
    
    
    CYCLE 3
    
    ...
    
    
    CYCLE 4
    
    ...
    
    NO CHANGES ON LAST CYCLE, HALTING
    
    ((cough alice)
     ...
     )
    >