Search with chronological backtracking

Compute the intersection of two lists:

(define (list-intersection list1 list2)
  (let ((x (an-element-of list1)))
       (require (member x list2))
       x))

We introduce a special form called amb, which returns one of its arguments.

(amb 'a 'b 'c)

(define (require p) (if (not p) (amb)))

(define (an-element-of list1)
  (require (not (null? list1)))
  (amb (car list1) (an-element-of (cdr list1))))

Need a read-eval-print loop that will also take a 'try-again command
to backtrack and get another answer.

Two fun applications of nondetermistic programming.

logic puzzles

In a certain bank the positions of cashier, manager, and teller are held
by Brown, Jones and Smith, though not necesserily respectively.

The tell, who was an only child, earns the least.
Smith, who married Brown's sister, earns more than the manager.

What position does each man fill?

(define (bank-positions)
  (let ((cashier (amb 'Brown 'Jones 'Smith))
        (manager (amb 'Brown 'Jones 'Smith))
        (teller (amb 'Brown 'Jones 'Smith)))
       (require (distinct? (list cashier manager teller)))
       (require (not (eq? teller 'Smith)))
       (require (not (eq? manager 'Smith)))
       (require (not (eq? teller 'Brown)))
       (list (list 'cashier cashier)
	     (list 'manager manager)
	     (list 'teller teller))))

where

(define (distinct? list1)
  (cond ((null? list1) #t)
	((null? (cdr list1)) #t)
	((member (car list1) (cdr list1)) #f)
	(else (distinct? (cdr list1)))))


natural language parsing

(define adjectives '(adj tall red round))
(define nouns '(n mice cats birds))
(define transitive-verbs '(v eat chase))
(define intransitive-verbs '(v fly sleep))

Use *unparsed* to hold list of words to be parsed

(define (parse-words list1)
 (require (not (null? *unparsed*)))
 (require (memq (car *unparsed*) (cdr list1)))
 (let ((found-word (car *unparsed*)))
    (set! *unparsed* (cdr *unparsed*))
    (list (car list1) found-word)))

(define *unparsed* ())

(define (parse input)
  (set! *unparsed* input)
  (let ((sent (parse-sentence)))
    (require (null? *unparsed*))
    sent))

Now for the grammar:

(define (parse-sentence)
  (list 'sentence
	(parse-noun-phrase)
	(parse-verb-phrase)))

(define (parse-noun-phrase)
  (amb (list 'noun-phrase
	      (parse-words nouns))
       (list 'noun-phrase
	     (parse-words adjectives)
	     (parse-noun-phrase)))
	
(define (parse-verb-phrase)
  (amb (list 'verb-phrase
             (parse-words intransitive-verbs))
       (list 'verb-phrase
	     (parse-words transitive-verbs)
	     (parse-noun-phrase))))

See section 4.3.2 for other examples