Missionaries and Animists: Basic Procedures

;;; This file includes problem-specific procedures for solving the
;;; Missionaries and Animists Puzzle using the general search
;;; procedure.

;;; To run a search, load the file search.ss and the file am.ss
;;; (the contents of this file without the html stuff).
;;; Then, to do a best-first search, for example, do
;;; (search best-first-merge '(#t (3 3)) am-extend am-goal?
;;;         am-estimate am-print-state)

;;; State configurations are represented as follows.
;;; The car of a configuration list represents where the boat is:
;;;   #t the right side of the river
;;;   #f the left side of the river
;;; The cadr of a configuration list is a list representing how many
;;;   missionaries (car) and animists (cadr) there are on the right
;;; Thus
;;;   (#t (3 3))
;;; is the start configuration for the puzzle.

;;; Is state the goal state?

(define am-goal?
  (lambda (state)
    (equal? (cadr (state-config state)) '(0 0))))

;;; Is the boat on the right side of the river?

(define boat-right?
  (lambda (state)
    (car (state-config state))))

;;; Is the boat on the left side of the river?

(define boat-left?
  (lambda (state)
    (not (car (state-config state)))))

;;; How many missionaries are there on the right?

(define n-miss-right
  (lambda (state)
    (car (cadr (state-config state)))))

;;; How many animists are there on the right?

(define n-anim-right
  (lambda (state)
    (cadr (cadr (state-config state)))))

;;; How many missionaries are there on the left?

(define n-miss-left
  (lambda (state)
    (- 3 (n-miss-right state))))

;;; How many animists are there on the left?

(define n-anim-left
  (lambda (state)
    (- 3 (n-anim-right state))))

;;; Is a state illegal for some reason?

(define am-bad-state?
  (lambda (state)
    (or
     ;; Illegal because there are more missionaries than
     ;; animists on one side or the other
     (and (> (n-miss-right state) (n-anim-right state))
	  (> (n-anim-right state) 0))
     (and (> (n-miss-left state) (n-anim-left state))
	  (> (n-anim-left state) 0))
     ;; Illegal because there are more than 3 or fewer than 0
     ;; missionaries or animists on one side or the other
     (> (n-miss-right state) 3)
     (< (n-miss-right state) 0)
     (> (n-anim-right state) 3)
     (< (n-anim-right state) 0))))

;;; What state results from moving n-miss missionaries and n-anim
;;; animists to the side opposite where the boat is starting from
;;; state.

(define am-move
  (lambda (state n-miss n-anim)
    (let* ((rt? (boat-right? state))
	   (dir (if rt? - +)))
      (list
       ;; Distance
       (add1 (state-distance state))
       ;; Estimate
       0
       ;; Configuration
       (list
	(if rt? #f #t)
	(list (dir (n-miss-right state) n-miss)
	      (dir (n-anim-right state) n-anim)))))))

;;; All of the possible states that are reachable in one "move"
;;; from state.

(define am-extend
  (lambda (state)
    (filter
     am-bad-state?
     (list (am-move state 1 1)
	   (am-move state 2 0)
	   (am-move state 0 2)
	   (am-move state 1 0)
	   (am-move state 0 1)))))

;;; Everything in ls which does not return #t to pred.

(define filter
  (lambda (pred ls)
    (cond ((null? ls) '())
          ((pred (car ls))
           (filter pred (cdr ls)))
          (else
           (cons (car ls)
                 (filter pred (cdr ls)))))))

;;; How far away is the goal likely to be?  Just adds the
;;; number of missionaries and animists that still need to
;;; get to the left side and one more if the boat is on the left
;;; side.

(define am-estimate
  (lambda (state)
    (+ (n-miss-right state)
       (n-anim-right state)
       (if (boat-left? state)
	   1
	   0))))

;;; Prints a pretty version of a state representation.

(define am-print-state
  (lambda (state)
    (let ((miss-rt (car (cadr (state-config state))))
	  (anim-rt (cadr (cadr (state-config state)))))
      (printf "  DISTANCE: ~s, ESTIMATE: ~s  "
	      (state-distance state)
	      (state-estimate state))
      ;; Missionaries on left.
      (display (case miss-rt
		 (0 "MMM ")
		 (1 "MM  ")
		 (2 "M   ")
		 (3 "    ")))
      (display (case anim-rt
		 (0 "AAA ")
		 (1 "AA  ")
		 (2 "A   ")
		 (3 "    ")))
      (display (if (car (state-config state))
		   "|  >|"
		   "|<  |"))
      (display (case miss-rt
		 (0 "    ")
		 (1 " M  ")
		 (2 " MM ")
		 (3 " MMM")))
      (display (case anim-rt
		 (0 "    ")
		 (1 " A  ")
		 (2 " AA ")
		 (3 " AAA"))))))